[Git][ghc/ghc][wip/keepAlive-optionB] 2 commits: base: Use keepAlive# in withForeignPtr

[Ben Gamari]

Ben Gamari pushed to branch wip/keepAlive-optionB at Glasgow Haskell Compiler / GHC


Commits:
c7fa0e40 by Ben Gamari at 2020-09-10T03:10:03+00:00
base: Use keepAlive# in withForeignPtr

- - - - -
2cc7cc8e by GHC GitLab CI at 2020-09-10T03:10:03+00:00
base: Make touchForeignPtr more robust

Previously touchForeignPtr would touch the ForeignPtr's
associated ForeignPtrContents. However, this is a normal constructor and
therefore can be eliminated by the simplifier. To ensure that the
foreign pointer's contents isn't dropped we need to rather `touch#` the
underlying array (which is the same thing that we key the `Weak` on when
adding finalizers).

- - - - -


2 changed files:

- libraries/base/Foreign/ForeignPtr/Imp.hs
- libraries/base/GHC/ForeignPtr.hs


Changes:

=====================================
libraries/base/Foreign/ForeignPtr/Imp.hs
=====================================
@@ -66,31 +66,6 @@ newForeignPtr finalizer p
        addForeignPtrFinalizer finalizer fObj
        return fObj
 
-withForeignPtr :: ForeignPtr a -> (Ptr a -> IO b) -> IO b
--- ^This is a way to look at the pointer living inside a
--- foreign object.  This function takes a function which is
--- applied to that pointer. The resulting 'IO' action is then
--- executed. The foreign object is kept alive at least during
--- the whole action, even if it is not used directly
--- inside. Note that it is not safe to return the pointer from
--- the action and use it after the action completes. All uses
--- of the pointer should be inside the
--- 'withForeignPtr' bracket.  The reason for
--- this unsafeness is the same as for
--- 'unsafeForeignPtrToPtr' below: the finalizer
--- may run earlier than expected, because the compiler can only
--- track usage of the 'ForeignPtr' object, not
--- a 'Ptr' object made from it.
---
--- This function is normally used for marshalling data to
--- or from the object pointed to by the
--- 'ForeignPtr', using the operations from the
--- 'Storable' class.
-withForeignPtr fo io
-  = do r <- io (unsafeForeignPtrToPtr fo)
-       touchForeignPtr fo
-       return r
-
 -- | This variant of 'newForeignPtr' adds a finalizer that expects an
 -- environment in addition to the finalized pointer.  The environment
 -- that will be passed to the finalizer is fixed by the second argument to


=====================================
libraries/base/GHC/ForeignPtr.hs
=====================================
@@ -3,6 +3,8 @@
 {-# LANGUAGE NoImplicitPrelude #-}
 {-# LANGUAGE UnboxedTuples #-}
 {-# LANGUAGE Unsafe #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE KindSignatures #-}
 
 {-# OPTIONS_HADDOCK not-home #-}
 
@@ -46,6 +48,7 @@ module GHC.ForeignPtr
         castForeignPtr,
         plusForeignPtr,
         -- * Finalization
+        withForeignPtr,
         touchForeignPtr,
         finalizeForeignPtr
         -- * Commentary
@@ -55,6 +58,7 @@ module GHC.ForeignPtr
 import Foreign.Storable
 import Data.Foldable    ( sequence_ )
 
+import GHC.Types
 import GHC.Show
 import GHC.Base
 import GHC.IORef
@@ -124,7 +128,7 @@ data ForeignPtrContents
     -- ^ The pointer refers to unmanaged memory that should not be freed when
     -- the 'ForeignPtr' becomes unreachable. Functions that add finalizers
     -- to a 'ForeignPtr' throw exceptions when the 'ForeignPtr' is backed by
-    -- 'PlainPtr'Most commonly, this is used with @Addr#@ literals.
+    -- 'PlainPtr'. Most commonly, this is used with @Addr#@ literals.
     -- See Note [Why FinalPtr].
     --
     -- @since 4.15
@@ -162,6 +166,7 @@ data ForeignPtrContents
     -- The invariants that apply to 'MallocPtr' apply to 'PlainPtr' as well.
 
 -- Note [Why FinalPtr]
+-- ~~~~~~~~~~~~~~~~~~~
 --
 -- FinalPtr exists as an optimization for foreign pointers created
 -- from Addr# literals. Most commonly, this happens in the bytestring
@@ -428,7 +433,7 @@ addForeignPtrConcFinalizer_ f@(MallocPtr fo r) finalizer = do
      else return ()
   where
     finalizer' :: State# RealWorld -> (# State# RealWorld, () #)
-    finalizer' = unIO (foreignPtrFinalizer r >> touch f)
+    finalizer' = unIO (foreignPtrFinalizer r >> touchForeignPtrContents f)
 
 addForeignPtrConcFinalizer_ _ _ =
   errorWithoutStackTrace "GHC.ForeignPtr: attempt to add a finalizer to plain pointer or a final pointer"
@@ -503,6 +508,36 @@ newForeignPtr_ (Ptr obj) =  do
   r <- newIORef NoFinalizers
   return (ForeignPtr obj (PlainForeignPtr r))
 
+withForeignPtr :: ForeignPtr a -> (Ptr a -> IO b) -> IO b
+-- ^This is a way to look at the pointer living inside a
+-- foreign object.  This function takes a function which is
+-- applied to that pointer. The resulting 'IO' action is then
+-- executed. The foreign object is kept alive at least during
+-- the whole action, even if it is not used directly
+-- inside. Note that it is not safe to return the pointer from
+-- the action and use it after the action completes. All uses
+-- of the pointer should be inside the
+-- 'withForeignPtr' bracket.  The reason for
+-- this unsafeness is the same as for
+-- 'unsafeForeignPtrToPtr' below: the finalizer
+-- may run earlier than expected, because the compiler can only
+-- track usage of the 'ForeignPtr' object, not
+-- a 'Ptr' object made from it.
+--
+-- This function is normally used for marshalling data to
+-- or from the object pointed to by the
+-- 'ForeignPtr', using the operations from the
+-- 'Storable' class.
+withForeignPtr fo@(ForeignPtr _ r) f = IO $ \s ->
+  case f (unsafeForeignPtrToPtr fo) of
+    IO action# ->
+      case r of
+        PlainForeignPtr ref -> keepAlive# ref s action#
+        FinalPtr -> action# s
+        MallocPtr mba _ -> keepAlive# mba s action#
+        PlainPtr mba -> keepAlive# mba s action#
+
+
 touchForeignPtr :: ForeignPtr a -> IO ()
 -- ^This function ensures that the foreign object in
 -- question is alive at the given place in the sequence of IO
@@ -528,10 +563,19 @@ touchForeignPtr :: ForeignPtr a -> IO ()
 -- result in artificial deadlock.  Another alternative is to use
 -- explicit reference counting.
 --
-touchForeignPtr (ForeignPtr _ r) = touch r
+touchForeignPtr (ForeignPtr _ r) = touchForeignPtrContents r
+
+touchForeignPtrContents :: ForeignPtrContents -> IO ()
+touchForeignPtrContents (PlainForeignPtr ref) = touchLifted  ref
+touchForeignPtrContents FinalPtr = return ()
+touchForeignPtrContents (MallocPtr mba _) = touchUnlifted mba
+touchForeignPtrContents (PlainPtr mba) = touchUnlifted mba
+
+touchLifted :: a -> IO ()
+touchLifted r = IO $ \s -> case touch# r s of s' -> (# s', () #)
 
-touch :: ForeignPtrContents -> IO ()
-touch r = IO $ \s -> case touch# r s of s' -> (# s', () #)
+touchUnlifted :: forall (a :: TYPE 'UnliftedRep). a -> IO ()
+touchUnlifted r = IO $ \s -> case touch# r s of s' -> (# s', () #)
 
 unsafeForeignPtrToPtr :: ForeignPtr a -> Ptr a
 -- ^This function extracts the pointer component of a foreign



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ef969940fbceddabb35a0d6055a991462fe7c608...2cc7cc8ec7c85457a5b59089d6f6efe6b5c9002e

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ef969940fbceddabb35a0d6055a991462fe7c608...2cc7cc8ec7c85457a5b59089d6f6efe6b5c9002e
You're receiving this email because of your account on gitlab.haskell.org.


-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20200910/af840a76/attachment-0001.html>