+
+
+evacuate' :: (RefObj a, AllocationManager b) => [a] -> StateT b IO ()
+evacuate' = foldr (\x evac -> evac >> evacuate'' x) (liftIO (return ()))
+
+evacuate'' :: (RefObj a, AllocationManager b) => a -> StateT b IO ()
+evacuate'' obj = do (size,payload) <- liftIO ((,) <$> size obj <*> payload obj)
+ -- malloc in TwoSpace
+ newPtr <- mallocBytes size
+ liftIO (putStrLn ("evacuating: " ++ show obj ++ " and set: " ++ show newPtr))
+ -- copy data over and leave notice
+ liftIO (copyBytes newPtr (intPtrToPtr payload) size >>
+ newRef obj (cast newPtr))
+
+evacuateList :: (RefObj a, AllocationManager b) => [a] -> b -> IO ()
+evacuateList objs manager = evalStateT (evacuate' objs) manager
+
+
+initTwoSpace :: Int -> IO TwoSpace
+initTwoSpace size = do printf "initializing TwoSpace memory manager with %d bytes.\n" 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)\n"
+ 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' }
+