[Haskell-cafe] Attach a finalizer to a FunPtr

Sylvain Henry sylvain at haskus.fr
Tue Sep 17 08:05:34 UTC 2019


Hi,

You can't attach a finalizer to an unpointed type (here Addr#). It 
explains the segfault.

You would have to attach the finalizer to `fptr` but it's quite fragile 
because GHC may remove the boxing in some cases.

Sylvain


On 17/09/2019 09:16, Roman Cheplyaka wrote:
>
> Hi all,
>
> I'd like to attach a finalizer to FunPtrs (which point to JIT-compiled 
> functions that need to be deallocated).
>
> However, the act of running the finalizer (no matter what it does) 
> results in a segfault.
>
> Here's a minimal example:
>
> {-# LANGUAGE UnboxedTuples, MagicHash #-}
> import GHC.Exts (FunPtr(..))
> import GHC.Base
> import Foreign.Ptr
> import System.Mem
>
> attachFinalizer :: FunPtr a -> IO () -> IO ()
> attachFinalizer fptr@(FunPtr addr) (IO fin) = IO $ \s0 ->
>   case mkWeak# addr fptr fin s0 of
>     (# s1, _ #) -> (# s1, () #)
>
> foreign import ccall "wrapper"
>   mkIO :: IO () -> IO (FunPtr (IO ()))
>
> main = do
>   fptr <- mkIO $ return ()
>   attachFinalizer fptr $ do
>     -- The exact contents of the finalizer doesn't seem to matter
>     putStrLn "+++ finalizer ran"
>     freeHaskellFunPtr fptr
>   putStrLn "+++ attached successfully"
>   performGC
>
> Is there a proper way to do this? (GHC 8.6.5)
>
> Roman
>
>
> _______________________________________________
> Haskell-Cafe mailing list
> To (un)subscribe, modify options or view archives go to:
> http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe
> Only members subscribed via the mailman list are allowed to post.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/haskell-cafe/attachments/20190917/350f89fa/attachment.html>


More information about the Haskell-Cafe mailing list