From: Harald Steinlechner <haraldsteinlechner@gmail.com>
Date: Mon, 27 Aug 2012 17:41:04 +0000 (+0200)
Subject: scratch/GC: progress with data structures and traversals
X-Git-Url: http://wien.tomnetworks.com/gitweb/?p=mate.git;a=commitdiff_plain;h=f472f7e09aff55af49016aa58195fafba74589e8

scratch/GC: progress with data structures and traversals
---

diff --git a/scratch/MemoryManager.hs b/scratch/MemoryManager.hs
index 05e69d0..8ddde1d 100644
--- 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 Control.Monad.State
+
+--import GC
+
 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')"