implemented Setup.hs to build boehm cpp libs and install them;

[hs-boehmgc.git] / src / Mate / GC / Boehm.hs

diff --git a/src/Mate/GC/Boehm.hs b/src/Mate/GC/Boehm.hs
index eb5711b169a9ef871aae58e411c5fe9e977c9287..360568c0e2311613d64509075e7a6bfe1b95c7f2 100644 (file)
--- a/src/Mate/GC/Boehm.hs
+++ b/src/Mate/GC/Boehm.hs
@@ -1,8 +1,11 @@
+{-# LANGUAGE ForeignFunctionInterface #-}
 {-# LANGUAGE CPP #-}
 module Mate.GC.Boehm (
      mallocBytesGC,
      unsafeFreeGC,
-     getHeapSize,
+     getHeapSizeGC,
+     initGC,
+     addRootGC,
   ) where
 
 #define DEBUG
@@ -11,20 +14,44 @@ import Foreign.Marshal.Alloc
 import Foreign.Ptr
 import Data.IORef
 import System.IO.Unsafe
+import Foreign.C.Types
+import Control.Monad
+
+foreign import ccall "gc/gc.h GC_malloc"
+   mallocGC_c :: CSize -> IO (Ptr a) 
+
+foreign import ccall "gc/gc.h GC_get_heap_size"
+   heapSizeGC_c :: IO CSize
+
+foreign import ccall "gc/gc.h GC_init"
+   initGC_c :: IO ()
+
+foreign import ccall "gc/gc.h GC_add_roots"
+   addRootGCInternal_c :: Ptr a -> Ptr a -> IO ()
 
 -- counts allocated memory in heap
 {-# NOINLINE globalBytesAllocated #-}
 globalBytesAllocated :: IORef Int
 globalBytesAllocated = unsafePerformIO (newIORef 0)
 
+-- |Initializs the GC. Should be called before mallocBytesGC
+initGC :: IO ()
+initGC = initGC_c
+
 #ifdef DEBUG
 -- |Allocates size bytes in managed memory
 mallocBytesGC :: Int -> IO (Ptr a)
-mallocBytesGC size = modifyIORef globalBytesAllocated (+ size) >> mallocBytes size
+mallocBytesGC size = do
+  --print "trying alloc"
+  ptr <- modifyIORef globalBytesAllocated (+ size) >> mallocGC_c (fromIntegral size)
+  if ptr == nullPtr 
+   then error "mallocBytes asked memory management for memory but returned nullPtr. (see BoehmGC)"
+   else return ptr
+
 #else
 -- |Allocates size bytes in managed memory
 mallocBytesGC :: Int -> IO (Ptr a)
-mallocBytesGC = mallocBytes
+mallocBytesGC = mallocGC_c . fromIntegral
 #endif
 
 -- |Explicitely deallocate an object. Not required and dangerous.
@@ -32,5 +59,9 @@ unsafeFreeGC :: Ptr a -> IO ()
 unsafeFreeGC _ = print "not implemented"
 
 -- |Returns currently allocated memory in bytes
-getHeapSize :: IO Int
-getHeapSize = readIORef globalBytesAllocated
+getHeapSizeGC :: IO Int
+getHeapSizeGC = liftM fromIntegral heapSizeGC_c
+
+-- |Adds a memory segment to be GC root
+addRootGC :: Ptr a -> Ptr a -> IO ()
+addRootGC = addRootGCInternal_c