<html>
<head>
<meta http-equiv="content-type" content="text/html; charset=UTF-8">
</head>
<body text="#000000" bgcolor="#FFFFFF">
<p><font face="Helvetica, Arial, sans-serif">Hi all,<br>
</font></p>
<p><font face="Helvetica, Arial, sans-serif">I'd like to attach a
finalizer to FunPtrs (which point to JIT-compiled functions that
need to be deallocated).</font></p>
<p><font face="Helvetica, Arial, sans-serif">However, the act of
running the finalizer (no matter what it does) results in a
segfault.<br>
</font></p>
<p><font face="Helvetica, Arial, sans-serif">Here's a minimal
example:<br>
</font></p>
<p><tt>{-# LANGUAGE UnboxedTuples, MagicHash #-}</tt><br>
<tt>import GHC.Exts (FunPtr(..))</tt><br>
<tt>import GHC.Base</tt><br>
<tt>import Foreign.Ptr</tt><br>
<tt>import System.Mem</tt><br>
<br>
<tt>attachFinalizer :: FunPtr a -> IO () -> IO ()</tt><br>
<tt>attachFinalizer fptr@(FunPtr addr) (IO fin) = IO $ \s0 -></tt><br>
<tt> case mkWeak# addr fptr fin s0 of</tt><br>
<tt> (# s1, _ #) -> (# s1, () #)</tt><br>
<br>
<tt>foreign import ccall "wrapper"</tt><br>
<tt> mkIO :: IO () -> IO (FunPtr (IO ()))</tt><br>
<br>
<tt>main = do</tt><br>
<tt> fptr <- mkIO $ return ()</tt><br>
<tt> attachFinalizer fptr $ do</tt><br>
<tt> -- The exact contents of the finalizer doesn't seem to
matter</tt><br>
<tt> putStrLn "+++ finalizer ran"</tt><br>
<tt> freeHaskellFunPtr fptr</tt><br>
<tt> putStrLn "+++ attached successfully"</tt><br>
<tt> performGC</tt></p>
<p><font face="Helvetica, Arial, sans-serif">Is there a proper way
to do this? (GHC 8.6.5)<br>
</font></p>
<p><font face="Helvetica, Arial, sans-serif">Roman<br>
</font></p>
</body>
</html>