[project @ 2003-09-10 11:46:58 by simonmar]

The finalizer for a ForeignPtr created with mallocForeignPtr better
"touch#" the MutableByteArray# after running the other finalizers,
otherwise the memory might be garbage collected before we've finished
running the finalizers.

This can cause crashes if you add any extra finalizers to a ForeignPtr
created with mallocForeignPtr.

SourceForge bug: #802692

diff --git a/GHC/ForeignPtr.hs b/GHC/ForeignPtr.hs
index f67e67f..0069de2 100644 (file)
--- a/GHC/ForeignPtr.hs
+++ b/GHC/ForeignPtr.hs
@@ -159,7 +159,8 @@ addForeignPtrConcFinalizer f@(MallocPtr fo r) finalizer = do
   if (null fs)
      then  IO $ \s -> 
               let p = unsafeForeignPtrToPtr f in
-              case mkWeak# fo () (foreignPtrFinalizer r p) s of 
+              case mkWeak# fo () (do foreignPtrFinalizer r p
+                                     touchPinnedByteArray# fo) s of 
                  (# s1, w #) -> (# s1, () #)
      else return ()
 
@@ -180,6 +181,9 @@ newForeignPtr_ (Ptr obj) =  do
     case mkForeignObj# obj s# of
       (# s1#, fo# #) -> (# s1#,  ForeignPtr fo# r #)
 
+touchPinnedByteArray# :: MutableByteArray# RealWorld -> IO ()
+touchPinnedByteArray# ba# = IO $ \s -> case touch# ba# s of s -> (# s, () #)
+
 touchForeignPtr :: ForeignPtr a -> IO ()
 -- ^This function ensures that the foreign object in
 -- question is alive at the given place in the sequence of IO
@@ -202,7 +206,7 @@ touchForeignPtr :: ForeignPtr a -> IO ()
 touchForeignPtr (ForeignPtr fo r)
    = IO $ \s -> case touch# fo s of s -> (# s, () #)
 touchForeignPtr (MallocPtr fo r)
-   = IO $ \s -> case touch# fo s of s -> (# s, () #)
+   = touchPinnedByteArray# fo
 
 unsafeForeignPtrToPtr :: ForeignPtr a -> Ptr a
 -- ^This function extracts the pointer component of a foreign