X-Git-Url: http://wien.tomnetworks.com/gitweb/?p=hs-boehmgc.git;a=blobdiff_plain;f=src%2FMate%2FGC%2FBoehm.hs;fp=src%2FMate%2FGC%2FBoehm.hs;h=eb5711b169a9ef871aae58e411c5fe9e977c9287;hp=0000000000000000000000000000000000000000;hb=c0b90dd3b13b6c926d9f31654957715c2c63f530;hpb=7ac91566d88541270138882e9ae0416872eb21ad

diff --git a/src/Mate/GC/Boehm.hs b/src/Mate/GC/Boehm.hs
new file mode 100644
index 0000000..eb5711b
--- /dev/null
+++ b/src/Mate/GC/Boehm.hs
@@ -0,0 +1,36 @@
+{-# LANGUAGE CPP #-}
+module Mate.GC.Boehm (
+     mallocBytesGC,
+     unsafeFreeGC,
+     getHeapSize,
+  ) where
+
+#define DEBUG
+
+import Foreign.Marshal.Alloc
+import Foreign.Ptr
+import Data.IORef
+import System.IO.Unsafe
+
+-- counts allocated memory in heap
+{-# NOINLINE globalBytesAllocated #-}
+globalBytesAllocated :: IORef Int
+globalBytesAllocated = unsafePerformIO (newIORef 0)
+
+#ifdef DEBUG
+-- |Allocates size bytes in managed memory
+mallocBytesGC :: Int -> IO (Ptr a)
+mallocBytesGC size = modifyIORef globalBytesAllocated (+ size) >> mallocBytes size
+#else
+-- |Allocates size bytes in managed memory
+mallocBytesGC :: Int -> IO (Ptr a)
+mallocBytesGC = mallocBytes
+#endif
+
+-- |Explicitely deallocate an object. Not required and dangerous.
+unsafeFreeGC :: Ptr a -> IO ()
+unsafeFreeGC _ = print "not implemented"
+
+-- |Returns currently allocated memory in bytes
+getHeapSize :: IO Int
+getHeapSize = readIORef globalBytesAllocated