[Haskell-cafe] Finding Memory Leaks

SevenThunders mattcbro at earthlink.net
Thu Nov 2 21:46:56 EST 2006



SevenThunders wrote:
> 
>   All my code is compiled using the -prof -auto 
> flag and then run using +RTS -hc -RTS.  The resulting plots do not show 
> a linear increase in heap usage, although the Windows XP operating 
> system does report such an increase.
> 
> 

This is either a bug in GHC or a bug in the profiler or both unless I am
mistaken.  
The bug seems to arise when using FFI and using the wrapper mode for  a
Haskell callback.
A pointer to the Haskell wrapper is created on the fly and then supposedly
released by freeHaskellFunPtr.

Unfortunately, at least under Windows XP 64 on my amd x2 3800 box, memory
grows without bound.  Even worse, however is the fact that profiling this
function does not reveal the leak at all.  It shows a constant memory
profile.

Here is the Haskell program.  The actual c program containing cfunc is not
really used in this snippet. (and I can't quite get that to work in this
case for some reason.)

<leaky.hs>
module Main where
import Foreign
import Foreign.Ptr
import Foreign.Storable

-- | A convenient type synonym for storable arrays
type Darr = Ptr (Double)
-- | Function type for mapping doubles to doubles
type Dfunc = Double -> Double
-- | A convenient type synonym for  monad containing storable arrays
type IODarr = IO (Darr)


foreign import ccall "wrapper" mkDfunc :: Dfunc -> IO (FunPtr Dfunc)
foreign import ccall "cleaky.h cfunc" cfunc :: (FunPtr Dfunc) -> IO ( Double
)


dadd :: Dfunc
dadd x = x + 1.0

getleaky :: Dfunc -> IO ()
getleaky cf = do
	pcf <- mkDfunc cf
	-- pd <- cfunc pcf 
	print pcf
	freeHaskellFunPtr pcf


main = sequence_ [getleaky dadd | q <- [1..500000]]


I compile this with
ghc -c cleaky.c
ghc -fglasgow-exts -fffi -prof -auto -I. --make  leaky.hs cleaky.o

and run it with
leaky +RTS -hc -RTS

<cleaky.c>
#include <math.h>
#include <stdio.h>
#include "cleaky.h"


double state = 1.0 ;

double cfunc(DFptr fptr)
{
// printf("In cfunc, fptr: %p\n", fptr) ;
state = (*fptr) (state) ;
// printf("state: %g\n", state) ;
return(state) ;
}


and <cleaky.h>
typedef double (*DFptr) (double) ;
double cfunc(DFptr) ;


The C code as I said isn't really used.  Is there a workaround for this? 
Perhaps some other way to free the function pointer?



-- 
View this message in context: http://www.nabble.com/Finding-Memory-Leaks-tf2563630.html#a7150682
Sent from the Haskell - Haskell-Cafe mailing list archive at Nabble.com.



More information about the Haskell-Cafe mailing list