Mate/Tests/MockRefs.hs

   1 module Mate.Tests.MockRefs where
   2
   3 import Mate.GC
   4
   5 import Foreign.Ptr
   6 import Foreign.Marshal.Alloc
   7 import Foreign.Marshal.Array
   8 import Foreign.Storable
   9 import GHC.Int
  10 import Text.Printf
  11
  12 import Control.Monad
  13
  14 instance RefObj (Ptr a) where
  15   payload     = return . ptrToIntPtr
  16   size a      = fmap ((+ 0x10) . length) (refs a)
  17   refs        = unpackRefs . castPtr
  18   marked      = markedRef
  19   mark        = markRef (0x1::Int32)
  20   unmark      = markRef (0x0::Int32)
  21   newRef      = newRefPtr
  22   patchRefs   = undefined
  23   cast = castPtr
  24
  25 instance PrintableRef (Ptr a) where
  26   printRef    = printRef'
  27
  28
  29 idOff           = 0x0
  30 numberOfObjsOff = 0x4
  31 markedOff = 0x8
  32 newRefOff = 0xC
  33 fieldsOff = 0x10
  34
  35 unpackRefs :: Ptr Int32 -> IO [Ptr b]
  36 unpackRefs ptr = do  --dereference number of objs; mark field skipped via fieldsOffset
  37                     numberOfObjs <- peekByteOff ptr numberOfObjsOff :: IO Int32
  38                     mapM (peekElemOff (ptr `plusPtr` fieldsOff)) [0..fromIntegral $ numberOfObjs-1]
  39
  40 markedRef :: Ptr a -> IO Bool
  41 markedRef ptr = liftM ((/=0) . fromIntegral) (peekByteOff ptr markedOff :: IO Int32)
  42
  43 markRef :: Int32 -> Ptr a -> IO ()
  44 markRef val ptr = pokeByteOff ptr markedOff val
  45
  46 newRefPtr :: Ptr a -> Ptr a -> IO ()
  47 newRefPtr ptr = pokeByteOff ptr newRefOff
  48
  49 printRef' :: Ptr a -> IO ()
  50 printRef' ptr = do printf "obj 0x%08x\n" =<< (peekByteOff ptr idOff :: IO Int32)
  51                    printf "children 0x%08x\n" =<< (peekByteOff ptr numberOfObjsOff :: IO Int32)
  52                    printf "marked 0x%08x\n" =<< (peekByteOff ptr markedOff :: IO Int32)
  53                    printf "newRef 0x%08x\n\n" =<< (peekByteOff ptr newRefOff :: IO Int32)
  54
  55 printTree :: Ptr a -> IO ()
  56 printTree = traverseIO printRef'
  57
  58 emptyObj id  = do mem <- mallocBytes 0x10
  59                   pokeArray mem [id,0,0::Int32,0]
  60                   return mem
  61
  62 twoRefs = do mem <- mallocBytes 0x18
  63              -- idOfObj; numberofObj; marked waste memory Int32
  64              pokeArray mem [0::Int32,2,0,0]
  65              obj1 <- emptyObj 1
  66              obj2 <- emptyObj 2
  67              pokeByteOff mem 0x10 obj1
  68              pokeByteOff mem 0x14 obj2
  69              return mem
  70
  71 cyclR = do mem <- mallocBytes 0x1C
  72            pokeArray mem [0::Int32,3,0,0]
  73            obj1 <- emptyObj 1
  74            obj2 <- emptyObj 2
  75            pokeByteOff mem 0x10 obj1
  76            pokeByteOff mem 0x14 obj2
  77            pokeByteOff mem 0x18 mem
  78            return mem
  79
  80 test objr = do twoRefs <- objr
  81                putStrLn "initial:\n"
  82                printTree twoRefs
  83                lifeRefs <- markTree'' marked mark [] twoRefs
  84                putStrLn "life refs: \n"
  85                print lifeRefs
  86                --forM lifeRefs printRef'
  87                putStrLn "after marking\n"
  88                printTree twoRefs
  89                markTree'' (liftM not . marked) unmark [] twoRefs
  90                putStrLn "after unmarking\n"
  91                printTree twoRefs