X-Git-Url: http://wien.tomnetworks.com/gitweb/?a=blobdiff_plain;f=Mate%2FGarbageAlloc.hs;h=aa2ed3f12c5377ae8943b6bcdaf4f54c4911818b;hb=58b7d15fa9d3089dc65fa0f9a0f4be3f8ddd35e6;hp=e7c1cc955a266ab09fb3691945fb8aadd1d5272d;hpb=94a3c50f1c43a7001791fed77560f268fc6d72a3;p=mate.git diff --git a/Mate/GarbageAlloc.hs b/Mate/GarbageAlloc.hs index e7c1cc9..aa2ed3f 100644 --- a/Mate/GarbageAlloc.hs +++ b/Mate/GarbageAlloc.hs @@ -1,12 +1,24 @@ {-# LANGUAGE ForeignFunctionInterface #-} {-# LANGUAGE CPP #-} #include "debug.h" -module Mate.GarbageAlloc where +module Mate.GarbageAlloc( + mallocClassData, + mallocStringGC, + mallocObjectGC, + getHeapMemory, + printMemoryUsage, + printGCStats, + mallocObjectUnmanaged, + mallocStringUnmanaged) where import Foreign import Foreign.C +import Mate.GC.Boehm + +#ifdef DBG_STR import Text.Printf +#endif import Mate.Debug -- unified place for allocating Memory @@ -15,23 +27,41 @@ import Mate.Debug mallocClassData :: Int -> IO (Ptr a) mallocClassData size = do printfStr "mallocClassData: %d\n" size - mallocBytes size + mem <- mallocBytes size + addRootGC mem (plusPtr mem size) + return mem -mallocString :: Int -> IO (Ptr a) -mallocString size = do +mallocStringGC :: Int -> IO (Ptr a) +mallocStringGC size = do printfStr "mallocString: %d\n" size - mallocBytes size + mallocBytesGC size -foreign export ccall mallocObject :: Int -> IO CPtrdiff -mallocObject :: Int -> IO CPtrdiff -mallocObject size = do - ptr <- mallocBytes size +foreign export ccall mallocObjectGC :: Int -> IO CPtrdiff +mallocObjectGC :: Int -> IO CPtrdiff +mallocObjectGC size = do + ptr <- mallocBytesGC size printfStr "mallocObject: %d\n" size return $ fromIntegral $ ptrToIntPtr ptr --- TODO: delete me -foreign export ccall demoInterfaceCall :: CUInt -> IO () -demoInterfaceCall :: CUInt -> IO () -demoInterfaceCall val = do - printf "demoInterfaceCall: 0x%08x\n" (fromIntegral val :: Word32) - return () +mallocObjectUnmanaged :: Int -> IO CPtrdiff +mallocObjectUnmanaged size = do + ptr <- mallocBytes size + printfStr "mallocObjectUnmanged: %d\n" size + return $ fromIntegral $ ptrToIntPtr ptr + +mallocStringUnmanaged :: Int -> IO (Ptr a) +mallocStringUnmanaged size = do + printfStr "mallocStringUnamaged: %d\n" size + mallocBytes size + + +getHeapMemory :: IO Int +getHeapMemory = getHeapSizeGC + +foreign export ccall printMemoryUsage :: IO () +printMemoryUsage :: IO () +printMemoryUsage = getHeapMemory >>= print + +foreign export ccall printGCStats :: IO () +printGCStats :: IO () +printGCStats = putStrLn "Should print GC Stats"