debugmode: no maybe anymore

[mate.git] / Mate / BasicBlocks.hs

diff --git a/Mate/BasicBlocks.hs b/Mate/BasicBlocks.hs
index 555f4661ebb701818d548635830f561bf8f6a21f..c2bdcd7587b43eeef08f426994259944a6151957 100644 (file)
--- 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'