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

diff --git a/Mate/BasicBlocks.hs b/Mate/BasicBlocks.hs
index b52f22d..2a8ac22 100644
--- a/Mate/BasicBlocks.hs
+++ b/Mate/BasicBlocks.hs
@@ -3,12 +3,12 @@
 #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
@@ -26,6 +26,7 @@ import JVM.Assembler
 
 import Mate.Types
 import Mate.Debug
+import Mate.Utilities
 
 #ifdef DEBUG
 import Text.Printf
@@ -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
+                     let keys = M.keys hmap
                      mapM_ (putStr . (flip (++)) ", " . show) keys
                      putStrLn "\n\nBasicBlocks:"
                      printMapBB' keys hmap
@@ -61,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
 
@@ -83,31 +84,39 @@ 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 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
@@ -193,6 +202,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