X-Git-Url: http://wien.tomnetworks.com/gitweb/?a=blobdiff_plain;f=Mate%2FBasicBlocks.hs;h=2a8ac22513df29f49bd56b55f912a1ee1a6425e6;hb=da245b03d80644c22b011acba31acacb880d8327;hp=ce676c224361fcde0af73bfa6e1ddf9e8a1fcbfd;hpb=a92b66dd82f6817efc937acbfcf4c6d4f10ecc29;p=mate.git

diff --git a/Mate/BasicBlocks.hs b/Mate/BasicBlocks.hs
index ce676c2..2a8ac22 100644
--- a/Mate/BasicBlocks.hs
+++ b/Mate/BasicBlocks.hs
@@ -3,9 +3,10 @@
 #include "debug.h"
 module Mate.BasicBlocks(
   BlockID,
-  BasicBlock (..),
-  BBEnd (..),
+  BasicBlock,
+  BBEnd,
   MapBB,
+  Method,
 #ifdef DBG_BB
   printMapBB,
 #endif
@@ -37,11 +38,10 @@ type OffIns = (Offset, Instruction)
 
 
 #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 -- M.keys
+                     let keys = M.keys hmap
                      mapM_ (putStr . (flip (++)) ", " . show) keys
                      putStrLn "\n\nBasicBlocks:"
                      printMapBB' keys hmap
@@ -87,13 +87,15 @@ test_04 = testInstance "./tests/Fac.class" "fac"
 #endif
 
 
-parseMethod :: Class Direct -> B.ByteString -> MethodSignature -> IO (Maybe MapBB)
+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
@@ -101,15 +103,20 @@ parseMethod cls method sig = do
                      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