printMapBB hmap = do
printfBb "BlockIDs: "
let keys = M.keys hmap
- mapM_ (printfBb. (flip (++)) ", " . show) keys
- printfBb "\n\nBasicBlocks:"
+ mapM_ (printfBb . flip (++) ", " . show) keys
+ printfBb "\n\nBasicBlocks:\n"
printMapBB' keys hmap
where
printMapBB' :: [BlockID] -> MapBB -> IO ()
printMapBB' [] _ = return ()
printMapBB' (i:is) hmap' = case M.lookup i hmap' of
Just bb -> do
- printfBb $ "Block " ++ (show i)
- mapM_ printfBb (map ((++) "\t" . show) $ code bb)
+ printfBb $ "Block " ++ show i ++ "\n"
+ mapM_ (printfBb . flip (++) "\n" . (++) "\t" . show) $ code bb
printfBb $ case successor bb of
Return -> ""
- FallThrough t1 -> "Sucessor: " ++ (show t1) ++ "\n"
- OneTarget t1 -> "Sucessor: " ++ (show t1) ++ "\n"
- TwoTarget t1 t2 -> "Sucessor: " ++ (show t1) ++ ", " ++ (show t2) ++ "\n"
+ FallThrough t1 -> "Sucessor: " ++ show t1 ++ "\n"
+ OneTarget t1 -> "Sucessor: " ++ show t1 ++ "\n"
+ TwoTarget t1 t2 -> "Sucessor: " ++ show t1 ++ ", " ++ show t2 ++ "\n"
printMapBB' is hmap
Nothing -> error $ "BlockID " ++ show i ++ " not found."
where val = fromIntegral (mmap M.! key) :: NativeWord
printfCp $ printf "%s\n" header
mapM_ printValue (M.keys mmap)
- if mateDEBUG
- then do
- let strpath = toString path
- hexDumpMap ("staticmap @ " ++ strpath) staticmap
- hexDumpMap ("fieldmap @ " ++ strpath) fieldmap
- hexDumpMap ("methodmap @ " ++ strpath) methodmap
- hexDumpMap ("interfacemap @ " ++ strpath) immap
- printfCp $ printf "mbase: 0x%08x\n" mbase
- printfCp $ printf "iftable: 0x%08x\n" wn_iftable
- else return ()
+ when mateDEBUG $ do
+ let strpath = toString path
+ hexDumpMap ("staticmap @ " ++ strpath) staticmap
+ hexDumpMap ("fieldmap @ " ++ strpath) fieldmap
+ hexDumpMap ("methodmap @ " ++ strpath) methodmap
+ hexDumpMap ("interfacemap @ " ++ strpath) immap
+ printfCp $ printf "mbase: 0x%08x\n" mbase
+ printfCp $ printf "iftable: 0x%08x\n" wn_iftable
virtual_map <- getVirtualMap
setVirtualMap $ M.insert mbase path virtual_map
import Text.Printf
import System.IO
import System.IO.Unsafe
+import Control.Monad
{-# NOINLINE logHandle #-}
{-# INLINE printString #-}
printString :: String -> String -> IO ()
-printString prefix str = if mateDEBUG
- then hPutStr logHandle . (++) prefix $ str
- else return ()
+printString prefix str = when mateDEBUG $ hPutStr logHandle . (++) prefix $ str
printfJit, printfBb, printfMp, printfCp, printfStr, printfInfo :: String -> IO ()
import qualified Data.Set as S
import qualified Data.ByteString.Lazy as B
import System.Plugins
+import Control.Monad
import Foreign.Ptr
import Foreign.C.Types
if S.member ACC_NATIVE flags
then do
let scm = toString cm; smethod = toString method
- if scm == "jmate/lang/MateRuntime" then do
+ if scm == "jmate/lang/MateRuntime" then
case smethod of
"loadLibrary" ->
return . funPtrToAddr $ loadLibraryAddr
cls <- getClassFile (methClassName methodinfo)
let ebb = emitFromBB cls rawmethod
- let cgconfig = defaultCodeGenConfig { codeBufferSize = fromIntegral $ (rawCodeLength rawmethod) * 32 }
+ let cgconfig = defaultCodeGenConfig { codeBufferSize = fromIntegral $ rawCodeLength rawmethod * 32 }
(_, Right right) <- runCodeGenWithConfig ebb () () cgconfig
let ((entry, _, _, new_tmap), _) = right
printfJit $ printf "generated code of \"%s\" from \"%s\":\n" (toString $ methName methodinfo) (toString $ methClassName methodinfo)
printfJit $ printf "\tstacksize: 0x%04x, locals: 0x%04x\n" (rawStackSize rawmethod) (rawLocals rawmethod)
- if mateDEBUG
- then mapM_ (printfJit . printf "%s\n" . showAtt) (snd right)
- else return ()
+ when mateDEBUG $ mapM_ (printfJit . printf "%s\n" . showAtt) (snd right)
printfJit $ printf "\n\n"
-- UNCOMMENT NEXT LINES FOR GDB FUN
-- if (toString $ methName methodinfo) == "thejavamethodIwant2debug"
emitInvoke :: Word16 -> Bool -> CodeGen e s (Maybe (Word32, TrapCause))
emitInvoke cpidx hasThis = do
let l = buildMethodID cls cpidx
- calladdr <- getCurrentOffset
newNamedLabel (show l) >>= defineLabel
- -- 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
+ -- like: call $0x01234567
+ calladdr <- emitSigIllTrap 5
let patcher reip = do
entryAddr <- liftIO $ getMethodEntry l
call (fromIntegral (entryAddr - (reip + 5)) :: NativeWord)
let argsLen = genericLength args
-- objref lives somewhere on the argument stack
mov ebx (Disp (argsLen * ptrSize), esp)
- if isInterface
- then mov ebx (Disp 0, ebx) -- get method-table-ptr, keep it in ebx
- else return () -- invokevirtual
+ when isInterface $
+ mov ebx (Disp 0, ebx) -- get method-table-ptr, keep it in ebx
-- get method-table-ptr (or interface-table-ptr)
mov eax (Disp 0, ebx)
-- make actual (indirect) call
calladdr <- getCurrentOffset
-- will be patched to this: call (Disp 0xXXXXXXXX, eax)
- emit32 (0x9090ffff :: Word32); nop; nop
+ emitSigIllTrap 6
-- discard arguments on stack (`+1' for "this")
let argcnt = ptrSize * (1 + methodGetArgsCount (methodNameTypeByIdx cls cpidx))
when (argcnt > 0) (add esp argcnt)
emit' (GETFIELD x) = do
pop eax -- this pointer
- trapaddr <- getCurrentOffset
-- like: 099db064 ff b0 e4 14 00 00 pushl 5348(%eax)
- emit32 (0x9090ffff :: Word32); nop; nop
+ trapaddr <- emitSigIllTrap 6
let patcher reip = do
let (cname, fname) = buildFieldOffset cls x
offset <- liftIO $ fromIntegral <$> getFieldOffset cname fname
- push32_rel_eax (Disp offset) -- get field
+ push32RelEax (Disp offset) -- get field
return reip
return $ Just (trapaddr, ObjectField patcher)
emit' (PUTFIELD x) = do
pop ebx -- value to write
pop eax -- this pointer
- trapaddr <- getCurrentOffset
-- like: 4581fc6b 89 98 30 7b 00 00 movl %ebx,31536(%eax)
- emit32 (0x9090ffff :: Word32); nop; nop
+ trapaddr <- emitSigIllTrap 6
let patcher reip = do
let (cname, fname) = buildFieldOffset cls x
offset <- liftIO $ fromIntegral <$> getFieldOffset cname fname
- mov32_rel_ebx_eax (Disp offset) -- set field
+ mov32RelEbxEax (Disp offset) -- set field
return reip
return $ Just (trapaddr, ObjectField patcher)
emit' (INSTANCEOF cpidx) = do
pop eax
- trapaddr <- getCurrentOffset
-- place something like `mov edx $mtable_of_objref' instead
- emit32 (0x9090ffff :: Word32)
+ trapaddr <- emitSigIllTrap 4
push (0 :: Word32)
let patcher reax reip = do
- emit32 (0x9090ffff :: Word32)
+ emitSigIllTrap 4
let classname = buildClassID cls cpidx
check <- liftIO $ isInstanceOf (fromIntegral reax) classname
if check
return $ Just (trapaddr, InstanceOf patcher)
emit' (NEW objidx) = do
let objname = buildClassID cls objidx
- trapaddr <- getCurrentOffset
-- place something like `push $objsize' instead
- emit32 (0x9090ffff :: Word32); nop
+ trapaddr <- emitSigIllTrap 5
callMalloc
-- 0x13371337 is just a placeholder; will be replaced with mtable ptr
mov (Disp 0, eax) (0x13371337 :: Word32)
-- (it didn't work for gnu/classpath/SystemProperties.java)
jmp l2
+ emitSigIllTrap :: Int -> CodeGen e s NativeWord
+ emitSigIllTrap traplen = do
+ trapaddr <- getCurrentOffset
+ -- 0xffff causes SIGILL
+ emit8 (0xff :: Word8); emit8 (0xff :: Word8)
+ -- fill rest up with NOPs
+ sequence_ [nop | _ <- [1 .. (traplen - 2)]]
+ return trapaddr
+
-- for locals we use a different storage
cArgs :: Word8 -> Word32
push32 imm32 = emit8 0x68 >> emit32 imm32
-- call disp32(%eax)
-call32_eax :: Disp -> CodeGen e s ()
-call32_eax (Disp disp32) = emit8 0xff >> emit8 0x90 >> emit32 disp32
+call32Eax :: Disp -> CodeGen e s ()
+call32Eax (Disp disp32) = emit8 0xff >> emit8 0x90 >> emit32 disp32
-- push disp32(%eax)
-push32_rel_eax :: Disp -> CodeGen e s ()
-push32_rel_eax (Disp disp32) = emit8 0xff >> emit8 0xb0 >> emit32 disp32
+push32RelEax :: Disp -> CodeGen e s ()
+push32RelEax (Disp disp32) = emit8 0xff >> emit8 0xb0 >> emit32 disp32
-- mov %ebx, disp32(%eax)
-mov32_rel_ebx_eax :: Disp -> CodeGen e s ()
-mov32_rel_ebx_eax (Disp disp32) = emit8 0x89 >> emit8 0x98 >> emit32 disp32
+mov32RelEbxEax :: Disp -> CodeGen e s ()
+mov32RelEbxEax (Disp disp32) = emit8 0x89 >> emit8 0x98 >> emit32 disp32
import Numeric
import qualified Data.Map as M
-import qualified Data.ByteString.Lazy as B
+import Control.Monad
import Foreign
import Foreign.C.Types
patchWithHarpy (patchInvoke mi rebx reax io_offset) reip
>>= delFalse
Nothing -> case resi of
- 0x13371234 -> return (-1) >>= delFalse
- _ -> error $ "getTrapType: abort :-( " ++ (showHex reip ". ")
- ++ (concatMap (`showHex` ", ") (M.keys tmap))
- if deleteMe
- then setTrapMap $ M.delete reipw32 tmap
- else return ()
+ 0x13371234 -> delFalse (-1)
+ _ -> error $ "getTrapType: abort :-( " ++ showHex reip ". "
+ ++ concatMap (`showHex` ", ") (M.keys tmap)
+ when deleteMe $ setTrapMap $ M.delete reipw32 tmap
return ret_nreip
- where
- delTrue = (\nreip -> return (True, nreip))
- delFalse = (\nreip -> return (False, nreip))
+ where
+ delTrue x = return (True,x)
+ delFalse x = return (False,x)
patchWithHarpy :: (CPtrdiff -> CodeGen () () CPtrdiff) -> CPtrdiff -> IO CPtrdiff
let entry = Just (intPtrToPtr (fromIntegral reip), fixme)
let cgconfig = defaultCodeGenConfig { customCodeBuffer = entry }
(_, Right right) <- runCodeGenWithConfig (withDisasm $ patcher reip) () () cgconfig
- if mateDEBUG
- then mapM_ (printfJit . printf "patched: %s\n" . showAtt) $ snd right
- else return ()
+ when mateDEBUG $ mapM_ (printfJit . printf "patched: %s\n" . showAtt) $ snd right
return $ fst right
withDisasm :: CodeGen e s CPtrdiff -> CodeGen e s (CPtrdiff, [Instruction])
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
+ vmap <- liftIO getVirtualMap
let newmi = MethodInfo methname (vmap M.! fromIntegral method_table) msig
offset <- liftIO io_offset
entryAddr <- liftIO $ getMethodEntry newmi
- call32_eax (Disp offset)
+ call32Eax (Disp offset)
-- patch entry in table
let call_insn = intPtrToPtr . fromIntegral $ table2patch + fromIntegral offset
liftIO $ poke call_insn entryAddr
projects / mate.git / commitdiff