From aeb286a558180b83258acfa65784248a0e7923ee Mon Sep 17 00:00:00 2001 From: simonmar Date: Wed, 26 Mar 2003 15:25:46 +0000 Subject: [PATCH] [project @ 2003-03-26 15:25:46 by simonmar] Change our ForeignPtr implementation to match the spec: finalizers must now be foreign functions. Move the old Haskell-finalizer versions of newForeignPtr and addForeignPtrFinalizer into Foreign.Concurrent, to make it clear that the implementations of these functions require concurrency. While I'm here: move the GHC-specific parts of the ForeignPtr implementation into GHC.ForeignPtr. --- Foreign/Concurrent.hs | 32 ++++++ GHC/ForeignPtr.hs | 259 +++++++++++++++++++++++++++++++++++++++++++++++++ Text/Regex/Posix.hsc | 19 ---- 3 files changed, 291 insertions(+), 19 deletions(-) create mode 100644 Foreign/Concurrent.hs create mode 100644 GHC/ForeignPtr.hs diff --git a/Foreign/Concurrent.hs b/Foreign/Concurrent.hs new file mode 100644 index 0000000..6d484e0 --- /dev/null +++ b/Foreign/Concurrent.hs @@ -0,0 +1,32 @@ +{-# OPTIONS -fno-implicit-prelude #-} +----------------------------------------------------------------------------- +-- | +-- Module : Foreign.Concurrent +-- Copyright : (c) The University of Glasgow 2003 +-- License : BSD-style (see the file libraries/base/LICENSE) +-- +-- Maintainer : ffi@haskell.org +-- Stability : provisional +-- Portability : non-portable (requires concurrency) +-- +-- FFI datatypes and operations that use or require concurrency. +-- +----------------------------------------------------------------------------- + +module Foreign.Concurrent + ( + -- * Concurrency-based @ForeignPtr@ operations +#ifdef __GLASGOW_HASKELL__ + newForeignPtr, + addForeignPtrFinalizer, +#endif + ) where + +#ifdef __GLASGOW_HASKELL__ +import qualified GHC.ForeignPtr +#endif + +#ifdef __GLASGOW_HASKELL__ +newForeignPtr = GHC.ForeignPtr.newConcForeignPtr +addForeignPtrFinalizer = GHC.ForeignPtr.addForeignPtrConcFinalizer +#endif diff --git a/GHC/ForeignPtr.hs b/GHC/ForeignPtr.hs new file mode 100644 index 0000000..dad5f04 --- /dev/null +++ b/GHC/ForeignPtr.hs @@ -0,0 +1,259 @@ +{-# OPTIONS -fno-implicit-prelude #-} +----------------------------------------------------------------------------- +-- | +-- Module : GHC.ForeignPtr +-- Copyright : (c) The University of Glasgow, 1992-2003 +-- License : see libraries/base/LICENSE +-- +-- Maintainer : cvs-ghc@haskell.org +-- Stability : internal +-- Portability : non-portable (GHC extensions) +-- +-- GHC's implementation of the 'ForeignPtr' data type. +-- +----------------------------------------------------------------------------- + +module GHC.ForeignPtr + ( + ForeignPtr(..), + newForeignPtr, + mallocForeignPtr, + mallocForeignPtrBytes, + addForeignPtrFinalizer, + touchForeignPtr, + withForeignPtr, + foreignPtrToPtr, + castForeignPtr, + newConcForeignPtr, + addForeignPtrConcFinalizer, + ) where + +import Control.Monad ( sequence_ ) +import Foreign.Ptr +import Foreign.Storable +import Data.Dynamic + +import GHC.List ( null ) +import GHC.Base +import GHC.IOBase +import GHC.Ptr ( Ptr(..) ) +import GHC.Err +import GHC.Show + +-- |The type 'ForeignPtr' represents references to objects that are +-- maintained in a foreign language, i.e., that are not part of the +-- data structures usually managed by the Haskell storage manager. +-- The essential difference between 'ForeignPtr's and vanilla memory +-- references of type @Ptr a@ is that the former may be associated +-- with /finalisers/. A finaliser is a routine that is invoked when +-- the Haskell storage manager detects that - within the Haskell heap +-- and stack - there are no more references left that are pointing to +-- the 'ForeignPtr'. Typically, the finaliser will, then, invoke +-- routines in the foreign language that free the resources bound by +-- the foreign object. +-- +-- The 'ForeignPtr' is parameterised in the same way as 'Ptr'. The +-- type argument of 'ForeignPtr' should normally be an instance of +-- class 'Storable'. +-- +data ForeignPtr a + = ForeignPtr ForeignObj# !(IORef [IO ()]) + | MallocPtr (MutableByteArray# RealWorld) !(IORef [IO ()]) + +instance Eq (ForeignPtr a) where + p == q = foreignPtrToPtr p == foreignPtrToPtr q + +instance Ord (ForeignPtr a) where + compare p q = compare (foreignPtrToPtr p) (foreignPtrToPtr q) + +instance Show (ForeignPtr a) where + showsPrec p f = showsPrec p (foreignPtrToPtr f) + +#include "Dynamic.h" +INSTANCE_TYPEABLE1(ForeignPtr,foreignPtrTc,"ForeignPtr") + +newForeignPtr :: Ptr a -> FunPtr (Ptr a -> IO ()) -> IO (ForeignPtr a) +-- ^Turns a plain memory reference into a foreign object by +-- associating a finaliser - a foreign function given by the @FunPtr@ +-- - with the reference. The finaliser will be executed after the +-- last reference to the foreign object is dropped. Note that there +-- is no guarantee on how soon the finaliser is executed after the +-- last reference was dropped; this depends on the details of the +-- Haskell storage manager. The only guarantee is that the finaliser +-- runs before the program terminates. +newForeignPtr p finalizer + = do fObj <- mkForeignPtr p + addForeignPtrFinalizer fObj finalizer + return fObj + +newConcForeignPtr :: Ptr a -> IO () -> IO (ForeignPtr a) +-- ^Turns a plain memory reference into a foreign object +-- by associating a finaliser - given by the monadic operation +-- - with the reference. The finaliser will be executed after +-- the last reference to the foreign object is dropped. Note +-- that there is no guarantee on how soon the finaliser is +-- executed after the last reference was dropped; this depends +-- on the details of the Haskell storage manager. The only +-- guarantee is that the finaliser runs before the program +-- terminates. +-- +-- The finalizer, when invoked, will run in a separate thread. +-- +newConcForeignPtr p finalizer + = do fObj <- mkForeignPtr p + addForeignPtrConcFinalizer fObj 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. +-- +-- @mallocForeignPtr@ is equivalent to +-- +-- > do { p <- malloc; newForeignPtr p free } +-- +-- although it may be implemented differently internally. You may not +-- assume that the memory returned by 'mallocForeignPtr' has been +-- allocated with C's @malloc()@. +mallocForeignPtr = doMalloc undefined + where doMalloc :: Storable a => a -> IO (ForeignPtr a) + doMalloc a = do + r <- newIORef [] + IO $ \s -> + case newPinnedByteArray# size s of { (# s, mbarr# #) -> + (# s, MallocPtr mbarr# r #) + } + where (I# size) = sizeOf a + +-- | 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 [] + IO $ \s -> + case newPinnedByteArray# size s of { (# s, mbarr# #) -> + (# s, MallocPtr mbarr# r #) + } + +addForeignPtrFinalizer :: ForeignPtr a -> FunPtr (Ptr a -> IO ()) -> IO () +-- ^This function adds a finaliser to the given foreign object. The +-- finalizer will run /before/ all other finalizers for the same +-- object which have already been registered. +addForeignPtrFinalizer fptr finalizer = + addForeignPtrConcFinalizer fptr + (mkFinalizer finalizer (foreignPtrToPtr fptr)) + +addForeignPtrConcFinalizer :: ForeignPtr a -> IO () -> IO () +-- ^This function adds a finaliser to the given @ForeignPtr@. The +-- finalizer will run /before/ all other finalizers for the same +-- object which have already been registered. +-- +-- This is a variant of @addForeignPtrFinalizer@, where the finalizer +-- is an arbitrary @IO@ action. When it is invoked, the finalizer +-- will run in a new thread. +-- +addForeignPtrConcFinalizer f@(ForeignPtr fo r) finalizer = do + fs <- readIORef r + writeIORef r (finalizer : fs) + if (null fs) + then IO $ \s -> + let p = foreignPtrToPtr f in + case mkWeak# fo () (foreignPtrFinalizer r p) s of + (# s1, w #) -> (# s1, () #) + else return () +addForeignPtrConcFinalizer f@(MallocPtr fo r) finalizer = do + fs <- readIORef r + writeIORef r (finalizer : fs) + if (null fs) + then IO $ \s -> + let p = foreignPtrToPtr f in + case mkWeak# fo () (foreignPtrFinalizer r p) s of + (# s1, w #) -> (# s1, () #) + else return () + +foreign import ccall "dynamic" + mkFinalizer :: FunPtr (Ptr a -> IO ()) -> Ptr a -> IO () + +foreignPtrFinalizer :: IORef [IO ()] -> Ptr a -> IO () +foreignPtrFinalizer r p = do + fs <- readIORef r + sequence_ fs + +mkForeignPtr :: Ptr a -> IO (ForeignPtr a) {- not exported -} +mkForeignPtr (Ptr obj) = do + r <- newIORef [] + IO $ \ s# -> + case mkForeignObj# obj s# of + (# s1#, fo# #) -> (# s1#, ForeignPtr fo# r #) + +touchForeignPtr :: ForeignPtr a -> IO () +-- ^This function ensures that the foreign object in +-- question is alive at the given place in the sequence of IO +-- actions. In particular 'withForeignPtr' +-- does a 'touchForeignPtr' after it +-- executes the user action. +-- +-- This function can be used to express liveness +-- dependencies between 'ForeignPtr's: for +-- example, if the finalizer for one +-- 'ForeignPtr' touches a second +-- 'ForeignPtr', then it is ensured that the +-- second 'ForeignPtr' will stay alive at +-- least as long as the first. This can be useful when you +-- want to manipulate /interior pointers/ to +-- a foreign structure: you can use +-- 'touchForeignObj' to express the +-- requirement that the exterior pointer must not be finalized +-- until the interior pointer is no longer referenced. +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, () #) + +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 unsafety is the same as for +-- 'foreignPtrToPtr' 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 (foreignPtrToPtr fo) + touchForeignPtr fo + return r + +foreignPtrToPtr :: ForeignPtr a -> Ptr a +-- ^This function extracts the pointer component of a foreign +-- pointer. This is a potentially dangerous operations, as if the +-- argument to 'foreignPtrToPtr' is the last usage +-- occurence of the given foreign pointer, then its finaliser(s) will +-- be run, which potentially invalidates the plain pointer just +-- obtained. Hence, 'touchForeignPtr' must be used +-- wherever it has to be guaranteed that the pointer lives on - i.e., +-- has another usage occurrence. +-- +-- To avoid subtle coding errors, hand written marshalling code +-- should preferably use 'withForeignPtr' rather +-- than combinations of 'foreignPtrToPtr' and +-- 'touchForeignPtr'. However, the later routines +-- are occasionally preferred in tool generated marshalling code. +foreignPtrToPtr (ForeignPtr fo r) = Ptr (foreignObjToAddr# fo) +foreignPtrToPtr (MallocPtr fo r) = Ptr (byteArrayContents# (unsafeCoerce# fo)) + +castForeignPtr :: ForeignPtr a -> ForeignPtr b +-- ^This function casts a 'ForeignPtr' +-- parameterised by one type into another type. +castForeignPtr f = unsafeCoerce# f diff --git a/Text/Regex/Posix.hsc b/Text/Regex/Posix.hsc index 8d2fc53..506a9ef 100644 --- a/Text/Regex/Posix.hsc +++ b/Text/Regex/Posix.hsc @@ -56,29 +56,15 @@ regcomp -> Int -- ^ Flags (summed together) -> IO Regex -- ^ Returns: the compiled regular expression regcomp pattern flags = do -#ifdef __HUGS__ regex_fptr <- mallocForeignPtrBytes (#const sizeof(regex_t)) -#else - regex_ptr <- mallocBytes (#const sizeof(regex_t)) - regex_fptr <- newForeignPtr regex_ptr (regfree regex_ptr) -#endif /* __HUGS__ */ r <- withCString pattern $ \cstr -> withForeignPtr regex_fptr $ \p -> c_regcomp p cstr (fromIntegral flags) -#ifdef __HUGS__ addForeignPtrFinalizer regex_fptr ptr_regfree -#endif if (r == 0) then return (Regex regex_fptr) else error "Text.Regex.Posix.regcomp: error in pattern" -- ToDo -#ifndef __HUGS__ -regfree :: Ptr CRegex -> IO () -regfree p_regex = do - c_regfree p_regex - free p_regex -#endif /* __HUGS__ */ - -- ----------------------------------------------------------------------------- -- regexec @@ -174,13 +160,8 @@ type CRegMatch = () foreign import ccall unsafe "regcomp" c_regcomp :: Ptr CRegex -> CString -> CInt -> IO CInt -#ifdef __HUGS__ foreign import ccall unsafe "®free" ptr_regfree :: FunPtr (Ptr CRegex -> IO ()) -#else -foreign import ccall unsafe "regfree" - c_regfree :: Ptr CRegex -> IO () -#endif /* __HUGS__ */ foreign import ccall unsafe "regexec" c_regexec :: Ptr CRegex -> CString -> CSize -- 1.7.10.4