ghc 5.02.2 FFI question
Bernard James POPE
bjpop@cs.mu.OZ.AU
Mon, 8 Apr 2002 15:17:47 +1000 (EST)
Hi All,
I've been playing with the FFI in GHC 5.02.2
I'm not sure if I'm using it correctly because I get a space leak
in my program.
Okay, very simply I want to construct a Haskell value from
within a C function and pass it back to Haskell. In the
following program I have an algebraic type called "Simple",
which has one unary constructor "K". The idea is to pass a Stable
pointer to K to the C code, and use rts_apply() to generate
an application of the constructor and then use getStablePtr()
to pass a stable pointer to the application back to Haskell.
version of GHC is 5.02.2, operating system is Debian linux
(woody), kernel 2.2.19, gcc version 2.95.4
Here's the Haskell code:
--------------------------------------------------------------------------------
-- file: Main.hs
module Main where
import Foreign
data Simple = K Double
deriving (Show)
-- first argument is a stable pointer to the constructor K
-- result is a stable pointer to an application of K to a
-- Double argument
foreign import "leak"
leak :: StablePtr (Double -> Simple) -> IO (StablePtr Simple)
-- this is the important bit
callLeak :: IO ()
callLeak = do kSPtr <- newStablePtr K
simpleSPtr <- leak kSPtr
simpleVal <- deRefStablePtr simpleSPtr
freeStablePtr kSPtr
freeStablePtr simpleSPtr
print simpleVal
main :: IO ()
main = repeatIO 100000 callLeak
-- perform an IO action n times
repeatIO :: Int -> IO () -> IO ()
repeatIO n io
| n > 0 = do {io; repeatIO (n-1) io}
| n == 0 = return ()
| otherwise = error $ "repeatIO: negative argument"
--------------------------------------------------------------------------------
Here's the C code that implements the function leak():
--------------------------------------------------------------------------------
/* file: LeakC.c */
/* paths are hardwired at the moment */
#include "/home/bjpop/ghc-5.02.2/ghc/includes/Rts.h"
#include "/home/bjpop/ghc-5.02.2/ghc/includes/RtsAPI.h"
#include "LeakC.h" /* this just has the prototype for leak() */
StgStablePtr leak (StgStablePtr k_Ptr)
{
HaskellObj k;
StgClosure *num;
/* find the data constructor K, by dereferencing */
/* the stable pointer to it */
k = (HaskellObj) deRefStablePtr (k_Ptr);
/* make some arbitrary Haskell Double value */
num = rts_mkDouble(230489.0923);
/* I'm a bit worried about this last line of code */
/* --- is this reasonable to do? */
/* apply K to the Double and return a stable pointer */
/* to the result */
return (getStablePtr ((StgPtr)(rts_apply (k, num))));
}
--------------------------------------------------------------------------------
Here's how I compile things:
ghc -c LeakC.c
ghc -package lang -fglasgow-exts -c Main.hs
ghc -package lang -fglasgow-exts Main.o LeakC.o
--------------------------------------------------------------------------------
And now some comments:
Testing indicates that memory leaks proportionally to the number
of times I call leak() (linear, I mean).
My suspicion is that either I am doing something very stupid, and or
data is not being collected completely after the stable pointers are
freed. Note that I am careful to free every stable pointer that I allocate.
I tried to dump the stable pointer table each time around to see whether
there was anything obvious. My intial investigation did not show much,
but I haven't looked too deeply.
If I don't call the leak() function, but just construct a Simple
value in the usual Haskell way the space leak disappears (even if I follow
the newStablePtr/freeStablePtr route).
The leak persists regardless of whether the result of calling the
foreign function is in the IO monad or not.
If it turns out that I am being stupid then I would appreciate some
advice on how to achieve the desired outcome but no space leak.
Alternatively, if my program is "reasonable" then I am happy to dive further
into debugging it, but I didn't want to spend any more hours trying
to find a bug if there actually isn't one to find.
Thanks heaps, and sorry for the length of the post.
Ooroo,
Bernie.