[project @ 2004-02-12 21:23:48 by krasimir]

[ghc-base.git] / GHC / ForeignPtr.hs

diff --git a/GHC/ForeignPtr.hs b/GHC/ForeignPtr.hs
index f67e67f..216f578 100644 (file)
--- a/GHC/ForeignPtr.hs
+++ b/GHC/ForeignPtr.hs
@@ -97,16 +97,16 @@ newConcForeignPtr p finalizer
        return fObj
 
 mallocForeignPtr :: Storable a => IO (ForeignPtr a)
--- ^ allocates some memory and returns a ForeignPtr to it.  The memory
--- will be released automatically when the ForeignPtr is discarded.
+-- ^ Allocate some memory and return a 'ForeignPtr' to it.  The memory
+-- will be released automatically when the 'ForeignPtr' is discarded.
 --
--- @mallocForeignPtr@ is equivalent to
+-- 'mallocForeignPtr' is equivalent to
 --
--- >    do { p <- malloc; newForeignPtr p free }
+-- >    do { p <- malloc; newForeignPtr finalizerFree p }
 -- 
--- although it may be implemented differently internally.  You may not
+-- although it may be implemented differently internally: you may not
 -- assume that the memory returned by 'mallocForeignPtr' has been
--- allocated with C's @malloc()@.
+-- allocated with 'Foreign.Marshal.Alloc.malloc'.
 mallocForeignPtr = doMalloc undefined
   where doMalloc :: Storable a => a -> IO (ForeignPtr a)
         doMalloc a = do
@@ -117,8 +117,8 @@ mallocForeignPtr = doMalloc undefined
             }
            where (I# size) = sizeOf a
 
--- | similar to 'mallocForeignPtr', except that the size of the memory required
--- is given explicitly as a number of bytes.
+-- | This function is similar to 'mallocForeignPtr', except that the
+-- size of the memory required is given explicitly as a number of bytes.
 mallocForeignPtrBytes :: Int -> IO (ForeignPtr a)
 mallocForeignPtrBytes (I# size) = do 
   r <- newIORef []
@@ -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