modules: move (public) datatypes into a new module
[mate.git] / Mate / BasicBlocks.hs
index 4ab119ad569d4d50d74b49cc1a92dc3863158716..229325d6a36423514d95f29dee312746a215854b 100644 (file)
@@ -6,11 +6,13 @@ module Mate.BasicBlocks(
   MapBB,
   printMapBB,
   parseMethod,
-  test_main
+  test_main,
+  testCFG -- added by hs to perform benches from outside
   )where
 
 import Data.Binary
 import Data.Int
+import Data.List
 import qualified Data.Map as M
 import qualified Data.ByteString.Lazy as B
 
@@ -19,22 +21,10 @@ import JVM.Converter
 import JVM.Assembler
 
 import Mate.Utilities
+import Mate.Types
 
 
-type BlockID = Int
--- Represents a CFG node
-data BasicBlock = BasicBlock {
-                     -- inputs  :: [Variable],
-                     -- outputs :: [Variable],
-                     code    :: [Instruction],
-                     successor :: BBEnd }
-
--- describes (leaving) edges of a CFG node
-data BBEnd = Return | OneTarget BlockID | TwoTarget BlockID BlockID deriving Show
-
-type MapBB = M.Map BlockID BasicBlock
-
--- for immediate representation for determine BBs
+-- for immediate representation to determine BBs
 type Offset = (Int, Maybe BBEnd) -- (offset in bytecode, offset to jump target)
 type OffIns = (Offset, Instruction)
 
@@ -56,6 +46,7 @@ printMapBB (Just hmap) = do
                              mapM_ putStrLn (map ((++) "\t" . show) $ code bb)
                              case successor bb of
                                Return -> putStrLn ""
+                               FallThrough t1 -> putStrLn $ "Sucessor: " ++ (show t1) ++ "\n"
                                OneTarget t1 -> putStrLn $ "Sucessor: " ++ (show t1) ++ "\n"
                                TwoTarget t1 t2 -> putStrLn $ "Sucessor: " ++ (show t1) ++ ", " ++ (show t2) ++ "\n"
                              printMapBB' is hmap
@@ -63,7 +54,8 @@ printMapBB (Just hmap) = do
 
 testInstance :: String -> B.ByteString -> IO ()
 testInstance cf method = do
-                      hmap <- parseMethod cf method
+                      cls <- parseClassFile cf
+                      hmap <- parseMethod cls method
                       printMapBB hmap
 
 test_main :: IO ()
@@ -71,16 +63,20 @@ test_main = do
   test_01
   test_02
   test_03
+  test_04
 
-test_01, test_02, test_03 :: IO ()
+test_01, test_02, test_03, test_04 :: IO ()
 test_01 = testInstance "./tests/Fib.class" "fib"
 test_02 = testInstance "./tests/While.class" "f"
 test_03 = testInstance "./tests/While.class" "g"
+test_04 = testInstance "./tests/Fac.class" "fac"
 
 
-parseMethod :: String -> B.ByteString -> IO (Maybe MapBB)
-parseMethod clspath method = do
-                     cls <- parseClassFile clspath
+parseMethod :: Class Resolved -> B.ByteString -> IO (Maybe MapBB)
+parseMethod cls method = do
+                     putStr "BB: analysing: "
+                     let msig = methodSignature $ (classMethods cls) !! 1
+                     B.putStrLn (method `B.append` ": " `B.append` (encode msig))
                      return $ testCFG $ lookupMethod method cls
 
 
@@ -95,7 +91,28 @@ buildCFG :: [Instruction] -> MapBB
 buildCFG xs = buildCFG' M.empty xs' xs'
   where
   xs' :: [OffIns]
-  xs' = calculateInstructionOffset xs
+  xs' = markBackwardTargets $ calculateInstructionOffset xs
+
+-- get already calculated jmp-targets and mark the predecessor of the
+-- target-instruction as "FallThrough". we just care about backwards
+-- jumps here (forward jumps are handled in buildCFG')
+markBackwardTargets :: [OffIns] -> [OffIns]
+markBackwardTargets [] = []
+markBackwardTargets (x:[]) = [x]
+markBackwardTargets insns@(x@((x_off,x_bbend),x_ins):y@((y_off,_),_):xs) =
+  (x_new):(markBackwardTargets (y:xs))
+  where
+  x_new = if isTarget then checkX y_off else x
+  checkX w16 = case x_bbend of
+    Just _ -> x -- already marked, don't change
+    Nothing -> ((x_off, Just $ FallThrough w16), x_ins) -- mark previous insn
+
+  -- look through all remaining insns in the stream if there is a jmp to `y'
+  isTarget = case find cmpOffset insns of Just _ -> True; Nothing -> False
+  cmpOffset ((_,(Just (OneTarget w16))),_) = w16 == y_off
+  cmpOffset ((_,(Just (TwoTarget _ w16))),_) = w16 == y_off
+  cmpOffset _ = False
+
 
 buildCFG' :: MapBB -> [OffIns] -> [OffIns] -> MapBB
 buildCFG' hmap [] _ = hmap
@@ -113,6 +130,7 @@ buildCFG' hmap (((off, entry), _):xs) insns = buildCFG' (insertlist entryi hmap)
         case entry of
         Just (TwoTarget t1 t2) -> [t1, t2]
         Just (OneTarget t) -> [t]
+        Just (FallThrough t) -> [t]
         Just (Return) -> []
         Nothing -> []
 
@@ -153,6 +171,7 @@ calculateInstructionOffset = cio' (0, Nothing)
       IF_ICMP _ w16 -> twotargets w16
       GOTO w16 -> onetarget w16
       IRETURN -> notarget
+      RETURN -> notarget
       _ -> ((off, Nothing), x):next
     where
     notarget = ((off, Just Return), x):next