basiblock: remove `markBackwardTargets'

[mate.git] / scratch / ScratchHS.hs

diff --git a/scratch/ScratchHS.hs b/scratch/ScratchHS.hs
index a6808b0a4758d3e99868700e37508fa2cbbe7c77..3e0acaff450c237adbc462f19b1de412b0bf6edd 100644 (file)
--- a/scratch/ScratchHS.hs
+++ b/scratch/ScratchHS.hs
@@ -1,3 +1,5 @@
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE NoMonomorphismRestriction #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE TemplateHaskell #-}
 
@@ -17,22 +19,31 @@
 module ScratchHS where
 
 import Data.Maybe
+import Control.Monad.State
 
-import Harpy
-import Harpy.X86Disassembler
+import Harpy hiding(fst,add)
+import qualified Harpy.X86Disassembler as H
+import qualified Data.ByteString.Lazy as B
+import qualified Data.Set as S
+import qualified Data.Heap as H
 
 import Foreign
-import Control.Monad
+
+import Debug.Trace
+import Data.Int
 
 import JVM.ClassFile
 import JVM.Converter
 import JVM.Dump
 
-import qualified JVM.Assembler as JAsm
+import JVM.Assembler 
 
 import Mate.Utilities
 import Mate.BasicBlocks
 
+import Frontend
+import Graph
+
 $(callDecl "callAsWord32" [t|Word32|])
 
 data SimpleStack = PushLit Int
@@ -70,7 +81,7 @@ exitCode = do mov esp ebp
 
 
 
-run :: [RegIL] -> Ptr Int32 -> IO (MateState, Either ErrMsg [Instruction])
+run :: [RegIL] -> Ptr Int32 -> IO (MateState, Either ErrMsg [H.Instruction])
 run program env = let compileAndFeedback = mapM_ compileRegIL program >> disassemble
                   in runCodeGen compileAndFeedback env (MateState "none")
 
@@ -84,7 +95,7 @@ emptyMemory n = mallocArray n
 testEnv p' = do 
               ptr <- emptyMemory 26
               (_, Right code) <- run p' ptr
-              return $ map showIntel code
+              return $ map H.showIntel code
 
 
 simpleTest ::  [RegIL]
@@ -97,10 +108,72 @@ loadMethod methodName classFile = do cls <- parseClassFile classFile
                                      return (cls, lookupMethod methodName cls)
 
 
-getFib = do (cls, Just m) <- loadMethod "ackermann" "../tests/Ackermann.class"
+getFib = do (cls, Just m) <- loadMethod "fac" "../tests/Fac.class"
             return (cls, m)
 
 fibBasicBlocks = do (cls,m) <- getFib
-                    hmap <- parseMethod cls "ackermann"
+                    hmap <- parseMethod cls "facFor"
                     printMapBB hmap
                     return ()
+
+
+fib = do con@(Just (ins,cls)) <- getMethodIO "../tests/Fac.class" "facFor"
+         let offsets = getInstOffsets ins
+         let taggedInst = zip3 (map Source $ sumSeries'' offsets) offsets ins
+         mapM_ print taggedInst
+         let continuations =  execState (findContinuations taggedInst) ([],H.empty)
+         print continuations
+         let cfg = buildCFGContext con
+         print cfg
+         return cfg 
+ 
+fib' = do con@(Just (ins,cls)) <- getMethodIO "../tests/Fac.class" "facFor"
+          let tagged = getInstructions ins
+          print tagged
+          let backRefs = splitBlocksBackRef tagged
+          let splitted = splitBlocks backRefs tagged
+          print splitted
+          let transitions = getTransitions splitted
+          let nodes       = getNodes splitted
+          print "nodes:"
+          print nodes
+          print "transitions"
+          print transitions
+          let (Just finalCyclicStructure) = indirectCFGToG splitted
+          print "Final result"
+          print $ printG' finalCyclicStructure
+
+main = do con@(Just (ins,cls)) <- getMethodIO "../tests/AbsurdlyHuge.class" "absurdlyHuge"
+          let tagged = getInstructions ins
+          let backRefs = splitBlocksBackRef tagged
+          let splitted = splitBlocks backRefs tagged
+          let transitions = getTransitions splitted
+          let nodes       = getNodes splitted
+          print "nodes:"
+          print nodes
+          print "transitions"
+          print transitions
+          let (Just finalCyclicStructure) = indirectCFGToG splitted
+          print "Final result"
+          print $ printG' finalCyclicStructure
+
+    
+
+
+diamant ::  G String
+diamant = let start = Node "a" left right
+              left  = Node "l" end Nil
+              right = Node "r" end Nil
+              end   = Node "g" start Nil
+          in start
+
+dag = Node "a" (Node "b" (Leaf "c") (Leaf "d")) (Node "b" (Leaf "c") (Leaf "d"))
+
+
+value (Node val _ _) = Just val
+value (Leaf val    ) = Just val
+value Nil            = Nothing
+                                          
+
+printG' ::  Ord k => G k -> [k]
+printG' g = evalState (foldGM ((: []), (++)) (\node -> let (Just v) = value node in v) [] g) S.empty