From 6f387a097adb43fcaad49672f15f21a1b724dc6e Mon Sep 17 00:00:00 2001
From: Harald Steinlechner <haraldsteinlechner@gmail.com>
Date: Mon, 27 Aug 2012 20:16:53 +0200
Subject: [PATCH] MemoryManager: twoSpace memorymanager initialization code;
 here its time for monad transformers...

---
 Mate/GC.hs            |  2 +-
 Mate/MemoryManager.hs | 29 +++++++++++++++++++++++++++--
 2 files changed, 28 insertions(+), 3 deletions(-)

diff --git a/Mate/GC.hs b/Mate/GC.hs
index 9781d20..8f37216 100644
--- a/Mate/GC.hs
+++ b/Mate/GC.hs
@@ -1,5 +1,5 @@
 {-# LANGUAGE ScopedTypeVariables #-}
-module GC 
+module Mate.GC 
   ({- dont export generic versions for high performance ;-) -}) where
 
 import Control.Monad
diff --git a/Mate/MemoryManager.hs b/Mate/MemoryManager.hs
index 8ddde1d..57aec48 100644
--- a/Mate/MemoryManager.hs
+++ b/Mate/MemoryManager.hs
@@ -1,12 +1,16 @@
-module MemoryManager ( ) where
+{-# LANGUAGE ExistentialQuantification #-}
+module Mate.MemoryManager ( ) where
 
 import qualified Foreign.Marshal.Alloc as Alloc
 import Foreign.Ptr
 import Foreign.Storable
 
+import Data.HashTable
+
+import Text.Printf
 import Control.Monad.State
 
---import GC
+import Mate.GC
 
 class AllocationManager a where
   mallocBytes :: a -> Int -> (a,Ptr b)
@@ -29,3 +33,24 @@ mallocBytes' bytes = do state <- get
                              put $ state { toHeap = end } 
                              return $ intPtrToPtr ptr
         fail = error "no space left in two space (mallocBytes')"
+
+-- here its time for monadtransformer :)
+evacuate :: [Ptr a] -> State TwoSpace (IO (HashTable (Ptr a) (Ptr a)))
+evacuate = undefined
+
+
+initTwoSpace :: Int -> IO TwoSpace
+initTwoSpace size =  do printf "initializing TwoSpace memory manager with %d bytes." size
+                        fromSpace <- Alloc.mallocBytes size
+                        toSpace   <- Alloc.mallocBytes size
+                        if fromSpace /= nullPtr && toSpace /= nullPtr 
+                           then return $ buildToSpace fromSpace toSpace
+                           else error "Could not initialize TwoSpace memory manager (malloc returned null ptr)"
+   where buildToSpace from to = let fromBase' = ptrToIntPtr from
+                                    toBase' = ptrToIntPtr to
+                                    fromExtreme' = ptrToIntPtr $ from `plusPtr` size
+                                    toExtreme' = ptrToIntPtr $ to `plusPtr` size
+                                in TwoSpace { fromBase = fromBase', toBase = toBase',
+                                              fromHeap = fromBase', toHeap = toBase',
+                                              fromExtreme = fromExtreme', toExtreme = toExtreme' }
+
-- 
2.25.1