
Hello again, I've tried the simplest possible reference counting approach which should be OK if all finalisers are run eventually (as I think is the case currently with ghc 6.2). But I don't seem to be able to get it to work. I've attached the library reference counting code (LibRef module) to the end of this message. Intended use is something like this... {-# notInline libXYZRef #-} libXYZRef :: LibRef libXYZRef = unsafePerformIO newLibRef main :: IO () main = finally (initLibXYZ >> userMain) (killLibRef libXYZRef shutDownLibXYZ) -- initLibXYZ and shutDownLibXYZ are Haskell bindings to functions supplied -- by libXYZ userMain :: IO () -- userMain creates ForeignPtrs to library objects using addLibRef I'm testing by creating 1 ForeignPtr reference using addLibRef and dropping it immediately thereafter (so it's garbage, but not detected as such immediately). Running with the -B rts option tells me when garbage collection has occured. The problem is I get a "fail: <<loop>>" error if no garbage collection has occured when killLibRef is called (I.E. killLibRef saves shutDownLibXYZ for later use because the reference count is non-zero). But everything works fine if I wait for garbage collection to occur before calling killLibRef. Does anybody have any idea what might be going wrong here? Personally I'm a bit suspicious of the use of the cToH and hToC functions in addLibRef, but I'm not aware of any alternative if you want to mix in some Haskell code with a finaliser. Thanks for any advice. LibRef code follows below.. module LibRef (LibRef -- data LibRef ,newLibRef -- IO LibRef ,addLibRef -- LibRef -> FinalizerPtr a -> Ptr a -> IO (ForeignPtr a) ,killLibRef -- LibRef -> IO () -> IO () ) where import Data.IORef import Foreign.Ptr import Foreign.ForeignPtr import Control.Concurrent.MVar foreign import ccall "dynamic" cToH :: FinalizerPtr a -> (Ptr a -> IO ()) foreign import ccall "wrapper" hToC :: (Ptr a -> IO ()) -> IO (FinalizerPtr a) newtype LibRef = LibRef (MVar Int -- Reference count (and lock) ,IORef (IO ()) -- Shutdown action ) -- Create a new LibRef newLibRef :: IO LibRef newLibRef = do countRef <- newMVar 0 -- No references killitRef <- newIORef $ return () -- No shutdown action initially return $ LibRef (countRef,killitRef) -- Similar to newForeignPtr. Creates a ForeignPtr reference to a library -- object and increments the LibRef reference count. The actual finaliser -- used runs the suppied finaliser (second arg) and then decrements the -- LibRef reference count. addLibRef :: LibRef -> FinalizerPtr a -> Ptr a -> IO (ForeignPtr a) addLibRef libRef@(LibRef (countMVar,_)) finalise ptr = do finalise' <- hToC $ \p -> do cToH finalise p decLibRef libRef count <- takeMVar countMVar -- Read (and lock) putMVar countMVar $! (count+1) -- Increment (and unlock) newForeignPtr finalise' ptr -- Decrement a LibRef reference count. If the resulting reference -- count is zero whatever action is stored in killitRef is executed -- (and killitRef is reset to return ()) decLibRef :: LibRef -> IO () decLibRef (LibRef (countMVar,killitRef)) = do putStrLn "<decLibRef>" count <- takeMVar countMVar -- Read and lock case count of 0 -> error "decLibRef applied to zero reference count" 1 -> do killit <- readIORef killitRef -- Get configured kill writeIORef killitRef $ return () -- Reset killitRef putMVar countMVar 0 -- Reset and unlock killit -- Kill it putStrLn "<No Refs>" _ -> putMVar countMVar $! (count-1) -- Decrement and unlock -- Call this when the library is no longer needed. -- Second Arg is library shutdown action. This is performed immediately -- if reference count == 0. Otherwise it is stored and executed by the -- last finaliser (when reference count hits 0). killLibRef :: LibRef -> IO () -> IO () killLibRef (LibRef (countMVar,killitRef)) killit = do count <- takeMVar countMVar -- Read and lock if count == 0 then do writeIORef killitRef $ return () -- Reset killitRef putMVar countMVar count -- Unlock killit -- Execute now putStrLn "<Killed now>" else do writeIORef killitRef killit -- Save for later putMVar countMVar count -- Unlock putStrLn "<Killed later>" Regards -- Adrian Hey