Mate/GarbageAlloc.hs

   1 {-# LANGUAGE ForeignFunctionInterface #-}
   2 {-# LANGUAGE CPP #-}
   3 #include "debug.h"
   4 module Mate.GarbageAlloc(
   5     mallocClassData,
   6     mallocString,
   7     mallocObject,
   8     getHeapMemory,
   9     printMemoryUsage,
  10     mallocStringVM,
  11     mallocObjectVM)  where
  12
  13 import Foreign
  14 import Foreign.C
  15
  16 import Mate.GC.Boehm
  17
  18 import Text.Printf
  19 import Mate.Debug
  20
  21 -- unified place for allocating Memory
  22 -- TODO: implement GC stuff ;-)
  23
  24 mallocClassData :: Int -> IO (Ptr a)
  25 mallocClassData size = do
  26   printfStr "mallocClassData: %d\n" size
  27   mem <- mallocBytes size
  28   addRootGC mem (plusPtr mem size)
  29   return mem
  30
  31 mallocString :: Int -> IO (Ptr a)
  32 mallocString size = do
  33   printfStr "mallocString: %d\n" size
  34   mallocBytesGC size
  35
  36 mallocStringVM :: Int -> IO (Ptr a)
  37 mallocStringVM = mallocBytes
  38
  39 foreign export ccall mallocObject :: Int -> IO CPtrdiff
  40 mallocObject :: Int -> IO CPtrdiff
  41 mallocObject size = do
  42   ptr <- mallocBytesGC size
  43   printfStr "mallocObject: %d\n" size
  44   return $ fromIntegral $ ptrToIntPtr ptr
  45
  46 mallocObjectVM :: Int -> IO CPtrdiff
  47 mallocObjectVM size = do
  48   ptr <- mallocBytes size
  49   printfStr "mallocObject VM: %d\n" size
  50   return $ fromIntegral $ ptrToIntPtr ptr
  51
  52 -- TODO: delete me
  53 foreign export ccall demoInterfaceCall :: CUInt -> IO ()
  54 demoInterfaceCall :: CUInt -> IO ()
  55 demoInterfaceCall val = do
  56   printf "demoInterfaceCall: 0x%08x\n" (fromIntegral val :: Word32)
  57   return ()
  58
  59 getHeapMemory :: IO Int
  60 getHeapMemory = getHeapSizeGC
  61
  62
  63 foreign export ccall printMemoryUsage :: IO ()
  64 printMemoryUsage :: IO ()
  65 printMemoryUsage = getHeapMemory >>= print