From a6e23e6cdfff068398a0e50bcd757832554effb5 Mon Sep 17 00:00:00 2001
From: Bernhard Urban <lewurm@gmail.com>
Date: Sun, 9 Sep 2012 17:59:57 +0200
Subject: [PATCH] basicblock: handle athrow as return

---
 Mate/BasicBlocks.hs | 41 ++++++++++++++++++++++++-----------------
 Mate/X86CodeGen.hs  |  1 +
 doc/TODO            |  4 ++++
 3 files changed, 29 insertions(+), 17 deletions(-)

diff --git a/Mate/BasicBlocks.hs b/Mate/BasicBlocks.hs
index 3d520b7..1795600 100644
--- a/Mate/BasicBlocks.hs
+++ b/Mate/BasicBlocks.hs
@@ -107,29 +107,32 @@ parseMethod cls methodname sig = do
   let nametype = methodNameType methoddirect
   let argscount = methodGetArgsCount nametype + (if isStatic then 0 else 1)
 
-  let msig = methodSignature method
-  printfBb $ printf "BB: analysing \"%s\"\n" $ toString (methodname `B.append` ": " `B.append` encode msig)
-  printMapBB mapbb
+  -- TODO: remove ;-)
   -- small example how to get information about
   -- exceptions of a method
-  -- TODO: remove ;-)
   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 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
 
 
 testCFG :: Code -> MapBB
-testCFG = buildCFG . codeInstructions
+testCFG c = buildCFG (codeInstructions c) (codeExceptions c)
 
-buildCFG :: [Instruction] -> MapBB
-buildCFG xs = execState (mapM (buildCFG' offins) alltargets) M.empty
+buildCFG :: [Instruction] -> [CodeException] -> MapBB
+buildCFG xs excps = execState (mapM (buildCFG' offins) $ alltargets ++ handlerEntries) M.empty
   where
-  (offins, targets) = runState (calculateInstructionOffset xs) S.empty
+  (offins, targets) = runState (calculateInstructionOffset tryBlocks xs) S.empty
   alltargets = S.toList $ S.insert 0 targets
+  tryBlocks = map (fromIntegral . eStartPC) excps
+  handlerEntries = map (fromIntegral . eHandlerPC) excps
 
 buildCFG' :: [OffIns] -> Int -> State MapBB ()
 buildCFG' insns off = do
@@ -160,26 +163,30 @@ parseBasicBlock i insns = emptyBasicBlock { code = insonly, successor = endblock
     omitins (off, _, _) = off < i
 
 
-calculateInstructionOffset :: [Instruction] -> AnalyseState
-calculateInstructionOffset = cio' (0, Nothing, NOP)
+calculateInstructionOffset :: [BlockID] -> [Instruction] -> AnalyseState
+calculateInstructionOffset exstarts = cio' 0
   where
-    addW16Signed :: Int -> Word16 -> Int
     addW16Signed i w16 = i + fromIntegral s16
       where s16 = fromIntegral w16 :: Int16
 
-    cio' :: OffIns -> [Instruction] -> AnalyseState
+    cio' :: Int -> [Instruction] -> AnalyseState
     cio' _ [] = return $ []
-    cio' (off,_,_) (x:xs) = case x of
+    cio' off (x:xs) = case x of
         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
+        ATHROW -> notarget
         IRETURN -> notarget
         ARETURN -> notarget
         RETURN -> notarget
-        _ -> normalins
+        _ -> if newoffset `elem` exstarts
+              then do
+                modify (S.insert newoffset)
+                ((off, Just $ OneTarget newoffset, x):) <$> next
+              else normalins
       where
         normalins = do
           tailinsns <- next -- eval remaining instructions
@@ -199,9 +206,9 @@ calculateInstructionOffset = cio' (0, Nothing, NOP)
           let jump = off `addW16Signed` w16
           modify (S.insert jump)
           ((off, Just $ TwoTarget nojump jump, x):) <$> next
-        next = cio' nextins xs
-        nextins = (newoffset, Nothing, NOP)
-        newoffset = off + insnLength x
+        next = cio' newoffset xs
+        newoffset = off + insLen
+        insLen = insnLength x
 
 -- TODO(bernhard): does GHC memomize results? i.e. does it calculate the size
 --                 of `NOP' only once?
diff --git a/Mate/X86CodeGen.hs b/Mate/X86CodeGen.hs
index af3e98d..5674523 100644
--- a/Mate/X86CodeGen.hs
+++ b/Mate/X86CodeGen.hs
@@ -226,6 +226,7 @@ emitFromBB cls method = do
     emit' ATHROW = do
       trapaddr <- emitSigIllTrap 2
       let patcher resp reip = do
+            error "no athrow for you, sorry"
             emitSigIllTrap 2
             return reip
       return $ Just (trapaddr, ThrowException patcher)
diff --git a/doc/TODO b/doc/TODO
index f65d294..525ed7c 100644
--- a/doc/TODO
+++ b/doc/TODO
@@ -81,6 +81,10 @@
 	-> seperate analysis, jit, execution, ...
 	-> maybe use ghc profiling? (it doesn't measure native execution, but well)
 
+(l) testing
+	-> specjvm98
+	-> dacapo benchmark suite
+
 
 (l) ... low priority
 (m) ... medium priority
-- 
2.25.1