Commit 2440e3c6 authored by Simon Marlow's avatar Simon Marlow

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
parent 39a262e5
......@@ -248,11 +248,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 ()
......@@ -261,11 +268,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@. The
......@@ -327,9 +332,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, () #)
......@@ -337,16 +342,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
......
......@@ -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;
......
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
#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();
}
}
......@@ -329,3 +329,7 @@ test('T9839_06', [ only_ways(prof_ways), ignore_output, exit_code(1), extra_run_
# 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'])
Markdown is supported
0%
or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment