X-Git-Url: http://wien.tomnetworks.com/gitweb/?a=blobdiff_plain;f=Mate%2FGC.hs;h=eb1f2f7db78bac215c61c8e89bebaa507c893ca7;hb=HEAD;hp=8f37216b747d36f3dca91183691075cc413fca08;hpb=6f387a097adb43fcaad49672f15f21a1b724dc6e;p=mate.git

diff --git a/Mate/GC.hs b/Mate/GC.hs
index 8f37216..eb1f2f7 100644
--- a/Mate/GC.hs
+++ b/Mate/GC.hs
@@ -1,66 +1,32 @@
 {-# LANGUAGE ScopedTypeVariables #-}
 module Mate.GC 
-  ({- dont export generic versions for high performance ;-) -}) where
+  ( RefObj(..), PrintableRef(..), traverseIO, markTree'', patchAllRefs 
+    {- dont export generic versions for high performance -> remove for production -}) where
 
 import Control.Monad
-
---import Data.Foldable hiding (mapM_)
-
-import Foreign.Ptr
-import Foreign.Marshal.Alloc
-import Foreign.Marshal.Array
-import Foreign.Storable
-import GHC.Int
-
 import qualified Data.Set as S
-import Text.Printf
 
-class (Eq a, Ord a) => RefObj a where
+import Foreign.Ptr (IntPtr, Ptr)
+
+class (Eq a, Ord a, Show a) => RefObj a where
+  
   payload :: a -> IO IntPtr
-  refs    :: a -> IO [a]
+  size    :: a -> IO Int
+  cast    :: Ptr b -> a
+ 
+  refs      :: a -> IO [a]
+  patchRefs :: a -> [a] -> IO ()
+  setNewRef :: a -> a -> IO ()
+  getNewRef :: a -> IO a
+  
   marked  :: a -> IO Bool
   mark    :: a -> IO ()
   unmark  :: a -> IO ()
-
--- TODO hs: wtf? i am failing to create a printable class with superclass refobj??
---class RefObj a => PrintableRefObj a where 
---  printRef   :: a -> IO ()
+  
 
 class PrintableRef a where
   printRef :: a -> IO ()
 
-instance RefObj (Ptr a) where
-  payload     = return . ptrToIntPtr
-  refs        = unpackRefs . castPtr
-  marked      = markedRef
-  mark        = markRef (0x1::Int32)
-  unmark      = markRef (0x0::Int32)
-
-instance PrintableRef (Ptr a) where
-  printRef    = printRef'
-
-
-idOff           = 0x0
-numberOfObjsOff = 0x4
-fieldsOff = 0xC
-markedOff = 0x8
-
-unpackRefs :: Ptr Int32 -> IO [Ptr b]
-unpackRefs ptr = do  --dereference number of objs; mark field skipped via fieldsOffset
-                    numberOfObjs <- peekByteOff ptr numberOfObjsOff :: IO Int32
-                    mapM (peekElemOff (ptr `plusPtr` fieldsOff)) [0..fromIntegral $ numberOfObjs-1]
-
-markedRef :: Ptr a -> IO Bool
-markedRef ptr = liftM ((/=0) . fromIntegral) (peekByteOff ptr markedOff :: IO Int32)
-
-markRef :: Int32 -> Ptr a -> IO ()
-markRef val ptr = pokeByteOff ptr markedOff val
-
-printRef' :: Ptr a -> IO ()
-printRef' ptr = do printf "obj 0x%08x\n" =<< (peekByteOff ptr idOff :: IO Int32)
-                   printf "children 0x%08x\n" =<< (peekByteOff ptr numberOfObjsOff :: IO Int32)                  
-                   printf "marked 0x%08x\n\n" =<< (peekByteOff ptr markedOff :: IO Int32)
-
 -- | Generically marks a graph (can be used to set mark bit and reset mark bit at the same time
 -- using customized loopcheck and marker funcs (i.e. to set the bit check on ==1 and on ==0 otherwise)
 -- Furthermore it produces a list of visited nodes (this can be all live one (or dead on respectively)
@@ -84,41 +50,17 @@ markTree :: RefObj a => a -> IO ()
 markTree root = marked root >>= (`unless` continue)
   where continue = mark root >> refs root >>= mapM_  markTree
 
-printTree :: Ptr a -> IO ()
-printTree = traverseIO printRef'
-
 
-emptyObj id  = do mem <- mallocBytes 0xC
-                  pokeArray mem [id,0,0::Int32]
-                  return mem
+-- | This object is alive. so its children are alive. patch child references to point
+-- to childrens new references
+patchRefsObj :: (RefObj a) => a -> IO ()
+patchRefsObj obj = do obj' <- getNewRef obj 
+                      fields <- refs obj
+                      newRefs <- mapM getNewRef fields
+                      print newRefs
+                      patchRefs obj' newRefs                 
 
-twoRefs = do mem <- mallocBytes 0x14
-             -- idOfObj; numberofObj; marked waste memory Int32
-             pokeArray mem [0::Int32,2,0]
-             obj1 <- emptyObj 1
-             obj2 <- emptyObj 2
-             pokeByteOff mem 0xC obj1
-             pokeByteOff mem 0x10 obj2
-             return mem
+patchAllRefs :: (RefObj a) => [a] -> IO ()
+patchAllRefs = mapM_ patchRefsObj
 
-cyclR = do mem <- mallocBytes 0x18
-           pokeArray mem [0::Int32,3,0]
-           obj1 <- emptyObj 1
-           obj2 <- emptyObj 2
-           pokeByteOff mem 0xC obj1
-           pokeByteOff mem 0x10 obj2
-           pokeByteOff mem 0x14 mem
-           return mem
 
-test objr = do twoRefs <- objr
-               putStrLn "initial:\n" 
-               printTree twoRefs
-               lifeRefs <- markTree'' marked mark [] twoRefs
-               putStrLn "life refs: \n"
-               print lifeRefs
-               --forM lifeRefs printRef'
-               putStrLn "after marking\n"
-               printTree twoRefs
-               markTree'' (liftM not . marked) unmark [] twoRefs
-               putStrLn "after unmarking\n"
-               printTree twoRefs