codegen: handle exceptions of a method

[mate.git] / Mate / X86CodeGen.hs

diff --git a/Mate/X86CodeGen.hs b/Mate/X86CodeGen.hs
index 621f0c2c6c70ed171a5f0236f06f323abe05e384..a61fac314b6d142c4f8dff0289a290c1a252e18f 100644 (file)
--- a/Mate/X86CodeGen.hs
+++ b/Mate/X86CodeGen.hs
@@ -7,8 +7,9 @@ import Data.Binary
 import Data.BinaryState
 import Data.Int
 import Data.Maybe
-import Data.List (genericLength)
+import Data.List (genericLength, find)
 import qualified Data.Map as M
+import qualified Data.Bimap as BI
 import qualified Data.ByteString.Lazy as B
 import Control.Monad
 import Control.Applicative
@@ -20,7 +21,7 @@ import qualified JVM.Assembler as J
 import JVM.Assembler hiding (Instruction)
 import JVM.ClassFile
 
-import Harpy
+import Harpy hiding (fst)
 import Harpy.X86Disassembler
 
 import Mate.BasicBlocks
@@ -31,6 +32,7 @@ import Mate.ClassPool
 import Mate.ClassHierarchy
 import {-# SOURCE #-} Mate.MethodPool
 import Mate.Strings
+import Mate.Debug
 
 
 foreign import ccall "&mallocObjectGC"
@@ -45,8 +47,8 @@ type BBStarts = M.Map BlockID Int
 type CompileInfo = (EntryPoint, Int, TrapMap)
 
 
-emitFromBB :: Class Direct -> RawMethod -> CodeGen e s (CompileInfo, [Instruction])
-emitFromBB cls method = do
+emitFromBB :: Class Direct -> MethodInfo -> RawMethod -> CodeGen e JpcNpcMap (CompileInfo, [Instruction])
+emitFromBB cls miThis method = do
     let keys = M.keys hmap
     llmap <- mapM (newNamedLabel . (++) "bb_" . show) keys
     let lmap = zip keys llmap
@@ -65,16 +67,16 @@ emitFromBB cls method = do
   getLabel bid [] = error $ "label " ++ show bid ++ " not found"
   getLabel i ((x,l):xs) = if i==x then l else getLabel i xs
 
-  efBB :: [(BlockID, Label)] -> BlockID -> CodeGen e s [(Maybe (Word32, TrapCause))]
+  efBB :: [(BlockID, Label)] -> BlockID -> CodeGen e JpcNpcMap [(Maybe (Word32, TrapCause))]
   efBB lmap bid = do
     defineLabel $ getLabel bid lmap
-    ret <- mapM emit'' $ code bb
+    retval <- mapM emit'' $ code bb
     case successor bb of
         FallThrough t -> do
           -- TODO(bernhard): le dirty hax. see java/lang/Integer.toString(int, int)
           jmp (getLabel t lmap)
         _ -> return ()
-    return ret
+    return retval
     where
     bb = hmap M.! bid
 
@@ -98,7 +100,7 @@ emitFromBB cls method = do
       -- like: call $0x01234567
       calladdr <- emitSigIllTrap 5
       let patcher reip = do
-            entryAddr <- liftIO $ getMethodEntry l
+            (entryAddr, _) <- liftIO $ getMethodEntry l
             call (fromIntegral (entryAddr - (reip + 5)) :: NativeWord)
             return reip
       -- discard arguments on stack
@@ -137,8 +139,12 @@ emitFromBB cls method = do
       -- depending on the method-table-ptr
       return $ Just (calladdr, VirtualCall isInterface mi offset)
 
-    emit'' :: J.Instruction -> CodeGen e s (Maybe (Word32, TrapCause))
-    emit'' insn = newNamedLabel ("jvm_insn: " ++ show insn) >>= defineLabel >> emit' insn
+    emit'' :: (Int, J.Instruction) -> CodeGen e JpcNpcMap (Maybe (Word32, TrapCause))
+    emit'' (jpc, insn) = do
+      npc <- getCurrentOffset
+      jpcrpc <- getState
+      setState (BI.insert jpc npc jpcrpc)
+      newNamedLabel ("jvm_insn: " ++ show insn) >>= defineLabel >> emit' insn
 
     emit' :: J.Instruction -> CodeGen e s (Maybe (Word32, TrapCause))
     emit' (INVOKESPECIAL cpidx) = emitInvoke cpidx True
@@ -212,11 +218,40 @@ emitFromBB cls method = do
       return $ Just (trapaddr, NewObject patcher)
 
     emit' ATHROW = do
+      pop eax
+      push eax
+      mov eax (Disp 0, eax)
       trapaddr <- emitSigIllTrap 2
-      let patcher resp reip = do
-            error "no athrow for you, sorry"
+      let patcher :: TrapPatcherEaxEsp
+          patcher reax resp reip = do
+            liftIO $ printfJit $ printf "reip: %d\n" (fromIntegral reip :: Word32)
+            liftIO $ printfJit $ printf "reax: %d\n" (fromIntegral reax :: Word32)
+            (_, jnmap) <- liftIO $ getMethodEntry miThis
+            liftIO $ printfJit $ printf "size: %d\n" (BI.size jnmap)
+            liftIO $ printfJit $ printf "jnmap: %s\n" (show $ BI.toList jnmap)
+            -- TODO: (-4) is a hack (due to the insns above)
+            let jpc = fromIntegral (jnmap BI.!> (fromIntegral reip - 4))
+            let exceptionmap = rawExcpMap method
+            liftIO $ printfJit $ printf "exmap: %s\n" (show $ M.toList exceptionmap)
+            let key =
+                  case find f $ M.keys exceptionmap of
+                    Just x -> x
+                    Nothing -> error "exception: no handler found. (TODO1)"
+                  where
+                    f (x, y) = jpc >= x && jpc <= y
+            liftIO $ printfJit $ printf "exception: key is: %s\n" (show key)
+            let handlerJPCs = exceptionmap M.! key
+            let f (x, y) = do x' <- getMethodTable x; return (fromIntegral x', y)
+            handlers <- liftIO $ mapM f handlerJPCs
+            liftIO $ printfJit $ printf "exception: handlers: %s\n" (show handlers)
+            let handlerJPC =
+                  case find ((==) reax . fst) handlers of
+                    Just x -> x
+                    Nothing -> error "exception: no handler found (TODO2)"
+            let handlerNPC = jnmap BI.! (fromIntegral $ snd handlerJPC)
+            liftIO $ printfJit $ printf "exception: handler at: 0x%08x\n" handlerNPC
             emitSigIllTrap 2
-            return reip
+            return $ fromIntegral handlerNPC
       return $ Just (trapaddr, ThrowException patcher)
 
     emit' insn = emit insn >> return Nothing