{-# LANGUAGE OverloadedStrings #-}
-module Mate.BasicBlocks where
+module Mate.BasicBlocks(
+ BlockID,
+ BasicBlock (..),
+ BBEnd (..),
+ MapBB,
+ printMapBB,
+ parseMethod
+ )where
import Data.Binary
import Data.Int
type OffIns = (Offset, Instruction)
-main = do
- args <- getArgs
- case args of
- [clspath] -> parseFile clspath "fib" -- TODO
- _ -> error "Synopsis: dump-class File.class"
-
-
-parseFile :: String -> B.ByteString -> IO ()
-parseFile clspath method = do
- --clsFile <- decodeFile clspath
- --putStrLn $ showListIx $ M.assocs $ constsPool (clsFile :: Class Pointers)
- cls <- parseClassFile clspath
- --dumpClass cls
- let mainmethod = lookupMethod method cls -- "main|([Ljava/lang/String;)V" cf
- let hmap = testCFG mainmethod
+printMapBB :: Maybe MapBB -> IO ()
+printMapBB Nothing = putStrLn "No BasicBlock"
+printMapBB (Just hmap) = do
putStr "BlockIDs: "
let keys = fst $ unzip $ H.toList hmap
mapM_ (putStr . (flip (++)) ", " . show) keys
putStrLn "\n\nBasicBlocks:"
- printMapBB keys hmap
-
-printMapBB :: [BlockID] -> MapBB -> IO ()
-printMapBB [] _ = return ()
-printMapBB (i:is) hmap = case H.lookup i hmap of
- Just bb -> do
- putStrLn $ "Block " ++ (show i)
- mapM_ putStrLn (map ((++) "\t" . show) $ code bb)
- case successor bb of
- Return -> putStrLn ""
- OneTarget t1 -> putStrLn $ "Sucessor: " ++ (show t1) ++ "\n"
- TwoTarget t1 t2 -> putStrLn $ "Sucessor: " ++ (show t1) ++ ", " ++ (show t2) ++ "\n"
- printMapBB is hmap
- Nothing -> error $ "BlockID " ++ show i ++ " not found."
-
-test_01 = parseFile "./tests/Fib.class" "fib"
-test_02 = parseFile "./tests/While.class" "f"
-test_03 = parseFile "./tests/While.class" "g"
-
-
-testCFG :: Maybe (Method Resolved) -> MapBB
+ printMapBB' keys hmap
+ where
+ printMapBB' :: [BlockID] -> MapBB -> IO ()
+ printMapBB' [] _ = return ()
+ printMapBB' (i:is) hmap = case H.lookup i hmap of
+ Just bb -> do
+ putStrLn $ "Block " ++ (show i)
+ mapM_ putStrLn (map ((++) "\t" . show) $ code bb)
+ case successor bb of
+ Return -> putStrLn ""
+ OneTarget t1 -> putStrLn $ "Sucessor: " ++ (show t1) ++ "\n"
+ TwoTarget t1 t2 -> putStrLn $ "Sucessor: " ++ (show t1) ++ ", " ++ (show t2) ++ "\n"
+ printMapBB' is hmap
+ Nothing -> error $ "BlockID " ++ show i ++ " not found."
+
+testInstance :: String -> B.ByteString -> IO ()
+testInstance cf method = do
+ hmap <- parseMethod cf method
+ printMapBB hmap
+
+test_01 = testInstance "./tests/Fib.class" "fib"
+test_02 = testInstance "./tests/While.class" "f"
+test_03 = testInstance "./tests/While.class" "g"
+
+
+parseMethod :: String -> B.ByteString -> IO (Maybe MapBB)
+parseMethod clspath method = do
+ cls <- parseClassFile clspath
+ return $ testCFG $ lookupMethod method cls
+
+
+testCFG :: Maybe (Method Resolved) -> Maybe MapBB
testCFG (Just m) = case attrByName m "Code" of
- Nothing -> error "no code"
+ Nothing -> Nothing
Just bytecode -> let code = decodeMethod bytecode
instructions = codeInstructions code
- in buildCFG instructions
-testCFG _ = error "no method to build cfg"
+ in Just $ buildCFG instructions
+testCFG _ = Nothing
buildCFG :: [Instruction] -> MapBB