From ecec298c7b0723081b1aea7447eae6f04118df34 Mon Sep 17 00:00:00 2001
From: Bernhard Urban <lewurm@gmail.com>
Date: Sun, 9 Sep 2012 14:24:01 +0200
Subject: [PATCH] basicblock: store length of basiblock (i.e. bytes of
 instructionstream)

---
 Mate/BasicBlocks.hs | 54 ++++++++++++++++++---------------------------
 Mate/Types.hs       |  6 ++++-
 2 files changed, 27 insertions(+), 33 deletions(-)

diff --git a/Mate/BasicBlocks.hs b/Mate/BasicBlocks.hs
index 5b68cfb..af00749 100644
--- a/Mate/BasicBlocks.hs
+++ b/Mate/BasicBlocks.hs
@@ -36,13 +36,10 @@ type BBState = S.Set Target
 type AnalyseState = State BBState [OffIns]
 
 
-noException :: B.ByteString
-noException = B.empty
-
 emptyBasicBlock :: BasicBlock
 emptyBasicBlock = BasicBlock
                     { code = []
-                    , exception = noException
+                    , bblength = 0
                     , successor = Return }
 
 printMapBB :: MapBB -> IO ()
@@ -57,7 +54,7 @@ printMapBB hmap = do
       printMapBB' [] _ = return ()
       printMapBB' (i:is) hmap' = case M.lookup i hmap' of
         Just bb -> do
-          printfBb $ "Block " ++ show i ++ "\n"
+          printfBb $ "Block " ++ show i ++ ". len: " ++ (show $ bblength bb) ++ "\n"
           mapM_ (printfBb . flip (++) "\n" . (++) "\t" . show) $ code bb
           printfBb $ case successor bb of
             Return -> ""
@@ -98,7 +95,7 @@ parseMethod cls methodname sig = do
                 (error $ "codeseg " ++ (show . toString) methodname ++ " not found")
                 (attrByName method "Code")
   let decoded = decodeMethod codeseg
-  let mapbb = testCFG cls decoded
+  let mapbb = testCFG decoded
   let locals = fromIntegral (codeMaxLocals decoded)
   let stacks = fromIntegral (codeStackSize decoded)
   let codelen = fromIntegral (codeLength decoded)
@@ -107,24 +104,25 @@ parseMethod cls methodname sig = do
   let nametype = methodNameType methoddirect
   let argscount = methodGetArgsCount nametype + (if isStatic then 0 else 1)
 
-  -- TODO: remove ;-)
-  -- small example how to get information about
-  -- exceptions of a method
-  let (Just m) = lookupMethodSig methodname sig cls
-  case attrByName m "Code" of
-    Nothing ->
-      printfBb $ printf "exception: no handler for this method\n"
-    Just exceptionstream ->
-      printfBb $ printf "exception: \"%s\"\n" (show $ codeExceptions $ decodeMethod exceptionstream)
-  -- [/remove]
+  let exceptionMap :: ExceptionMap
+      exceptionMap = foldl f M.empty $ codeExceptions decoded
+        where
+          f emap ce =
+            if M.member key emap
+              then M.adjust (value:) key emap
+              else M.insert key [value] emap
+              where
+                key = (&&&) eStartPC eEndPC ce
+                value = (&&&) (buildClassID cls . eCatchType) eHandlerPC ce
+
   let msig = methodSignature method
   printfBb $ printf "BB: analysing \"%s\"\n" $ toString (methodname `B.append` ": " `B.append` encode msig)
   printMapBB mapbb
-  return $ RawMethod mapbb locals stacks argscount codelen
+  return $ RawMethod mapbb exceptionMap locals stacks argscount codelen
 
 
-testCFG :: Class Direct -> Code -> MapBB
-testCFG cls c = buildCFG (codeInstructions c) (codeExceptions c)
+testCFG :: Code -> MapBB
+testCFG c = buildCFG (codeInstructions c) (codeExceptions c)
   where
     buildCFG :: [Instruction] -> [CodeException] -> MapBB
     buildCFG xs excps = execState (mapM buildCFG' $ alltargets ++ handlerEntries) M.empty
@@ -134,28 +132,20 @@ testCFG cls c = buildCFG (codeInstructions c) (codeExceptions c)
       tryBlocks = map (fromIntegral . eStartPC) excps
       handlerEntries = map (fromIntegral . eHandlerPC) excps
 
-      exceptionMap :: M.Map (Word16, Word16) [(B.ByteString, Word16)]
-      exceptionMap = foldl f M.empty excps
-        where
-          f emap ce =
-            if M.member key emap
-              then M.adjust (value:) key emap
-              else M.insert key [value] emap
-              where
-                key = (&&&) eStartPC eEndPC ce
-                value = (&&&) (buildClassID cls . eCatchType) eHandlerPC ce
-
       buildCFG' :: Int -> State MapBB ()
       buildCFG' off = do
         let value = parseBasicBlock off offins
         modify (M.insert off value)
 
 parseBasicBlock :: Int -> [OffIns] -> BasicBlock
-parseBasicBlock i insns = emptyBasicBlock { code = insonly, successor = endblock }
+parseBasicBlock i insns = emptyBasicBlock
+          { code = insonly
+          , bblength = lastoff - i + (insnLength lastins)
+          , successor = endblock }
   where
     (lastblock, is) = takeWhilePlusOne validins omitins insns
     (_, _, insonly) = unzip3 is
-    (_, Just endblock, _) = fromJust lastblock
+    (lastoff, Just endblock, lastins) = fromJust lastblock
 
     -- also take last (non-matched) element and return it
     takeWhilePlusOne :: (a -> Bool) -> (a -> Bool) -> [a] -> (Maybe a, [a])
diff --git a/Mate/Types.hs b/Mate/Types.hs
index de17e37..bff97df 100644
--- a/Mate/Types.hs
+++ b/Mate/Types.hs
@@ -4,6 +4,7 @@ module Mate.Types
   , BasicBlock(..)
   , BBEnd(..)
   , MapBB
+  , ExceptionMap
   , RawMethod(..)
   , TrapMap, MethodMap, ClassMap, FieldMap
   , StringMap, VirtualMap, InterfaceMap
@@ -23,6 +24,7 @@ module Mate.Types
 
 import Data.Int
 import Data.Functor
+import Data.Word
 import qualified Data.Map as M
 import qualified Data.ByteString.Lazy as B
 
@@ -42,7 +44,7 @@ type BlockID = Int
 -- Represents a CFG node
 data BasicBlock = BasicBlock {
   code :: [Instruction],
-  exception :: B.ByteString,
+  bblength :: Int,
   successor :: BBEnd }
 
 -- describes (leaving) edges of a CFG node
@@ -54,9 +56,11 @@ data BBEnd
   deriving Show
 
 type MapBB = M.Map BlockID BasicBlock
+type ExceptionMap = M.Map (Word16, Word16) [(B.ByteString, Word16)]
 
 data RawMethod = RawMethod {
   rawMapBB :: MapBB,
+  rawExcpMap :: ExceptionMap,
   rawLocals :: Int,
   rawStackSize :: Int,
   rawArgCount :: NativeWord,
-- 
2.25.1