scratch/MemoryManager.hs

   1 module MemoryManager ( ) where
   2
   3 import qualified Foreign.Marshal.Alloc as Alloc
   4 import Foreign.Ptr
   5 import Foreign.Storable
   6
   7 import Control.Monad.State
   8
   9 --import GC
  10
  11 class AllocationManager a where
  12   mallocBytes :: a -> Int -> (a,Ptr b)
  13
  14 data TwoSpace = TwoSpace { fromBase :: IntPtr,
  15                            toBase   :: IntPtr,
  16                            fromHeap :: IntPtr,
  17                            toHeap   :: IntPtr,
  18                            fromExtreme :: IntPtr,
  19                            toExtreme   :: IntPtr }
  20
  21 mallocBytes' :: Int -> State TwoSpace (Ptr b)
  22 mallocBytes' bytes = do state <- get
  23                         let end = (toHeap state) + (ptrToIntPtr $ nullPtr `plusPtr` bytes) -- not really? FUUU
  24                         -- actually i would like to use an existential within TwoSpace but this requires
  25                         -- pattern matchingt at call site http://stackoverflow.com/questions/10192663/why-cant-existential-types-use-record-syntax which is i think even slower.
  26                         if end <= toExtreme state then alloc state end else fail
  27   where alloc :: TwoSpace -> IntPtr -> State TwoSpace (Ptr b)
  28         alloc state end = do let ptr = toHeap state
  29                              put $ state { toHeap = end }
  30                              return $ intPtrToPtr ptr
  31         fail = error "no space left in two space (mallocBytes')"