[commit: ghc] ghc-7.10: Fix a bug with mallocForeignPtr and finalizers (#10904) (8c4cbe5)
git at git.haskell.org
git at git.haskell.org
Thu Oct 22 15:07:29 UTC 2015
Repository : ssh://git@git.haskell.org/ghc
On branch : ghc-7.10
Link : http://ghc.haskell.org/trac/ghc/changeset/8c4cbe597f346a9ab3b4cd05c14d679ecb4abb97/ghc
>---------------------------------------------------------------
commit 8c4cbe597f346a9ab3b4cd05c14d679ecb4abb97
Author: Simon Marlow <marlowsd at gmail.com>
Date: Wed Sep 23 10:01:23 2015 +0100
Fix a bug with mallocForeignPtr and finalizers (#10904)
Summary: See Note [MallocPtr finalizers]
Test Plan: validate; new test T10904
Reviewers: ezyang, bgamari, austin, hvr, rwbarton
Subscribers: thomie
Differential Revision: https://phabricator.haskell.org/D1275
>---------------------------------------------------------------
8c4cbe597f346a9ab3b4cd05c14d679ecb4abb97
libraries/base/GHC/ForeignPtr.hs | 36 +++++++++++++++++++++---------------
rts/sm/MarkWeak.c | 5 +++++
testsuite/tests/rts/T10904.hs | 28 ++++++++++++++++++++++++++++
testsuite/tests/rts/T10904lib.c | 30 ++++++++++++++++++++++++++++++
testsuite/tests/rts/all.T | 4 ++++
5 files changed, 88 insertions(+), 15 deletions(-)
diff --git a/libraries/base/GHC/ForeignPtr.hs b/libraries/base/GHC/ForeignPtr.hs
index 448eaee..be730f8 100644
--- a/libraries/base/GHC/ForeignPtr.hs
+++ b/libraries/base/GHC/ForeignPtr.hs
@@ -250,11 +250,18 @@ addForeignPtrFinalizer :: FinalizerPtr a -> ForeignPtr a -> IO ()
-- finalizer will run /before/ all other finalizers for the same
-- object which have already been registered.
addForeignPtrFinalizer (FunPtr fp) (ForeignPtr p c) = case c of
- PlainForeignPtr r -> f r >> return ()
- MallocPtr _ r -> f r >> return ()
+ PlainForeignPtr r -> insertCFinalizer r fp 0# nullAddr# p ()
+ MallocPtr _ r -> insertCFinalizer r fp 0# nullAddr# p c
_ -> error "GHC.ForeignPtr: attempt to add a finalizer to a plain pointer"
- where
- f r = insertCFinalizer r fp 0# nullAddr# p
+
+-- Note [MallocPtr finalizers] (#10904)
+--
+-- When we have C finalizers for a MallocPtr, the memory is
+-- heap-resident and would normally be recovered by the GC before the
+-- finalizers run. To prevent the memory from being reused too early,
+-- we attach the MallocPtr constructor to the "value" field of the
+-- weak pointer when we call mkWeak# in ensureCFinalizerWeak below.
+-- The GC will keep this field alive until the finalizers have run.
addForeignPtrFinalizerEnv ::
FinalizerEnvPtr env a -> Ptr env -> ForeignPtr a -> IO ()
@@ -263,11 +270,9 @@ addForeignPtrFinalizerEnv ::
-- finalizer. The environment passed to the finalizer is fixed by the
-- second argument to 'addForeignPtrFinalizerEnv'
addForeignPtrFinalizerEnv (FunPtr fp) (Ptr ep) (ForeignPtr p c) = case c of
- PlainForeignPtr r -> f r >> return ()
- MallocPtr _ r -> f r >> return ()
+ PlainForeignPtr r -> insertCFinalizer r fp 1# ep p ()
+ MallocPtr _ r -> insertCFinalizer r fp 1# ep p c
_ -> error "GHC.ForeignPtr: attempt to add a finalizer to a plain pointer"
- where
- f r = insertCFinalizer r fp 1# ep p
addForeignPtrConcFinalizer :: ForeignPtr a -> IO () -> IO ()
-- ^This function adds a finalizer to the given @ForeignPtr at . The
@@ -319,9 +324,9 @@ insertHaskellFinalizer r f = do
data MyWeak = MyWeak (Weak# ())
insertCFinalizer ::
- IORef Finalizers -> Addr# -> Int# -> Addr# -> Addr# -> IO ()
-insertCFinalizer r fp flag ep p = do
- MyWeak w <- ensureCFinalizerWeak r
+ IORef Finalizers -> Addr# -> Int# -> Addr# -> Addr# -> value -> IO ()
+insertCFinalizer r fp flag ep p val = do
+ MyWeak w <- ensureCFinalizerWeak r val
IO $ \s -> case addCFinalizerToWeak# fp p flag ep w s of
(# s1, 1# #) -> (# s1, () #)
@@ -329,16 +334,17 @@ insertCFinalizer r fp flag ep p = do
-- has finalized w by calling foreignPtrFinalizer. We retry now.
-- This won't be an infinite loop because that thread must have
-- replaced the content of r before calling finalizeWeak#.
- (# s1, _ #) -> unIO (insertCFinalizer r fp flag ep p) s1
+ (# s1, _ #) -> unIO (insertCFinalizer r fp flag ep p val) s1
-ensureCFinalizerWeak :: IORef Finalizers -> IO MyWeak
-ensureCFinalizerWeak ref@(IORef (STRef r#)) = do
+ensureCFinalizerWeak :: IORef Finalizers -> value -> IO MyWeak
+ensureCFinalizerWeak ref@(IORef (STRef r#)) value = do
fin <- readIORef ref
case fin of
CFinalizers weak -> return (MyWeak weak)
HaskellFinalizers{} -> noMixingError
NoFinalizers -> IO $ \s ->
- case mkWeakNoFinalizer# r# () s of { (# s1, w #) ->
+ case mkWeakNoFinalizer# r# (unsafeCoerce# value) s of { (# s1, w #) ->
+ -- See Note [MallocPtr finalizers] (#10904)
case atomicModifyMutVar# r# (update w) s1 of
{ (# s2, (weak, needKill ) #) ->
if needKill
diff --git a/rts/sm/MarkWeak.c b/rts/sm/MarkWeak.c
index c5a107c..c44d4b9 100644
--- a/rts/sm/MarkWeak.c
+++ b/rts/sm/MarkWeak.c
@@ -191,6 +191,11 @@ static void collectDeadWeakPtrs (generation *gen)
{
StgWeak *w, *next_w;
for (w = gen->old_weak_ptr_list; w != NULL; w = next_w) {
+ // If we have C finalizers, keep the value alive for this GC.
+ // See Note [MallocPtr finalizers] in GHC.ForeignPtr, and #10904
+ if (w->cfinalizers != &stg_NO_FINALIZER_closure) {
+ evacuate(&w->value);
+ }
evacuate(&w->finalizer);
next_w = w->link;
w->link = dead_weak_ptr_list;
diff --git a/testsuite/tests/rts/T10904.hs b/testsuite/tests/rts/T10904.hs
new file mode 100644
index 0000000..264df3a
--- /dev/null
+++ b/testsuite/tests/rts/T10904.hs
@@ -0,0 +1,28 @@
+import Control.Concurrent
+import Control.Monad
+import Foreign
+import Foreign.C.Types
+import System.Environment
+
+
+foreign import ccall safe "finalizerlib.h init_value"
+ init_value :: Ptr CInt -> IO ()
+
+foreign import ccall safe "finalizerlib.h &finalize_value"
+ finalize_value :: FinalizerPtr CInt
+
+
+allocateValue :: IO ()
+allocateValue = do
+ fp <- mallocForeignPtrBytes 10000
+ withForeignPtr fp init_value
+ addForeignPtrFinalizer finalize_value fp
+
+
+main :: IO ()
+main = do
+ [n] <- fmap (fmap read) getArgs
+ _ <- forkIO (loop n)
+ loop n
+ where
+ loop n = replicateM_ n allocateValue
diff --git a/testsuite/tests/rts/T10904lib.c b/testsuite/tests/rts/T10904lib.c
new file mode 100644
index 0000000..bfed67b
--- /dev/null
+++ b/testsuite/tests/rts/T10904lib.c
@@ -0,0 +1,30 @@
+#include <stdio.h>
+#include <stdlib.h>
+
+
+#define MAGIC 0x11223344
+
+void
+init_value(int * p)
+{
+ *p = MAGIC;
+}
+
+
+void
+finalize_value(int * p)
+{
+ static long counter = 0;
+
+ counter += 1;
+
+ if (counter % 1000000 == 0) {
+ fprintf(stderr, "finalize_value: %ld calls\n", counter);
+ }
+
+ if (*p != MAGIC) {
+ fprintf(stderr, "finalize_value: %x != %x after %ld calls\n",
+ *p, MAGIC, counter);
+ abort();
+ }
+}
diff --git a/testsuite/tests/rts/all.T b/testsuite/tests/rts/all.T
index e3b9da1..3993006 100644
--- a/testsuite/tests/rts/all.T
+++ b/testsuite/tests/rts/all.T
@@ -284,3 +284,7 @@ test('linker_error3',
# in 'epoll' and 'select' backends on reading from EBADF
# mingw32 skip as UNIX pipe and close(fd) is used to exercise the problem
test('T10590', [ignore_output, when(opsys('mingw32'),skip)], compile_and_run, [''])
+
+# 20000 was easily enough to trigger the bug with 7.10
+test('T10904', [ omit_ways(['ghci']), extra_run_opts('20000') ],
+ compile_and_run, ['T10904lib.c'])
More information about the ghc-commits
mailing list