X-Git-Url: http://wien.tomnetworks.com/gitweb/?a=blobdiff_plain;f=Mate%2FBasicBlocks.hs;h=fbb61f7a06ecf6a471d5b33385953f58228ee19b;hb=f82dbecc763818452667ac568da96b7c5dd7cc97;hp=3c0b93cfef82b9380aedce1f04aedeceaae0bdf1;hpb=b3427c38e5e0b38e44df820e03cabf91613be1ce;p=mate.git diff --git a/Mate/BasicBlocks.hs b/Mate/BasicBlocks.hs index 3c0b93c..fbb61f7 100644 --- a/Mate/BasicBlocks.hs +++ b/Mate/BasicBlocks.hs @@ -8,7 +8,6 @@ module Mate.BasicBlocks( MapBB, #ifdef DBG_BB printMapBB, - test_main, #endif parseMethod, testCFG -- added by hs to perform benches from outside @@ -24,9 +23,9 @@ import JVM.ClassFile import JVM.Converter import JVM.Assembler -import Mate.Utilities import Mate.Types import Mate.Debug +import Mate.Utilities #ifdef DEBUG import Text.Printf @@ -42,7 +41,7 @@ printMapBB :: Maybe MapBB -> IO () printMapBB Nothing = putStrLn "No BasicBlock" printMapBB (Just 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 @@ -62,11 +61,12 @@ printMapBB (Just hmap) = do 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 @@ -84,11 +84,12 @@ test_02 = testInstance "./tests/While.class" "f" test_03 = testInstance "./tests/While.class" "g" test_04 = testInstance "./tests/Fac.class" "fac" #endif +#endif -parseMethod :: Class Resolved -> B.ByteString -> IO (Maybe MapBB) -parseMethod cls method = do - let maybe_bb = testCFG $ lookupMethod method cls +parseMethod :: Class Direct -> B.ByteString -> MethodSignature -> IO (Maybe MapBB) +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 @@ -97,18 +98,18 @@ parseMethod cls method = do -- 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) return maybe_bb -testCFG :: Maybe (Method Resolved) -> 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 MapBB +testCFG m = do + m' <- m + bytecode <- attrByName m' "Code" + return $ buildCFG $ codeInstructions $ decodeMethod bytecode buildCFG :: [Instruction] -> MapBB @@ -194,6 +195,8 @@ calculateInstructionOffset = cio' (0, Nothing) 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