{-# LANGUAGE ScopedTypeVariables #-}
module Mate.GC
- ( RefObj
+ ( RefObj(..), PrintableRef(..), traverseIO, markTree''
{- dont export generic versions for high performance -> remove for production -}) where
import Control.Monad
-
-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
+
+import Foreign.Ptr (IntPtr)
class (Eq a, Ord a) => RefObj a where
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)
- newRef = newRefPtr
- patchRefs = undefined
- copy = undefined
-
-instance PrintableRef (Ptr a) where
- printRef = printRef'
-
-
-idOff = 0x0
-numberOfObjsOff = 0x4
-markedOff = 0x8
-newRefOff = 0xC
-fieldsOff = 0x10
-
-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
-
-newRefPtr :: Ptr a -> Ptr a -> IO ()
-newRefPtr ptr newRef = pokeByteOff ptr newRefOff newRef
-
-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" =<< (peekByteOff ptr markedOff :: IO Int32)
- printf "newRef 0x%08x\n\n" =<< (peekByteOff ptr newRefOff :: 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)
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 0x10
- pokeArray mem [id,0,0::Int32,0]
- return mem
-
-twoRefs = do mem <- mallocBytes 0x18
- -- idOfObj; numberofObj; marked waste memory Int32
- pokeArray mem [0::Int32,2,0,0]
- obj1 <- emptyObj 1
- obj2 <- emptyObj 2
- pokeByteOff mem 0x10 obj1
- pokeByteOff mem 0x14 obj2
- return mem
-
-cyclR = do mem <- mallocBytes 0x1C
- pokeArray mem [0::Int32,3,0,0]
- obj1 <- emptyObj 1
- obj2 <- emptyObj 2
- pokeByteOff mem 0x10 obj1
- pokeByteOff mem 0x14 obj2
- pokeByteOff mem 0x18 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
import Foreign.Ptr
import Foreign.Storable
-import Data.HashTable
-
import Text.Printf
import Control.Monad.State
--- /dev/null
+module Mate.Tests.MockRefs where
+
+import Mate.GC
+
+import Foreign.Ptr
+import Foreign.Marshal.Alloc
+import Foreign.Marshal.Array
+import Foreign.Storable
+import GHC.Int
+import Text.Printf
+
+import Control.Monad
+
+instance RefObj (Ptr a) where
+ payload = return . ptrToIntPtr
+ refs = unpackRefs . castPtr
+ marked = markedRef
+ mark = markRef (0x1::Int32)
+ unmark = markRef (0x0::Int32)
+ newRef = newRefPtr
+ patchRefs = undefined
+ copy = undefined
+
+instance PrintableRef (Ptr a) where
+ printRef = printRef'
+
+
+idOff = 0x0
+numberOfObjsOff = 0x4
+markedOff = 0x8
+newRefOff = 0xC
+fieldsOff = 0x10
+
+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
+
+newRefPtr :: Ptr a -> Ptr a -> IO ()
+newRefPtr ptr newRef = pokeByteOff ptr newRefOff newRef
+
+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" =<< (peekByteOff ptr markedOff :: IO Int32)
+ printf "newRef 0x%08x\n\n" =<< (peekByteOff ptr newRefOff :: IO Int32)
+
+printTree :: Ptr a -> IO ()
+printTree = traverseIO printRef'
+
+emptyObj id = do mem <- mallocBytes 0x10
+ pokeArray mem [id,0,0::Int32,0]
+ return mem
+
+twoRefs = do mem <- mallocBytes 0x18
+ -- idOfObj; numberofObj; marked waste memory Int32
+ pokeArray mem [0::Int32,2,0,0]
+ obj1 <- emptyObj 1
+ obj2 <- emptyObj 2
+ pokeByteOff mem 0x10 obj1
+ pokeByteOff mem 0x14 obj2
+ return mem
+
+cyclR = do mem <- mallocBytes 0x1C
+ pokeArray mem [0::Int32,3,0,0]
+ obj1 <- emptyObj 1
+ obj2 <- emptyObj 2
+ pokeByteOff mem 0x10 obj1
+ pokeByteOff mem 0x14 obj2
+ pokeByteOff mem 0x18 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
+{-# LANGUAGE GADTs #-}
module Analysis where
+import Compiler.Hoopl
import Control.Monad.State
type Addr = Int
-data StackIL = Dup | Ld Addr Type | Add Type | Store Addr Type
+data StackIL = Dup | Ld Addr Type | Add Type | Store Addr Type deriving Show
type Target = (Int,Type)
type Source = (Int,Type)
type Stack = [StackElem]
dup :: State Stack ()
-dup = modify (\(top@(i,t):x) -> (i+1,t) : top : xs)
+dup = modify (\(top@(i,t):xs) -> (i+1,t) : top : xs)
push :: Type -> State Stack Int
push t = do tos <- get
generateRegisterIR = (`evalState` []) . aInterpret
--data StackIL = Dup | Ld Addr Type | Add Type | Store Addr Type
-testCase1 = [ Ld 0 Int, Ld 1 Int, Dup , Add Int, Add Int, Store 0 Int]
+testCase1 = [ Ld 0 Int, Ld 1 Int, Dup , Add Int, Add Int, Store 0 Int]
+
+bench = concat . replicate 100000
+
+type TLabel = Int
+type Var = String
+data Expr = VarE Var | AddE Var Var | Lit Int | CLe Expr Expr
+
+data Node e x where
+ Label :: TLabel -> Node C O
+ Assign :: Var -> Expr -> Node O O
+ If :: Expr -> TLabel -> TLabel -> Node O C
+ Ret :: Node O C
+ Nop :: Node O O
+ Branch :: TLabel -> Node C C
+
+{-testProgram = [ Assign "x" (Lit 3),
+ Assign "y" (Lit 5),
+ If (CLe (VarE "x") (VarE "y")) 1 2,
+ Assign "x" (VarE "y")
+ ] -}
+
+
--- /dev/null
+module Main where
+
+import Analysis
+
+main = print $ (bench testCase1)
projects / mate.git / commitdiff