From d1acec71b0610d8cfe39ba5171370e49e133d41e Mon Sep 17 00:00:00 2001
From: simonmar <unknown>
Date: Thu, 21 Jul 2005 10:00:34 +0000
Subject: [PATCH] [project @ 2005-07-21 10:00:34 by simonmar] Further
 optimisations to ForeignPtr: now we don't allocate the
 IORef for a ForeignPtr without a finalizer.

---
 GHC/ForeignPtr.hs |   66 +++++++++++++++++++++++++++++------------------------
 1 file changed, 36 insertions(+), 30 deletions(-)

diff --git a/GHC/ForeignPtr.hs b/GHC/ForeignPtr.hs
index ff66aa7..9a83c25 100644
--- a/GHC/ForeignPtr.hs
+++ b/GHC/ForeignPtr.hs
@@ -34,7 +34,6 @@ import Control.Monad 	( sequence_ )
 import Foreign.Ptr
 import Foreign.Storable
 
-import GHC.List  	( null )
 import GHC.Base
 import GHC.IOBase
 import GHC.STRef	( STRef(..) )
@@ -70,8 +69,13 @@ data ForeignPtr a = ForeignPtr Addr# ForeignPtrContents
 	-- attached to is kept alive.
 
 data ForeignPtrContents 
-  = PlainForeignPtr !(IORef [IO ()])
-  | MallocPtr (MutableByteArray# RealWorld) !(IORef [IO ()])
+  = PlainNoFinalizer
+  | PlainWithFinalizer     !(IORef [IO ()])
+  | MallocPtrNoFinalizer   (MutableByteArray# RealWorld)
+  | MallocPtrWithFinalizer (MutableByteArray# RealWorld) !(IORef [IO ()])
+  -- we optimise the no-finalizer case, which is especially common
+  -- with a MallocPtr.  mallocForeignPtr doesn't have to create an
+  -- IORef, or set up a weak pointer.
 
 instance Eq (ForeignPtr a) where
     p == q  =  unsafeForeignPtrToPtr p == unsafeForeignPtrToPtr q
@@ -117,11 +121,10 @@ mallocForeignPtr :: Storable a => IO (ForeignPtr a)
 mallocForeignPtr = doMalloc undefined
   where doMalloc :: Storable b => b -> IO (ForeignPtr b)
         doMalloc a = do
-  	  r <- newIORef []
 	  IO $ \s ->
 	    case newPinnedByteArray# size s of { (# s, mbarr# #) ->
 	     (# s, ForeignPtr (byteArrayContents# (unsafeCoerce# mbarr#))
-		     	      (MallocPtr mbarr# r) #)
+		     	      (MallocPtrNoFinalizer mbarr#) #)
             }
 	    where (I# size) = sizeOf a
 
@@ -129,11 +132,10 @@ mallocForeignPtr = doMalloc undefined
 -- size of the memory required is given explicitly as a number of bytes.
 mallocForeignPtrBytes :: Int -> IO (ForeignPtr a)
 mallocForeignPtrBytes (I# size) = do 
-  r <- newIORef []
   IO $ \s ->
      case newPinnedByteArray# size s      of { (# s, mbarr# #) ->
        (# s, ForeignPtr (byteArrayContents# (unsafeCoerce# mbarr#))
-		        (MallocPtr mbarr# r) #)
+		        (MallocPtrNoFinalizer mbarr#) #)
      }
 
 addForeignPtrFinalizer :: FinalizerPtr a -> ForeignPtr a -> IO ()
@@ -162,23 +164,26 @@ addForeignPtrConcFinalizer :: ForeignPtr a -> IO () -> IO ()
 addForeignPtrConcFinalizer (ForeignPtr a c) finalizer = 
   addForeignPtrConcFinalizer_ c finalizer
 
-addForeignPtrConcFinalizer_ f@(PlainForeignPtr r) finalizer = do
-  fs <- readIORef r
-  writeIORef r (finalizer : fs)
-  if (null fs)
-     then IO $ \s ->
-	      case r of { IORef (STRef r#) ->
+addForeignPtrConcFinalizer_ PlainNoFinalizer finalizer = do
+  r <- newIORef []
+  IO $ \s ->  case r of { IORef (STRef r#) ->
 	      case mkWeak# r# () (foreignPtrFinalizer r) s of {  (# s1, w #) ->
 	      (# s1, () #) }}
-     else return ()
-addForeignPtrConcFinalizer_ f@(MallocPtr fo r) finalizer = do 
+  addForeignPtrConcFinalizer_ (PlainWithFinalizer r) finalizer
+
+addForeignPtrConcFinalizer_ f@(PlainWithFinalizer r) finalizer = do
   fs <- readIORef r
   writeIORef r (finalizer : fs)
-  if (null fs)
-     then  IO $ \s -> 
-	       case mkWeak# fo () (do foreignPtrFinalizer r; touch f) s of
+
+addForeignPtrConcFinalizer_ f@(MallocPtrNoFinalizer fo) finalizer = do
+  r <- newIORef []
+  IO $ \s -> case mkWeak# fo () (do foreignPtrFinalizer r; touch f) s of
 		  (# s1, w #) -> (# s1, () #)
-     else return ()
+  addForeignPtrConcFinalizer_ (MallocPtrWithFinalizer fo r) finalizer
+
+addForeignPtrConcFinalizer_ f@(MallocPtrWithFinalizer fo r) finalizer = do 
+  fs <- readIORef r
+  writeIORef r (finalizer : fs)
 
 foreign import ccall "dynamic" 
   mkFinalizer :: FinalizerPtr a -> Ptr a -> IO ()
@@ -189,9 +194,7 @@ foreignPtrFinalizer r = do fs <- readIORef r; sequence_ fs
 newForeignPtr_ :: Ptr a -> IO (ForeignPtr a)
 -- ^Turns a plain memory reference into a foreign pointer that may be
 -- associated with finalizers by using 'addForeignPtrFinalizer'.
-newForeignPtr_ (Ptr obj) =  do
-  r <- newIORef []
-  return (ForeignPtr obj (PlainForeignPtr r))
+newForeignPtr_ (Ptr obj) = return (ForeignPtr obj PlainNoFinalizer)
 
 touchForeignPtr :: ForeignPtr a -> IO ()
 -- ^This function ensures that the foreign object in
@@ -246,11 +249,14 @@ castForeignPtr f = unsafeCoerce# f
 -- | Causes the finalizers associated with a foreign pointer to be run
 -- immediately.
 finalizeForeignPtr :: ForeignPtr a -> IO ()
-finalizeForeignPtr (ForeignPtr _ foreignPtr) = do
-	finalizers <- readIORef refFinalizers
-	sequence_ finalizers
-	writeIORef refFinalizers []
-	where
-		refFinalizers = case foreignPtr of
-			(PlainForeignPtr ref) -> ref
-			(MallocPtr  _ ref) -> ref
+finalizeForeignPtr (ForeignPtr _ contents) = do
+  case contents of
+    PlainNoFinalizer           -> return ()
+    PlainWithFinalizer r       -> runFinalizers r
+    MallocPtrNoFinalizer _     -> return ()
+    MallocPtrWithFinalizer _ r -> runFinalizers r
+ where
+   runFinalizers r = do 
+     fs <- readIORef r
+     sequence_ fs
+     writeIORef r []
-- 
1.7.10.4