+{-# LANGUAGE ForeignFunctionInterface #-}
{-# LANGUAGE CPP #-}
module Mate.GC.Boehm (
mallocBytesGC,
unsafeFreeGC,
getHeapSize,
+ initGC,
+ addRootGC,
) where
#define DEBUG
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 :: CSize -> IO (Ptr a)
+
+foreign import ccall "gc/gc.h GC_get_heap_size"
+ heapSizeGC :: IO CSize
+
+
+foreign import ccall "gc/gc.h GC_init"
+ initGC :: IO ()
+
+
+foreign import ccall "gc/gc.h GC_add_roots"
+ addRootGCInternal :: Ptr a -> Ptr a -> IO ()
-- counts allocated memory in heap
{-# NOINLINE globalBytesAllocated #-}
#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 (fromIntegral size)
+ if ptr == nullPtr
+ then error "alloc 0"
+ else return ptr
+
#else
-- |Allocates size bytes in managed memory
mallocBytesGC :: Int -> IO (Ptr a)
-mallocBytesGC = mallocBytes
+mallocBytesGC = mallocGC . fromIntegral
#endif
-- |Explicitely deallocate an object. Not required and dangerous.
-- |Returns currently allocated memory in bytes
getHeapSize :: IO Int
-getHeapSize = readIORef globalBytesAllocated
+getHeapSize = liftM fromIntegral heapSizeGC
+
+addRootGC :: Ptr a -> Ptr a -> IO ()
+addRootGC = addRootGCInternal