X-Git-Url: http://wien.tomnetworks.com/gitweb/?a=blobdiff_plain;f=Mate%2FX86TrapHandling.hs;h=82ed7ca0d738ca3ad52b1a0f23562ac8ae0e9597;hb=c541c18161f42753454ab94bbc5e1a43ef89ae40;hp=23be786ee65cfce828afe2bebd6651c78dd831af;hpb=c00b8e4b5d8179be5c34b9d7b3fcfc3cb364b86b;p=mate.git

diff --git a/Mate/X86TrapHandling.hs b/Mate/X86TrapHandling.hs
index 23be786..82ed7ca 100644
--- a/Mate/X86TrapHandling.hs
+++ b/Mate/X86TrapHandling.hs
@@ -7,12 +7,12 @@ module Mate.X86TrapHandling (
 
 import Numeric
 import qualified Data.Map as M
-import qualified Data.ByteString.Lazy as B
+import Control.Monad
 
 import Foreign
 import Foreign.C.Types
 
-import Harpy
+import Harpy hiding (fst)
 
 import Mate.Types
 import Mate.NativeSizes
@@ -26,37 +26,39 @@ import Harpy.X86Disassembler
 foreign import ccall "register_signal"
   register_signal :: IO ()
 
-foreign export ccall mateHandler :: CPtrdiff -> CPtrdiff -> CPtrdiff -> CPtrdiff -> IO CPtrdiff
-mateHandler :: CPtrdiff -> CPtrdiff -> CPtrdiff -> CPtrdiff -> IO CPtrdiff
-mateHandler reip reax rebx resi = do
+foreign export ccall mateHandler :: CPtrdiff -> CPtrdiff -> CPtrdiff -> CPtrdiff -> CPtrdiff -> IO CPtrdiff
+mateHandler :: CPtrdiff -> CPtrdiff -> CPtrdiff -> CPtrdiff -> CPtrdiff -> IO CPtrdiff
+mateHandler reip reax rebx resi resp = do
   tmap <- getTrapMap
   let reipw32 = fromIntegral reip
   (deleteMe, ret_nreip) <- case M.lookup reipw32 tmap of
-    (Just (StaticMethod _)) ->
-        patchWithHarpy patchStaticCall reip >>= delTrue
+    (Just (StaticMethod patcher)) ->
+        patchWithHarpy patcher reip >>= delFalse
     (Just (StaticField _))  ->
         staticFieldHandler reip >>= delTrue
-    (Just (InstanceOf cn))  ->
-        patchWithHarpy (`patchInstanceOf` cn) reip >>= delFalse
-    (Just (NewObject cn))   ->
-        patchWithHarpy (`patchNewObject` cn) reip >>= delTrue
-    (Just (VirtualCall False _ io_offset)) ->
-        patchWithHarpy (patchInvoke reax reax io_offset) reip
-        >>= delTrue
-    (Just (VirtualCall True  _ io_offset)) ->
-        patchWithHarpy (patchInvoke rebx reax io_offset) reip
-        >>= delTrue
+    (Just (ObjectField patcher)) ->
+        patchWithHarpy patcher reip >>= delTrue
+    (Just (InstanceOf patcher))  ->
+        patchWithHarpy (patcher reax) reip >>= delFalse
+    (Just (ThrowException patcher)) ->
+        patchWithHarpy (patcher reax resp) reip >>= delFalse
+    (Just (NewObject patcher))   ->
+        patchWithHarpy patcher reip >>= delTrue
+    (Just (VirtualCall False mi io_offset)) ->
+        patchWithHarpy (patchInvoke mi reax reax io_offset) reip
+        >>= delFalse
+    (Just (VirtualCall True  mi io_offset)) ->
+        patchWithHarpy (patchInvoke mi rebx reax io_offset) reip
+        >>= delFalse
     Nothing -> case resi of
-        0x13371234 -> return (-1) >>= delFalse
-        _ -> error $ "getTrapType: abort :-( " ++ (showHex reip ". ")
-             ++ (concatMap (`showHex` ", ") (M.keys tmap))
-  if deleteMe
-    then setTrapMap $ M.delete reipw32 tmap
-    else return ()
+        0x13371234 -> delFalse (-1)
+        _ -> error $ "getTrapType: abort :-( eip: "
+             ++ showHex reip ". " ++ concatMap (`showHex` ", ") (M.keys tmap)
+  when deleteMe $ setTrapMap $ M.delete reipw32 tmap
   return ret_nreip
-  where
-    delTrue = (\nreip -> return (False, nreip))
-    delFalse = (\nreip -> return (False, nreip))
+    where
+      delTrue x = return (True,x)
+      delFalse x = return (False,x)
 
 
 patchWithHarpy :: (CPtrdiff -> CodeGen () () CPtrdiff) -> CPtrdiff -> IO CPtrdiff
@@ -67,10 +69,8 @@ patchWithHarpy patcher reip = do
   let entry = Just (intPtrToPtr (fromIntegral reip), fixme)
   let cgconfig = defaultCodeGenConfig { customCodeBuffer = entry }
   (_, Right right) <- runCodeGenWithConfig (withDisasm $ patcher reip) () () cgconfig
-  if mateDEBUG
-    then mapM_ (printfJit . printf "patched: %s\n" . showAtt) $ snd right
-    else return ()
-  return reip
+  when mateDEBUG $ mapM_ (printfJit . printf "patched: %s\n" . showIntel) $ snd right
+  return $ fst right
 
 withDisasm :: CodeGen e s CPtrdiff -> CodeGen e s (CPtrdiff, [Instruction])
 withDisasm patcher = do
@@ -78,13 +78,6 @@ withDisasm patcher = do
   d <- disassemble
   return (reip, d)
 
-patchStaticCall :: CPtrdiff -> CodeGen e s CPtrdiff
-patchStaticCall reip = do
-  entryAddr <- liftIO $ getMethodEntry reip 0
-  call (fromIntegral (entryAddr - (reip + 5)) :: NativeWord)
-  return reip
-
-
 staticFieldHandler :: CPtrdiff -> IO CPtrdiff
 staticFieldHandler reip = do
   -- patch the offset here, first two bytes are part of the insn (opcode + reg)
@@ -96,26 +89,13 @@ staticFieldHandler reip = do
       return reip
     else error "staticFieldHandler: something is wrong here. abort.\n"
 
-patchInstanceOf :: CPtrdiff -> B.ByteString -> CodeGen e s CPtrdiff
-patchInstanceOf reip classname = do
-  mtable <- liftIO $ getMethodTable classname
-  mov edx mtable
-  return reip
-
-patchNewObject :: CPtrdiff -> B.ByteString -> CodeGen e s CPtrdiff
-patchNewObject reip classname = do
-  objsize <- liftIO $ getObjectSize classname
-  push32 objsize
-  callMalloc
-  mtable <- liftIO $ getMethodTable classname
-  mov (Disp 0, eax) mtable
-  return reip
-
-patchInvoke :: CPtrdiff -> CPtrdiff -> IO NativeWord -> CPtrdiff -> CodeGen e s CPtrdiff
-patchInvoke method_table table2patch io_offset reip = do
+patchInvoke :: MethodInfo -> CPtrdiff -> CPtrdiff -> IO NativeWord -> CPtrdiff -> CodeGen e s CPtrdiff
+patchInvoke (MethodInfo methname _ msig)  method_table table2patch io_offset reip = do
+  vmap <- liftIO getVirtualMap
+  let newmi = MethodInfo methname (vmap M.! fromIntegral method_table) msig
   offset <- liftIO io_offset
-  entryAddr <- liftIO $ getMethodEntry reip method_table
-  call32_eax (Disp offset)
+  (entryAddr, _) <- liftIO $ getMethodEntry newmi
+  call32Eax (Disp offset)
   -- patch entry in table
   let call_insn = intPtrToPtr . fromIntegral $ table2patch + fromIntegral offset
   liftIO $ poke call_insn entryAddr