Mate/MemoryManager.hs

   1 {-# LANGUAGE ExistentialQuantification #-}
   2 module Mate.MemoryManager ( ) where
   3
   4 import qualified Foreign.Marshal.Alloc as Alloc
   5 import Foreign.Ptr
   6 import Foreign.Storable
   7
   8 import Data.HashTable
   9
  10 import Text.Printf
  11 import Control.Monad.State
  12
  13 import Mate.GC
  14
  15 class AllocationManager a where
  16   mallocBytes :: a -> Int -> (a,Ptr b)
  17
  18 data TwoSpace = TwoSpace { fromBase :: IntPtr,
  19                            toBase   :: IntPtr,
  20                            fromHeap :: IntPtr,
  21                            toHeap   :: IntPtr,
  22                            fromExtreme :: IntPtr,
  23                            toExtreme   :: IntPtr }
  24
  25 mallocBytes' :: Int -> State TwoSpace (Ptr b)
  26 mallocBytes' bytes = do state <- get
  27                         let end = (toHeap state) + (ptrToIntPtr $ nullPtr `plusPtr` bytes) -- not really? FUUU
  28                         -- actually i would like to use an existential within TwoSpace but this requires
  29                         -- pattern matchingt at call site http://stackoverflow.com/questions/10192663/why-cant-existential-types-use-record-syntax which is i think even slower.
  30                         if end <= toExtreme state then alloc state end else fail
  31   where alloc :: TwoSpace -> IntPtr -> State TwoSpace (Ptr b)
  32         alloc state end = do let ptr = toHeap state
  33                              put $ state { toHeap = end }
  34                              return $ intPtrToPtr ptr
  35         fail = error "no space left in two space (mallocBytes')"
  36
  37 type Action = IO ()
  38
  39 evacuate :: RefObj a => [a] -> State TwoSpace Action
  40 evacuate = undefined
  41
  42 evacuate' :: RefObj a => a -> State TwoSpace Action
  43 evacuate' = undefined
  44
  45
  46 initTwoSpace :: Int -> IO TwoSpace
  47 initTwoSpace size =  do printf "initializing TwoSpace memory manager with %d bytes." size
  48                         fromSpace <- Alloc.mallocBytes size
  49                         toSpace   <- Alloc.mallocBytes size
  50                         if fromSpace /= nullPtr && toSpace /= nullPtr
  51                            then return $ buildToSpace fromSpace toSpace
  52                            else error "Could not initialize TwoSpace memory manager (malloc returned null ptr)"
  53    where buildToSpace from to = let fromBase' = ptrToIntPtr from
  54                                     toBase' = ptrToIntPtr to
  55                                     fromExtreme' = ptrToIntPtr $ from `plusPtr` size
  56                                     toExtreme' = ptrToIntPtr $ to `plusPtr` size
  57                                 in TwoSpace { fromBase = fromBase', toBase = toBase',
  58                                               fromHeap = fromBase', toHeap = toBase',
  59                                               fromExtreme = fromExtreme', toExtreme = toExtreme' }
  60