#include "debug.h"
module Mate.BasicBlocks(
BlockID,
- BasicBlock (..),
- BBEnd (..),
+ BasicBlock,
+ BBEnd,
MapBB,
+ Method,
#ifdef DBG_BB
printMapBB,
- test_main,
#endif
parseMethod,
testCFG -- added by hs to perform benches from outside
import Mate.Types
import Mate.Debug
+import Mate.Utilities
#ifdef DEBUG
import Text.Printf
#ifdef DBG_BB
-printMapBB :: Maybe MapBB -> IO ()
-printMapBB Nothing = putStrLn "No BasicBlock"
-printMapBB (Just hmap) = do
+printMapBB :: MapBB -> IO ()
+printMapBB hmap = do
putStr "BlockIDs: "
- let keys = fst $ unzip $ M.toList hmap
+ let keys = M.keys hmap
mapM_ (putStr . (flip (++)) ", " . show) keys
putStrLn "\n\nBasicBlocks:"
printMapBB' keys hmap
Nothing -> error $ "BlockID " ++ show i ++ " not found."
#endif
+#if 0
#ifdef DBG_BB
-testInstance :: String -> B.ByteString -> IO ()
-testInstance cf method = do
+testInstance :: String -> B.ByteString -> MethodSignature -> IO ()
+testInstance cf method sig = do
cls <- parseClassFile cf
- hmap <- parseMethod cls method
+ hmap <- parseMethod cls method sig
printMapBB hmap
#endif
test_03 = testInstance "./tests/While.class" "g"
test_04 = testInstance "./tests/Fac.class" "fac"
#endif
+#endif
-parseMethod :: Class Direct -> B.ByteString -> IO (Maybe MapBB)
-parseMethod cls method = do
- let maybe_bb = testCFG $ lookupMethod method cls
+parseMethod :: Class Direct -> B.ByteString -> MethodSignature -> IO (Maybe RawMethod)
+parseMethod cls method sig = do
+ let maybe_bb = testCFG $ lookupMethodSig method sig cls
let msig = methodSignature $ classMethods cls !! 1
printfBb "BB: analysing \"%s\"\n" $ toString (method `B.append` ": " `B.append` encode msig)
#ifdef DBG_BB
- printMapBB maybe_bb
+ case maybe_bb of
+ Just m -> printMapBB $ rawMapBB m
+ Nothing -> return ()
#endif
-- small example how to get information about
-- exceptions of a method
-- TODO: remove ;-)
- let (Just m) = lookupMethod method cls
+ let (Just m) = lookupMethodSig method sig cls
case attrByName m "Code" of
Nothing -> printfBb "exception: no handler for this method\n"
- Just exceptionstream -> printfBb "exception: \"%s\"\n" (show $ codeExceptions $ decodeMethod exceptionstream)
+ Just exceptionstream -> do
+ printfBb "exception: \"%s\"\n" (show $ codeExceptions $ decodeMethod exceptionstream)
return maybe_bb
-testCFG :: Maybe (Method Direct) -> Maybe MapBB
-testCFG (Just m) = case attrByName m "Code" of
- Nothing -> Nothing
- Just bytecode -> Just $ buildCFG $ codeInstructions $ decodeMethod bytecode
-testCFG _ = Nothing
+testCFG :: Maybe (Method Direct) -> Maybe RawMethod
+testCFG m = do
+ m' <- m
+ codeseg <- attrByName m' "Code"
+ let decoded = decodeMethod codeseg
+ let mapbb = buildCFG $ codeInstructions decoded
+ let locals = fromIntegral (codeMaxLocals decoded)
+ let stacks = fromIntegral (codeStackSize decoded)
+ return $ RawMethod mapbb locals stacks
buildCFG :: [Instruction] -> MapBB
IF _ w16 -> twotargets w16
IF_ICMP _ w16 -> twotargets w16
IF_ACMP _ w16 -> twotargets w16
+ IFNONNULL w16 -> twotargets w16
+ IFNULL w16 -> twotargets w16
GOTO w16 -> onetarget w16
IRETURN -> notarget
ARETURN -> notarget