From 1f89e5ca20462468c9b1620a4ba162cb9a8addef Mon Sep 17 00:00:00 2001 From: Bernhard Urban Date: Sat, 18 Aug 2012 18:22:46 +0200 Subject: [PATCH] traps: use harpy for patching pro: o more readable contra: o probably slower than plain patching o no saftey checks any more (but we could add that if we want) --- Mate/X86CodeGen.hs | 21 ++++-- Mate/X86TrapHandling.hs | 154 ++++++++++++++++++---------------------- doc/TODO | 3 - 3 files changed, 85 insertions(+), 93 deletions(-) diff --git a/Mate/X86CodeGen.hs b/Mate/X86CodeGen.hs index fb62c90..68cc70e 100644 --- a/Mate/X86CodeGen.hs +++ b/Mate/X86CodeGen.hs @@ -346,12 +346,6 @@ emitFromBB cls method = do jmp l2 - callMalloc :: CodeGen e s () - callMalloc = do - call mallocObjectAddr - add esp (ptrSize :: Word32) - push eax - -- for locals we use a different storage cArgs :: Word8 -> Word32 cArgs x = ptrSize * (argcount - x' + isLocal) @@ -370,3 +364,18 @@ emitFromBB cls method = do s8_w32 :: Word8 -> Word32 s8_w32 w8 = fromIntegral s8 where s8 = fromIntegral w8 :: Int8 + +callMalloc :: CodeGen e s () +callMalloc = do + call mallocObjectAddr + add esp (ptrSize :: Word32) + push eax + +-- the regular push implementation, considers the provided immediate and selects +-- a different instruction if it fits in 8bit. but this is not useful for +-- patching. +push32 :: Word32 -> CodeGen e s () +push32 imm32 = emit8 0x68 >> emit32 imm32 + +call32_eax :: Disp -> CodeGen e s () +call32_eax (Disp disp32) = emit8 0xff >> emit8 0x90 >> emit32 disp32 diff --git a/Mate/X86TrapHandling.hs b/Mate/X86TrapHandling.hs index e41c1ad..1a571a3 100644 --- a/Mate/X86TrapHandling.hs +++ b/Mate/X86TrapHandling.hs @@ -14,111 +14,97 @@ import qualified Data.ByteString.Lazy as B import Foreign import Foreign.C.Types +import Harpy + import Mate.Types import Mate.NativeSizes import {-# SOURCE #-} Mate.MethodPool import Mate.ClassPool +import Mate.X86CodeGen + +#ifdef DBG_JIT +import Text.Printf +#endif +import Mate.Debug +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 eip eax ebx esi = do +mateHandler reip reax rebx resi = do tmap <- getTrapMap - case M.lookup (fromIntegral eip) tmap of - (Just (StaticMethod _)) -> staticCallHandler eip - (Just (StaticField _)) -> staticFieldHandler eip - (Just (InstanceOf cn)) -> instanceOfMissHandler eip cn - (Just (NewObject cn)) -> newObjectHandler eip cn - (Just (VirtualCall False _ io_offset)) -> invokeHandler eax eax eip io_offset - (Just (VirtualCall True _ io_offset)) -> invokeHandler ebx eax eip io_offset - Nothing -> case esi of + case M.lookup (fromIntegral reip) tmap of + (Just (StaticMethod _)) -> patchWithHarpy patchStaticCall reip + (Just (StaticField _)) -> staticFieldHandler reip + (Just (InstanceOf cn)) -> patchWithHarpy (`patchInstanceOf` cn) reip + (Just (NewObject cn)) -> patchWithHarpy (`patchNewObject` cn) reip + (Just (VirtualCall False _ io_offset)) -> + patchWithHarpy (patchInvoke reax reax io_offset) reip + (Just (VirtualCall True _ io_offset)) -> + patchWithHarpy (patchInvoke rebx reax io_offset) reip + Nothing -> case resi of 0x13371234 -> return (-1) - _ -> error $ "getTrapType: abort :-(" ++ (showHex eip "") ++ ", " ++ show (M.keys tmap) + _ -> error $ "getTrapType: abort :-( " ++ (showHex reip ". ") + ++ (concatMap (`showHex` ", ") (M.keys tmap)) + +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 + mapM_ (printfJit "patched: %s\n" . showAtt) $ snd right + return reip + +withDisasm :: CodeGen e s CPtrdiff -> CodeGen e s (CPtrdiff, [Instruction]) +withDisasm patcher = do + reip <- patcher + 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 -staticCallHandler :: CPtrdiff -> IO CPtrdiff -staticCallHandler eip = do - -- the actual insn to patch as pointer - let insn_ptr = intPtrToPtr (fromIntegral eip) :: Ptr CUChar - -- call offset is displaced by one byte (as the first byte is the opcode) - let imm_ptr = intPtrToPtr (fromIntegral (eip + 1)) :: Ptr CPtrdiff - -- 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 - if checkMe == 0x909090ff then - do - entryAddr <- getMethodEntry eip 0 - poke insn_ptr 0xe8 -- `call' opcode - -- it's a relative call, so we have to calculate the offset. why "+ 5"? - -- (1) the whole insn is 5 bytes long - -- (2) offset is calculated wrt to the beginning of the next insn - poke imm_ptr (entryAddr - (eip + 5)) - return eip - else error "staticCallHandler: something is wrong here. abort\n" staticFieldHandler :: CPtrdiff -> IO CPtrdiff -staticFieldHandler eip = do +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 CPtrdiff + let imm_ptr = intPtrToPtr (fromIntegral (reip + 2)) :: Ptr CPtrdiff checkMe <- peek imm_ptr if checkMe == 0x00000000 then do - getStaticFieldAddr eip >>= poke imm_ptr - return eip + getStaticFieldAddr reip >>= poke imm_ptr + return reip else error "staticFieldHandler: something is wrong here. abort.\n" -instanceOfMissHandler :: CPtrdiff -> B.ByteString -> IO CPtrdiff -instanceOfMissHandler eip classname = do - -- first byte is going to be the opcode - let insn_ptr = intPtrToPtr (fromIntegral eip) :: Ptr CUChar - -- the next four bytes are the immediate - let imm_ptr = intPtrToPtr (fromIntegral (eip + 1)) :: Ptr CPtrdiff - checkMe <- peek imm_ptr - if checkMe == 0x909090ff then -- safety check... - do - mtable <- getMethodTable classname - poke imm_ptr (fromIntegral mtable) - poke insn_ptr 0xba -- `mov edx' opcode - return eip - else error "instanceOfMissHandler: 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 -newObjectHandler :: CPtrdiff -> B.ByteString -> IO CPtrdiff -newObjectHandler eip classname = do - let push_insn_ptr = intPtrToPtr (fromIntegral eip) :: Ptr CUChar - let push_imm_ptr = intPtrToPtr (fromIntegral (eip + 1)) :: Ptr CPtrdiff - let mov_imm_ptr = intPtrToPtr (fromIntegral (eip + 16)) :: Ptr CPtrdiff - checkMe <- peek mov_imm_ptr - if checkMe == 0x13371337 - then do - objsize <- getObjectSize classname - mtable <- getMethodTable classname - poke push_insn_ptr 0x68 -- push_imm insn - poke push_imm_ptr (fromIntegral objsize) - poke mov_imm_ptr (fromIntegral mtable) - return eip - else error "newObjectHandler: something is wrong here. abort.\n" +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 -invokeHandler :: CPtrdiff -> CPtrdiff -> CPtrdiff -> IO NativeWord -> IO CPtrdiff -invokeHandler method_table table2patch eip io_offset = do - let call0_insn_ptr = intPtrToPtr (fromIntegral eip) :: Ptr CUChar - let call1_insn_ptr = intPtrToPtr (fromIntegral (eip + 1)) :: Ptr CUChar - let call_imm_ptr = intPtrToPtr (fromIntegral (eip + 2)) :: Ptr CPtrdiff - offset <- io_offset - -- @table2patch: note, that can be a method-table or a interface-table - entryAddr <- getMethodEntry eip method_table - - -- patch table +patchInvoke :: CPtrdiff -> CPtrdiff -> IO NativeWord -> CPtrdiff -> CodeGen e s CPtrdiff +patchInvoke method_table table2patch io_offset reip = do + offset <- liftIO io_offset + entryAddr <- liftIO $ getMethodEntry reip method_table + call32_eax (Disp offset) + -- patch entry in table let call_insn = intPtrToPtr . fromIntegral $ table2patch + fromIntegral offset - poke call_insn entryAddr - - -- patch insn - checkMe <- peek call_imm_ptr - if checkMe == 0x90909090 - then do - poke call0_insn_ptr 0xff -- indirect call op[0] - poke call1_insn_ptr 0x90 -- indirect call op[1] - poke call_imm_ptr (fromIntegral offset) - return eip - else error "invokeHandler: something is wrong here. abort\n" + liftIO $ poke call_insn entryAddr + return reip diff --git a/doc/TODO b/doc/TODO index 15f7cb7..f65d294 100644 --- a/doc/TODO +++ b/doc/TODO @@ -81,9 +81,6 @@ -> seperate analysis, jit, execution, ... -> maybe use ghc profiling? (it doesn't measure native execution, but well) -(h) patching also possible with harpy? - -> we can use a own buffer @ codegeneration... - (l) ... low priority (m) ... medium priority -- 2.25.1