foreign import ccall "&printGCStats"
printGCStatsAddr :: FunPtr (IO ())
-getMethodEntry :: CPtrdiff -> CPtrdiff -> IO CPtrdiff
-getMethodEntry signal_from methodtable = do
+getMethodEntry :: MethodInfo -> IO CPtrdiff
+getMethodEntry mi@(MethodInfo method cm sig) = do
mmap <- getMethodMap
- tmap <- getTrapMap
- vmap <- getVirtualMap
-
- let w32_from = fromIntegral signal_from
- let mi = tmap M.! w32_from
- let mi'@(MethodInfo method cm sig) =
- case mi of
- (StaticMethod x) -> x
- (VirtualCall _ (MethodInfo methname _ msig) _) -> newMi methname msig
- _ -> error "getMethodEntry: no TrapCause found. abort."
- where newMi mn = MethodInfo mn (vmap M.! fromIntegral methodtable)
- entryaddr <- case M.lookup mi' mmap of
+
+ entryaddr <- case M.lookup mi mmap of
Nothing -> do
cls <- getClassFile cm
- printfMp $ printf "getMethodEntry(from 0x%08x): no method \"%s\" found. compile it\n" w32_from (show mi')
+ printfMp $ printf "getMethodEntry: no method \"%s\" found. compile it\n" (show mi)
mm <- lookupMethodRecursive method sig [] cls
case mm of
Just (mm', clsnames, cls') -> do
symbol = sym1 ++ "__" ++ smethod ++ "__" ++ sym2
printfMp $ printf "native-call: symbol: %s\n" symbol
nf <- loadNativeFunction symbol
- setMethodMap $ M.insert mi' nf mmap
+ setMethodMap $ M.insert mi nf mmap
return nf
else do
rawmethod <- parseMethod cls' method sig
entry <- compileBB rawmethod (MethodInfo method (thisClass cls') sig)
- addMethodRef entry mi' clsnames
+ addMethodRef entry mi clsnames
return $ fromIntegral entry
Nothing -> error $ show method ++ " not found. abort"
Just w32 -> return w32
addMethodRef :: NativeWord -> MethodInfo -> [B.ByteString] -> IO ()
compileBB :: RawMethod -> MethodInfo -> IO NativeWord
executeFuncPtr :: NativeWord -> IO ()
-getMethodEntry :: CPtrdiff -> CPtrdiff -> IO CPtrdiff
+getMethodEntry :: MethodInfo -> IO CPtrdiff
type TrapPatcher = CPtrdiff -> CodeGen () () CPtrdiff
data TrapCause
- = StaticMethod MethodInfo -- for static calls
+ = StaticMethod TrapPatcher -- for static calls
| VirtualCall Bool MethodInfo (IO NativeWord) -- for invoke{interface,virtual}
| InstanceOf B.ByteString -- class name
- | NewObject B.ByteString -- class name
+ | NewObject TrapPatcher -- class name
| StaticField StaticFieldInfo
| ObjectField TrapPatcher
import Mate.Types
import Mate.Utilities
import Mate.ClassPool
+import {-# SOURCE #-} Mate.MethodPool
import Mate.Strings
-- causes SIGILL. in the signal handler we patch it to the acutal call.
-- place two nop's at the end, therefore the disasm doesn't screw up
emit32 (0x9090ffff :: Word32); nop
+ let patcher reip = do
+ entryAddr <- liftIO $ getMethodEntry l
+ call (fromIntegral (entryAddr - (reip + 5)) :: NativeWord)
+ return reip
-- discard arguments on stack
let argcnt = ((if hasThis then 1 else 0) + methodGetArgsCount (methodNameTypeByIdx cls cpidx)) * ptrSize
when (argcnt > 0) (add esp argcnt)
-- push result on stack if method has a return value
when (methodHaveReturnValue cls cpidx) (push eax)
- return $ Just (calladdr, StaticMethod l)
+ return $ Just (calladdr, StaticMethod patcher)
virtualCall :: Word16 -> Bool -> CodeGen e s (Maybe (Word32, TrapCause))
virtualCall cpidx isInterface = do
callMalloc
-- 0x13371337 is just a placeholder; will be replaced with mtable ptr
mov (Disp 0, eax) (0x13371337 :: Word32)
- return $ Just (trapaddr, NewObject objname)
+ let patcher reip = do
+ objsize <- liftIO $ getObjectSize objname
+ push32 objsize
+ callMalloc
+ mtable <- liftIO $ getMethodTable objname
+ mov (Disp 0, eax) mtable
+ return reip
+ return $ Just (trapaddr, NewObject patcher)
emit' insn = emit insn >> return Nothing
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 >>= delTrue
(Just (StaticField _)) ->
staticFieldHandler reip >>= delTrue
(Just (ObjectField patcher)) ->
patchWithHarpy patcher 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
+ (Just (NewObject patcher)) ->
+ patchWithHarpy patcher reip >>= delTrue
+ (Just (VirtualCall False mi io_offset)) ->
+ patchWithHarpy (patchInvoke mi reax reax io_offset) reip
>>= delTrue
- (Just (VirtualCall True _ io_offset)) ->
- patchWithHarpy (patchInvoke rebx reax io_offset) reip
+ (Just (VirtualCall True mi io_offset)) ->
+ patchWithHarpy (patchInvoke mi rebx reax io_offset) reip
>>= delTrue
Nothing -> case resi of
0x13371234 -> return (-1) >>= delFalse
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)
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
+ entryAddr <- liftIO $ getMethodEntry newmi
call32_eax (Disp offset)
-- patch entry in table
let call_insn = intPtrToPtr . fromIntegral $ table2patch + fromIntegral offset
projects / mate.git / commitdiff