codegen: handle exceptions of a method
[mate.git] / Mate / X86TrapHandling.hs
index f383c2d3635afdec98079b70931d7101cf929374..82ed7ca0d738ca3ad52b1a0f23562ac8ae0e9597 100644 (file)
-{-# LANGUAGE CPP #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE ForeignFunctionInterface #-}
-#include "debug.h"
-module Mate.X86TrapHandling where
+module Mate.X86TrapHandling (
+  mateHandler,
+  register_signal
+  ) where
 
+import Numeric
 import qualified Data.Map as M
+import Control.Monad
 
 import Foreign
 import Foreign.C.Types
 
+import Harpy hiding (fst)
+
 import Mate.Types
-import Mate.MethodPool
+import Mate.NativeSizes
+import {-# SOURCE #-} Mate.MethodPool
 import Mate.ClassPool
+import Mate.X86CodeGen
+
+import Mate.Debug
+import Harpy.X86Disassembler
 
 foreign import ccall "register_signal"
   register_signal :: IO ()
 
-
-getTrapType :: CUInt -> CUInt -> IO CUInt
-getTrapType signal_from from2 = 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
-  case M.lookup (fromIntegral signal_from) tmap of
-    (Just (MI _)) -> return 0
-    (Just (SFI _)) -> return 2
-    (Just _) -> error "getTrapMap: doesn't happen"
-    -- maybe we've a hit on the second `from' value
-    Nothing -> case M.lookup (fromIntegral from2) tmap of
-      (Just (VI True _)) -> return 1
-      (Just (VI False _)) -> return 5
-      (Just (II True _)) -> return 4
-      (Just (II False _)) -> return 8
-      (Just _) -> error "getTrapType: abort #1 :-("
-      Nothing -> error $ "getTrapType: abort #2 :-(" ++ show signal_from ++ ", " ++ show from2 ++ ", " ++ show tmap
+  let reipw32 = fromIntegral reip
+  (deleteMe, ret_nreip) <- case M.lookup reipw32 tmap of
+    (Just (StaticMethod patcher)) ->
+        patchWithHarpy patcher reip >>= delFalse
+    (Just (StaticField _))  ->
+        staticFieldHandler 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 -> 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 x = return (True,x)
+      delFalse x = return (False,x)
 
-foreign export ccall mateHandler :: CUInt -> CUInt -> CUInt -> CUInt -> IO CUInt
-mateHandler :: CUInt -> CUInt -> CUInt -> CUInt -> IO CUInt
-mateHandler eip eax ebx esp = do
-  callerAddr <- callerAddrFromStack esp
-  blah <- getTrapType eip callerAddr
-  case blah of
-    0 -> staticCallHandler eip
-    1 -> invokeHandler eax eax esp True
-    5 -> invokeHandler eax eax esp False
-    4 -> invokeHandler eax ebx esp True
-    8 -> invokeHandler eax ebx esp False
-    2 -> staticFieldHandler eip
-    x -> error $ "wtf: " ++ show x
 
-staticCallHandler :: CUInt -> IO CUInt
-staticCallHandler eip = do
-  -- the actual insn to patch is displaced by two bytes
-  let insn_ptr = intPtrToPtr (fromIntegral (eip - 2)) :: Ptr CUChar
-  -- call offset is displaced by one byte
-  let imm_ptr = intPtrToPtr (fromIntegral (eip - 1)) :: Ptr CUInt
-  -- in codegen we set the immediate to some magic value
-  -- in order to produce a SIGILL signal. we also do a safety
-  -- check here, if we're really the "owner" of this signal.
-  checkMe <- peek imm_ptr
-  case checkMe == 0x90ffff90 of
-    True -> do
-      entryAddr <- getMethodEntry eip 0
-      poke insn_ptr 0xe8 -- call opcode
-      -- it's a relative call, so we have to calculate the offset. why "+ 3"?
-      -- (1) the whole insn is 5 bytes long
-      -- (2) begin of insn is displaced by 2 bytes
-      -- (3) offset is calculated wrt to the beginning of the next insn
-      poke imm_ptr (entryAddr - (eip + 3))
-      return (eip - 2)
-    False -> error "staticCallHandler: something is wrong here. abort\n"
+patchWithHarpy :: (CPtrdiff -> CodeGen () () CPtrdiff) -> CPtrdiff -> IO CPtrdiff
+patchWithHarpy patcher reip = do
+  -- this is just an upperbound. if the value is to low, patching fails. find
+  -- something better?
+  let fixme = 1024
+  let entry = Just (intPtrToPtr (fromIntegral reip), fixme)
+  let cgconfig = defaultCodeGenConfig { customCodeBuffer = entry }
+  (_, Right right) <- runCodeGenWithConfig (withDisasm $ patcher reip) () () cgconfig
+  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
+  reip <- patcher
+  d <- disassemble
+  return (reip, d)
 
-staticFieldHandler :: CUInt -> IO CUInt
-staticFieldHandler eip = do
+staticFieldHandler :: CPtrdiff -> IO CPtrdiff
+staticFieldHandler reip = do
   -- patch the offset here, first two bytes are part of the insn (opcode + reg)
-  let imm_ptr = intPtrToPtr (fromIntegral (eip + 2)) :: Ptr CUInt
+  let imm_ptr = intPtrToPtr (fromIntegral (reip + 2)) :: Ptr CPtrdiff
   checkMe <- peek imm_ptr
-  case checkMe == 0x00000000 of
-    True -> do
-      getStaticFieldAddr eip >>= poke imm_ptr
-      return eip
-    False -> error "staticFieldHandler: something is wrong here. abort.\n"
-
-invokeHandler :: CUInt -> CUInt -> CUInt -> Bool -> IO CUInt
-invokeHandler method_table table2patch esp imm8 = do
-  -- table2patch: note, that can be a method-table or a interface-table
-  callerAddr <- callerAddrFromStack esp
-  offset <- if imm8 then offsetOfCallInsn8 esp else offsetOfCallInsn32 esp
-  entryAddr <- getMethodEntry callerAddr method_table
-  let call_insn = intPtrToPtr (fromIntegral $ table2patch + fromIntegral offset)
-  poke call_insn entryAddr
-  return entryAddr
-
-
-callerAddrFromStack :: CUInt -> IO CUInt
-callerAddrFromStack = peek . intPtrToPtr . fromIntegral
-
-offsetOfCallInsn8 :: CUInt -> IO CUInt
-offsetOfCallInsn8 esp = do
-  let ret_ptr = intPtrToPtr (fromIntegral esp) :: Ptr CUInt
-  ret <- peek ret_ptr
-  retval <- peek (intPtrToPtr (fromIntegral (ret - 1)) :: Ptr CUChar)
-  return $ fromIntegral retval
+  if checkMe == 0x00000000 then
+    do
+      getStaticFieldAddr reip >>= poke imm_ptr
+      return reip
+    else error "staticFieldHandler: something is wrong here. abort.\n"
 
-offsetOfCallInsn32 :: CUInt -> IO CUInt
-offsetOfCallInsn32 esp = do
-  let ret_ptr = intPtrToPtr (fromIntegral esp) :: Ptr CUInt
-  ret <- peek ret_ptr
-  peek (intPtrToPtr $ fromIntegral (ret - 4))
+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 newmi
+  call32Eax (Disp offset)
+  -- patch entry in table
+  let call_insn = intPtrToPtr . fromIntegral $ table2patch + fromIntegral offset
+  liftIO $ poke call_insn entryAddr
+  return reip