1 {-# LANGUAGE OverloadedStrings #-}
2 {-# LANGUAGE ForeignFunctionInterface #-}
3 module Mate.X86TrapHandling (
9 import qualified Data.Map as M
10 import qualified Data.ByteString.Lazy as B
13 import Foreign.C.Types
18 import Mate.NativeSizes
19 import {-# SOURCE #-} Mate.MethodPool
21 import Mate.X86CodeGen
24 import Harpy.X86Disassembler
26 foreign import ccall "register_signal"
27 register_signal :: IO ()
29 foreign export ccall mateHandler :: CPtrdiff -> CPtrdiff -> CPtrdiff -> CPtrdiff -> IO CPtrdiff
30 mateHandler :: CPtrdiff -> CPtrdiff -> CPtrdiff -> CPtrdiff -> IO CPtrdiff
31 mateHandler reip reax rebx resi = do
33 let reipw32 = fromIntegral reip
34 (deleteMe, ret_nreip) <- case M.lookup reipw32 tmap of
35 (Just (StaticMethod _)) ->
36 patchWithHarpy patchStaticCall reip >>= delTrue
37 (Just (StaticField _)) ->
38 staticFieldHandler reip >>= delTrue
39 (Just (InstanceOf cn)) ->
40 patchWithHarpy (`patchInstanceOf` cn) reip >>= delFalse
41 (Just (NewObject cn)) ->
42 patchWithHarpy (`patchNewObject` cn) reip >>= delTrue
43 (Just (VirtualCall False _ io_offset)) ->
44 patchWithHarpy (patchInvoke reax reax io_offset) reip
46 (Just (VirtualCall True _ io_offset)) ->
47 patchWithHarpy (patchInvoke rebx reax io_offset) reip
49 Nothing -> case resi of
50 0x13371234 -> return (-1) >>= delFalse
51 _ -> error $ "getTrapType: abort :-( " ++ (showHex reip ". ")
52 ++ (concatMap (`showHex` ", ") (M.keys tmap))
54 then setTrapMap $ M.delete reipw32 tmap
58 delTrue = (\nreip -> return (False, nreip))
59 delFalse = (\nreip -> return (False, nreip))
62 patchWithHarpy :: (CPtrdiff -> CodeGen () () CPtrdiff) -> CPtrdiff -> IO CPtrdiff
63 patchWithHarpy patcher reip = do
64 -- this is just an upperbound. if the value is to low, patching fails. find
67 let entry = Just (intPtrToPtr (fromIntegral reip), fixme)
68 let cgconfig = defaultCodeGenConfig { customCodeBuffer = entry }
69 (_, Right right) <- runCodeGenWithConfig (withDisasm $ patcher reip) () () cgconfig
71 then mapM_ (printfJit . printf "patched: %s\n" . showAtt) $ snd right
75 withDisasm :: CodeGen e s CPtrdiff -> CodeGen e s (CPtrdiff, [Instruction])
76 withDisasm patcher = do
81 patchStaticCall :: CPtrdiff -> CodeGen e s CPtrdiff
82 patchStaticCall reip = do
83 entryAddr <- liftIO $ getMethodEntry reip 0
84 call (fromIntegral (entryAddr - (reip + 5)) :: NativeWord)
88 staticFieldHandler :: CPtrdiff -> IO CPtrdiff
89 staticFieldHandler reip = do
90 -- patch the offset here, first two bytes are part of the insn (opcode + reg)
91 let imm_ptr = intPtrToPtr (fromIntegral (reip + 2)) :: Ptr CPtrdiff
92 checkMe <- peek imm_ptr
93 if checkMe == 0x00000000 then
95 getStaticFieldAddr reip >>= poke imm_ptr
97 else error "staticFieldHandler: something is wrong here. abort.\n"
99 patchInstanceOf :: CPtrdiff -> B.ByteString -> CodeGen e s CPtrdiff
100 patchInstanceOf reip classname = do
101 mtable <- liftIO $ getMethodTable classname
105 patchNewObject :: CPtrdiff -> B.ByteString -> CodeGen e s CPtrdiff
106 patchNewObject reip classname = do
107 objsize <- liftIO $ getObjectSize classname
110 mtable <- liftIO $ getMethodTable classname
111 mov (Disp 0, eax) mtable
114 patchInvoke :: CPtrdiff -> CPtrdiff -> IO NativeWord -> CPtrdiff -> CodeGen e s CPtrdiff
115 patchInvoke method_table table2patch io_offset reip = do
116 offset <- liftIO io_offset
117 entryAddr <- liftIO $ getMethodEntry reip method_table
118 call32_eax (Disp offset)
119 -- patch entry in table
120 let call_insn = intPtrToPtr . fromIntegral $ table2patch + fromIntegral offset
121 liftIO $ poke call_insn entryAddr