X-Git-Url: http://wien.tomnetworks.com/gitweb/?a=blobdiff_plain;f=Mate%2FBasicBlocks.hs;h=c2bdcd7587b43eeef08f426994259944a6151957;hb=b2cb1c7393ad3eaf43b3cd928e6e4a932324eaa1;hp=555f4661ebb701818d548635830f561bf8f6a21f;hpb=bc05c4601a08bc81f459b98ac54575fd4b56fb48;p=mate.git diff --git a/Mate/BasicBlocks.hs b/Mate/BasicBlocks.hs index 555f466..c2bdcd7 100644 --- a/Mate/BasicBlocks.hs +++ b/Mate/BasicBlocks.hs @@ -19,6 +19,7 @@ import Data.Int import Data.List import qualified Data.Map as M import qualified Data.ByteString.Lazy as B +import Data.Maybe import JVM.ClassFile import JVM.Converter @@ -87,38 +88,42 @@ test_04 = testInstance "./tests/Fac.class" "fac" #endif -parseMethod :: Class Direct -> B.ByteString -> MethodSignature -> IO (Maybe RawMethod) -parseMethod cls method sig = do - let maybe_bb = testCFG $ lookupMethodSig method sig cls +parseMethod :: Class Direct -> B.ByteString -> MethodSignature -> IO RawMethod +parseMethod cls methodname sig = do + let method = fromMaybe + (error $ "method " ++ (show . toString) methodname ++ " not found") + (lookupMethodSig methodname sig cls) + let codeseg = fromMaybe + (error $ "codeseg " ++ (show . toString) methodname ++ " not found") + (attrByName method "Code") + let decoded = decodeMethod codeseg + let mapbb = testCFG decoded + let locals = fromIntegral (codeMaxLocals decoded) + let stacks = fromIntegral (codeStackSize decoded) + let methoddirect = methodInfoToMethod (MethodInfo methodname "" sig) cls + let isStatic = methodIsStatic methoddirect + let nametype = methodNameType methoddirect + let argscount = methodGetArgsCount nametype + (if isStatic then 0 else 1) + let msig = methodSignature $ classMethods cls !! 1 - printfBb "BB: analysing \"%s\"\n" $ toString (method `B.append` ": " `B.append` encode msig) + printfBb "BB: analysing \"%s\"\n" $ toString (methodname `B.append` ": " `B.append` encode msig) #ifdef DBG_BB - case maybe_bb of - Just m -> printMapBB $ rawMapBB m - Nothing -> return () + printMapBB mapbb #endif -- small example how to get information about -- exceptions of a method -- TODO: remove ;-) - let (Just m) = lookupMethodSig method sig cls + let (Just m) = lookupMethodSig methodname 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 + return $ RawMethod mapbb locals stacks argscount -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 - +testCFG :: Code -> MapBB +testCFG = buildCFG . codeInstructions buildCFG :: [Instruction] -> MapBB buildCFG xs = buildCFG' M.empty xs' xs'