scratch/GC: progress with data structures and traversals

diff --git a/scratch/MemoryManager.hs b/scratch/MemoryManager.hs
index 05e69d0f1a0d6215e0e82292f5b5d86be7b31b8e..8ddde1de9c850ba9625b8a28267065acb0aa00fb 100644 (file)
--- a/scratch/MemoryManager.hs
+++ b/scratch/MemoryManager.hs
@@ -4,13 +4,28 @@ import qualified Foreign.Marshal.Alloc as Alloc
 import Foreign.Ptr
 import Foreign.Storable
 
 import Foreign.Ptr
 import Foreign.Storable
 

+import Control.Monad.State
+
+--import GC
+

 class AllocationManager a where
   mallocBytes :: a -> Int -> (a,Ptr b)
 
 class AllocationManager a where
   mallocBytes :: a -> Int -> (a,Ptr b)
 

-data TwoSpace = TwoSpace { basePtrA :: IntPtr, basePtrB :: IntPtr, heapPtrA :: IntPtr, heapPtrB :: IntPtr }
-
-instance AllocationManager TwoSpace where
-  mallocBytes = mallocBytes'
+data TwoSpace = TwoSpace { fromBase :: IntPtr, 
+                           toBase   :: IntPtr, 
+                           fromHeap :: IntPtr, 
+                           toHeap   :: IntPtr,
+                           fromExtreme :: IntPtr,
+                           toExtreme   :: IntPtr }

 
 

-mallocBytes' :: TwoSpace -> Int -> (TwoSpace, Ptr a)
-mallocBytes' = undefined
+mallocBytes' :: Int -> State TwoSpace (Ptr b)
+mallocBytes' bytes = do state <- get
+                        let end = (toHeap state) + (ptrToIntPtr $ nullPtr `plusPtr` bytes) -- not really? FUUU
+                        -- actually i would like to use an existential within TwoSpace but this requires
+                        -- pattern matchingt at call site http://stackoverflow.com/questions/10192663/why-cant-existential-types-use-record-syntax which is i think even slower. 
+                        if end <= toExtreme state then alloc state end else fail
+  where alloc :: TwoSpace -> IntPtr -> State TwoSpace (Ptr b)
+        alloc state end = do let ptr = toHeap state
+                             put $ state { toHeap = end } 
+                             return $ intPtrToPtr ptr
+        fail = error "no space left in two space (mallocBytes')"