1 {-# LANGUAGE OverloadedStrings #-}
2 {-# LANGUAGE ForeignFunctionInterface #-}
3 module Mate.X86TrapHandling (
9 import qualified Data.Map as M
13 import Foreign.C.Types
15 import Harpy hiding (fst)
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 -> CPtrdiff -> IO CPtrdiff
30 mateHandler :: CPtrdiff -> CPtrdiff -> CPtrdiff -> CPtrdiff -> CPtrdiff -> IO CPtrdiff
31 mateHandler reip reax rebx resi resp = do
33 let reipw32 = fromIntegral reip
34 (deleteMe, ret_nreip) <- case M.lookup reipw32 tmap of
35 (Just (StaticMethod patcher)) ->
36 patchWithHarpy patcher reip >>= delFalse
37 (Just (StaticField _)) ->
38 staticFieldHandler reip >>= delTrue
39 (Just (ObjectField patcher)) ->
40 patchWithHarpy patcher reip >>= delTrue
41 (Just (InstanceOf patcher)) ->
42 patchWithHarpy (patcher reax) reip >>= delFalse
43 (Just (ThrowException patcher)) ->
44 patchWithHarpy (patcher resp) reip >>= delFalse
45 (Just (NewObject patcher)) ->
46 patchWithHarpy patcher reip >>= delTrue
47 (Just (VirtualCall False mi io_offset)) ->
48 patchWithHarpy (patchInvoke mi reax reax io_offset) reip
50 (Just (VirtualCall True mi io_offset)) ->
51 patchWithHarpy (patchInvoke mi rebx reax io_offset) reip
53 Nothing -> case resi of
54 0x13371234 -> delFalse (-1)
55 _ -> error $ "getTrapType: abort :-( " ++ showHex reip ". "
56 ++ concatMap (`showHex` ", ") (M.keys tmap)
57 when deleteMe $ setTrapMap $ M.delete reipw32 tmap
60 delTrue x = return (True,x)
61 delFalse x = return (False,x)
64 patchWithHarpy :: (CPtrdiff -> CodeGen () () CPtrdiff) -> CPtrdiff -> IO CPtrdiff
65 patchWithHarpy patcher reip = do
66 -- this is just an upperbound. if the value is to low, patching fails. find
69 let entry = Just (intPtrToPtr (fromIntegral reip), fixme)
70 let cgconfig = defaultCodeGenConfig { customCodeBuffer = entry }
71 (_, Right right) <- runCodeGenWithConfig (withDisasm $ patcher reip) () () cgconfig
72 when mateDEBUG $ mapM_ (printfJit . printf "patched: %s\n" . showIntel) $ snd right
75 withDisasm :: CodeGen e s CPtrdiff -> CodeGen e s (CPtrdiff, [Instruction])
76 withDisasm patcher = do
81 staticFieldHandler :: CPtrdiff -> IO CPtrdiff
82 staticFieldHandler reip = do
83 -- patch the offset here, first two bytes are part of the insn (opcode + reg)
84 let imm_ptr = intPtrToPtr (fromIntegral (reip + 2)) :: Ptr CPtrdiff
85 checkMe <- peek imm_ptr
86 if checkMe == 0x00000000 then
88 getStaticFieldAddr reip >>= poke imm_ptr
90 else error "staticFieldHandler: something is wrong here. abort.\n"
92 patchInvoke :: MethodInfo -> CPtrdiff -> CPtrdiff -> IO NativeWord -> CPtrdiff -> CodeGen e s CPtrdiff
93 patchInvoke (MethodInfo methname _ msig) method_table table2patch io_offset reip = do
94 vmap <- liftIO getVirtualMap
95 let newmi = MethodInfo methname (vmap M.! fromIntegral method_table) msig
96 offset <- liftIO io_offset
97 entryAddr <- liftIO $ getMethodEntry newmi
98 call32Eax (Disp offset)
99 -- patch entry in table
100 let call_insn = intPtrToPtr . fromIntegral $ table2patch + fromIntegral offset
101 liftIO $ poke call_insn entryAddr