-{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ForeignFunctionInterface #-}
-#include "debug.h"
module Mate.X86CodeGen where
import Prelude hiding (and, div)
import Data.BinaryState
import Data.Int
import Data.Maybe
+import Data.List (genericLength, find)
import qualified Data.Map as M
+import qualified Data.Bimap as BI
import qualified Data.ByteString.Lazy as B
import Control.Monad
+import Control.Applicative
import Foreign hiding (xor)
import Foreign.C.Types
import JVM.Assembler hiding (Instruction)
import JVM.ClassFile
-import Harpy
+import Harpy hiding (fst)
import Harpy.X86Disassembler
import Mate.BasicBlocks
import Mate.Types
import Mate.Utilities
import Mate.ClassPool
+import Mate.ClassHierarchy
+import {-# SOURCE #-} Mate.MethodPool
import Mate.Strings
-#ifdef DEBUG
-import Text.Printf
-#endif
+import Mate.Debug
-foreign import ccall "&mallocObject"
+foreign import ccall "&mallocObjectGC"
mallocObjectAddr :: FunPtr (Int -> IO CPtrdiff)
type EntryPoint = Ptr Word8
type BBStarts = M.Map BlockID Int
-type CompileInfo = (EntryPoint, BBStarts, Int, TrapMap)
+type CompileInfo = (EntryPoint, Int, TrapMap)
-emitFromBB :: Class Direct -> RawMethod -> CodeGen e s (CompileInfo, [Instruction])
-emitFromBB cls method = do
+emitFromBB :: Class Direct -> MethodInfo -> RawMethod -> CodeGen e JpcNpcMap (CompileInfo, [Instruction])
+emitFromBB cls miThis method = do
let keys = M.keys hmap
llmap <- mapM (newNamedLabel . (++) "bb_" . show) keys
let lmap = zip keys llmap
push ebp
mov ebp esp
sub esp (fromIntegral (rawLocals method) * ptrSize :: Word32)
-
- (calls, bbstarts) <- efBB (0, hmap M.! 0) M.empty M.empty lmap
+ calls <- M.fromList . catMaybes . concat <$> mapM (efBB lmap) keys
d <- disassemble
end <- getCodeOffset
- return ((ep, bbstarts, end, calls), d)
+ return ((ep, end, calls), d)
where
hmap = rawMapBB method
getLabel :: BlockID -> [(BlockID, Label)] -> Label
- getLabel _ [] = error "label not found!"
+ getLabel bid [] = error $ "label " ++ show bid ++ " not found"
getLabel i ((x,l):xs) = if i==x then l else getLabel i xs
- efBB :: (BlockID, BasicBlock) -> TrapMap -> BBStarts -> [(BlockID, Label)] -> CodeGen e s (TrapMap, BBStarts)
- efBB (bid, bb) calls bbstarts lmap =
- if M.member bid bbstarts then
- return (calls, bbstarts)
- else do
- bb_offset <- getCodeOffset
- let bbstarts' = M.insert bid bb_offset bbstarts
- defineLabel $ getLabel bid lmap
- cs <- mapM emit'' $ code bb
- let calls' = calls `M.union` M.fromList (catMaybes cs)
- case successor bb of
- Return -> return (calls', bbstarts')
+ efBB :: [(BlockID, Label)] -> BlockID -> CodeGen e JpcNpcMap [(Maybe (Word32, TrapCause))]
+ efBB lmap bid = do
+ defineLabel $ getLabel bid lmap
+ retval <- mapM emit'' $ code bb
+ case successor bb of
FallThrough t -> do
-- TODO(bernhard): le dirty hax. see java/lang/Integer.toString(int, int)
jmp (getLabel t lmap)
- efBB (t, hmap M.! t) calls' bbstarts' lmap
- OneTarget t -> efBB (t, hmap M.! t) calls' bbstarts' lmap
- TwoTarget t1 t2 -> do
- (calls'', bbstarts'') <- efBB (t1, hmap M.! t1) calls' bbstarts' lmap
- efBB (t2, hmap M.! t2) calls'' bbstarts'' lmap
- -- TODO(bernhard): also use metainformation
- -- TODO(bernhard): implement `emit' as function which accepts a list of
- -- instructions, so we can use patterns for optimizations
+ _ -> return ()
+ return retval
where
+ bb = hmap M.! bid
+
+ forceRegDump :: CodeGen e s ()
+ forceRegDump = do
+ push esi
+ mov esi (0x13371234 :: Word32)
+ mov esi (Addr 0)
+ pop esi
+
getCurrentOffset :: CodeGen e s Word32
getCurrentOffset = do
- ep <- getEntryPoint
- let w32_ep = (fromIntegral $ ptrToIntPtr ep) :: Word32
- offset <- getCodeOffset
- return $ w32_ep + fromIntegral offset
+ ep <- (fromIntegral . ptrToIntPtr) <$> getEntryPoint
+ offset <- fromIntegral <$> getCodeOffset
+ return $ ep + offset
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) >> emit8 (0x90 :: Word8)
+ -- like: call $0x01234567
+ calladdr <- emitSigIllTrap 5
+ 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)
- invokeEpilog :: Word16 -> Word32 -> (Bool -> TrapCause) -> CodeGen e s (Maybe (Word32, TrapCause))
- invokeEpilog cpidx offset trapcause = do
+ virtualCall :: Word16 -> Bool -> CodeGen e s (Maybe (Word32, TrapCause))
+ virtualCall cpidx isInterface = do
+ let mi@(MethodInfo methodname objname msig@(MethodSignature args _)) = buildMethodID cls cpidx
+ newNamedLabel (show mi) >>= defineLabel
+ -- get method offset for call @ runtime
+ let offset = if isInterface
+ then getInterfaceMethodOffset objname methodname (encode msig)
+ else getMethodOffset objname (methodname `B.append` encode msig)
+ let argsLen = genericLength args
+ -- objref lives somewhere on the argument stack
+ mov ebx (Disp (argsLen * ptrSize), esp)
+ 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
- call (Disp offset, eax)
+ -- will be patched to this: call (Disp 0xXXXXXXXX, eax)
+ emitSigIllTrap 6
-- discard arguments on stack (`+1' for "this")
let argcnt = ptrSize * (1 + methodGetArgsCount (methodNameTypeByIdx cls cpidx))
when (argcnt > 0) (add esp argcnt)
-- push result on stack if method has a return value
when (methodHaveReturnValue cls cpidx) (push eax)
- let imm8 = is8BitOffset offset
- return $ Just (calladdr + (if imm8 then 3 else 6), trapcause imm8)
+ -- note, that "mi" has the wrong class reference here.
+ -- we figure that out at run-time, in the methodpool,
+ -- depending on the method-table-ptr
+ return $ Just (calladdr, VirtualCall isInterface mi offset)
- emit'' :: J.Instruction -> CodeGen e s (Maybe (Word32, TrapCause))
- emit'' insn = newNamedLabel ("jvm_insn: " ++ show insn) >>= defineLabel >> emit' insn
+ emit'' :: (Int, J.Instruction) -> CodeGen e JpcNpcMap (Maybe (Word32, TrapCause))
+ emit'' (jpc, insn) = do
+ npc <- getCurrentOffset
+ jpcrpc <- getState
+ setState (BI.insert jpc npc jpcrpc)
+ newNamedLabel ("jvm_insn: " ++ show insn) >>= defineLabel >> emit' insn
emit' :: J.Instruction -> CodeGen e s (Maybe (Word32, TrapCause))
emit' (INVOKESPECIAL cpidx) = emitInvoke cpidx True
emit' (INVOKESTATIC cpidx) = emitInvoke cpidx False
- emit' (INVOKEINTERFACE cpidx _) = do
- -- get methodInfo entry
- let mi@(MethodInfo methodname ifacename msig@(MethodSignature args _)) = buildMethodID cls cpidx
- newNamedLabel (show mi) >>= defineLabel
- -- objref lives somewhere on the argument stack
- mov eax (Disp ((* ptrSize) $ fromIntegral $ length args), esp)
- -- get method-table-ptr, keep it in eax (for trap handling)
- mov eax (Disp 0, eax)
- -- get interface-table-ptr
- mov ebx (Disp 0, eax)
- -- get method offset
- offset <- liftIO $ getInterfaceMethodOffset ifacename methodname (encode msig)
- -- note, that "mi" has the wrong class reference here.
- -- we figure that out at run-time, in the methodpool,
- -- depending on the method-table-ptr
- invokeEpilog cpidx offset (`InterfaceMethod` mi)
- emit' (INVOKEVIRTUAL cpidx) = do
- -- get methodInfo entry
- let mi@(MethodInfo methodname objname msig@(MethodSignature args _)) = buildMethodID cls cpidx
- newNamedLabel (show mi) >>= defineLabel
- -- objref lives somewhere on the argument stack
- mov eax (Disp ((* ptrSize) $ fromIntegral $ length args), esp)
- -- get method-table-ptr
- mov eax (Disp 0, eax)
- -- get method offset
- let nameAndSig = methodname `B.append` encode msig
- offset <- liftIO $ getMethodOffset objname nameAndSig
- -- note, that "mi" has the wrong class reference here.
- -- we figure that out at run-time, in the methodpool,
- -- depending on the method-table-ptr
- invokeEpilog cpidx offset (`VirtualMethod` mi)
+ emit' (INVOKEINTERFACE cpidx _) = virtualCall cpidx True
+ emit' (INVOKEVIRTUAL cpidx) = virtualCall cpidx False
+
emit' (PUTSTATIC cpidx) = do
pop eax
trapaddr <- getCurrentOffset
mov eax (Addr 0x00000000) -- it's a trap
push eax
return $ Just (trapaddr, StaticField $ buildStaticFieldID cls cpidx)
+
+ emit' (GETFIELD x) = do
+ pop eax -- this pointer
+ -- like: 099db064 ff b0 e4 14 00 00 pushl 5348(%eax)
+ trapaddr <- emitSigIllTrap 6
+ let patcher reip = do
+ let (cname, fname) = buildFieldOffset cls x
+ offset <- liftIO $ fromIntegral <$> getFieldOffset cname fname
+ 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
+ -- like: 4581fc6b 89 98 30 7b 00 00 movl %ebx,31536(%eax)
+ trapaddr <- emitSigIllTrap 6
+ let patcher reip = do
+ let (cname, fname) = buildFieldOffset cls x
+ offset <- liftIO $ fromIntegral <$> getFieldOffset cname fname
+ mov32RelEbxEax (Disp offset) -- set field
+ return reip
+ return $ Just (trapaddr, ObjectField patcher)
+
+ emit' (INSTANCEOF cpidx) = do
+ pop eax
+ -- place something like `mov edx $mtable_of_objref' instead
+ trapaddr <- emitSigIllTrap 4
+ push (0 :: Word32)
+ let patcher reax reip = do
+ emitSigIllTrap 4
+ let classname = buildClassID cls cpidx
+ check <- liftIO $ isInstanceOf (fromIntegral reax) classname
+ if check
+ then push (1 :: Word32)
+ else push (0 :: Word32)
+ return (reip + 4)
+ return $ Just (trapaddr, InstanceOf patcher)
+ emit' (NEW objidx) = do
+ let objname = buildClassID cls objidx
+ -- place something like `push $objsize' instead
+ trapaddr <- emitSigIllTrap 5
+ callMalloc
+ -- 0x13371337 is just a placeholder; will be replaced with mtable ptr
+ mov (Disp 0, eax) (0x13371337 :: Word32)
+ mov (Disp 4, eax) (0x1337babe :: Word32)
+ let patcher reip = do
+ objsize <- liftIO $ getObjectSize objname
+ push32 objsize
+ callMalloc
+ mtable <- liftIO $ getMethodTable objname
+ mov (Disp 0, eax) mtable
+ mov (Disp 4, eax) (0x1337babe :: Word32)
+ return reip
+ return $ Just (trapaddr, NewObject patcher)
+
+ emit' ATHROW = do
+ pop eax
+ push eax
+ mov eax (Disp 0, eax)
+ trapaddr <- emitSigIllTrap 2
+ let patcher :: TrapPatcherEaxEsp
+ patcher reax resp reip = do
+ liftIO $ printfJit $ printf "reip: %d\n" (fromIntegral reip :: Word32)
+ liftIO $ printfJit $ printf "reax: %d\n" (fromIntegral reax :: Word32)
+ (_, jnmap) <- liftIO $ getMethodEntry miThis
+ liftIO $ printfJit $ printf "size: %d\n" (BI.size jnmap)
+ liftIO $ printfJit $ printf "jnmap: %s\n" (show $ BI.toList jnmap)
+ -- TODO: (-4) is a hack (due to the insns above)
+ let jpc = fromIntegral (jnmap BI.!> (fromIntegral reip - 4))
+ let exceptionmap = rawExcpMap method
+ liftIO $ printfJit $ printf "exmap: %s\n" (show $ M.toList exceptionmap)
+ let key =
+ case find f $ M.keys exceptionmap of
+ Just x -> x
+ Nothing -> error "exception: no handler found. (TODO1)"
+ where
+ f (x, y) = jpc >= x && jpc <= y
+ liftIO $ printfJit $ printf "exception: key is: %s\n" (show key)
+ let handlerJPCs = exceptionmap M.! key
+ let f (x, y) = do x' <- getMethodTable x; return (fromIntegral x', y)
+ handlers <- liftIO $ mapM f handlerJPCs
+ liftIO $ printfJit $ printf "exception: handlers: %s\n" (show handlers)
+ let handlerJPC =
+ case find ((==) reax . fst) handlers of
+ Just x -> x
+ Nothing -> error "exception: no handler found (TODO2)"
+ let handlerNPC = jnmap BI.! (fromIntegral $ snd handlerJPC)
+ liftIO $ printfJit $ printf "exception: handler at: 0x%08x\n" handlerNPC
+ emitSigIllTrap 2
+ return $ fromIntegral handlerNPC
+ return $ Just (trapaddr, ThrowException patcher)
+
emit' insn = emit insn >> return Nothing
emit :: J.Instruction -> CodeGen e s ()
pop ebx -- length
mov (Disp 0, eax) ebx -- store length at offset 0
push eax -- push ref again
- emit (NEW objidx) = do
- let objname = buildClassID cls objidx
- amount <- liftIO $ getObjectSize objname
- push (amount :: Word32)
- callMalloc
- -- TODO(bernhard): save reference somewhere for GC
- -- set method table pointer
- mtable <- liftIO $ getMethodTable objname
- mov (Disp 0, eax) mtable
+
emit (CHECKCAST _) = nop -- TODO(bernhard): ...
- -- TODO(bernhard): ...
- emit (INSTANCEOF _) = do
- pop eax
- push (1 :: Word32)
- emit ATHROW = -- TODO(bernhard): ...
- emit32 (0xffffffff :: Word32)
emit I2C = do
pop eax
and eax (0x000000ff :: Word32)
(CInteger i) -> liftIO $ return i
e -> error $ "LDCI... missing impl.: " ++ show e
push value
- emit (GETFIELD x) = do
- offset <- emitFieldOffset x
- push (Disp (fromIntegral offset), eax) -- get field
- emit (PUTFIELD x) = do
- pop ebx -- value to write
- offset <- emitFieldOffset x
- mov (Disp (fromIntegral offset), eax) ebx -- set field
emit IADD = do pop ebx; pop eax; add eax ebx; push eax
emit ISUB = do pop ebx; pop eax; sub eax ebx; push eax
emit IRETURN = do pop eax; emit RETURN
emit invalid = error $ "insn not implemented yet: " ++ show invalid
- emitFieldOffset :: Word16 -> CodeGen e s Int32
- emitFieldOffset x = do
- pop eax -- this pointer
- let (cname, fname) = buildFieldOffset cls x
- liftIO $ getFieldOffset cname fname
-
emitIF :: CMP -> CodeGen e s ()
emitIF cond = let
sid = case successor bb of TwoTarget _ t -> t; _ -> error "bad"
-- (it didn't work for gnu/classpath/SystemProperties.java)
jmp l2
+ emitSigIllTrap :: Int -> CodeGen e s NativeWord
+ emitSigIllTrap traplen = do
+ when (traplen < 2) (error "emitSigIllTrap: trap len too short")
+ trapaddr <- getCurrentOffset
+ -- 0xffff causes SIGILL
+ emit8 (0xff :: Word8); emit8 (0xff :: Word8)
+ -- fill rest up with NOPs
+ sequence_ [nop | _ <- [1 .. (traplen - 2)]]
+ return trapaddr
- callMalloc :: CodeGen e s ()
- callMalloc = do
- call mallocObjectAddr
- add esp (ptrSize :: Word32)
- push eax
-- for locals we use a different storage
cArgs :: Word8 -> Word32
s8_w32 w8 = fromIntegral s8
where s8 = fromIntegral w8 :: Int8
- is8BitOffset :: Word32 -> Bool
- is8BitOffset w32 = s32 < 128 && s32 > (-127)
- where s32 = fromIntegral w32 :: Int32
+callMalloc :: CodeGen e s ()
+callMalloc = do
+ call mallocObjectAddr
+ add esp (ptrSize :: Word32)
+ push eax
+
+
+-- harpy tries to cut immediates (or displacements), if they fit in 8bit.
+-- however, this is bad for patching so we want to put always 32bit.
+
+-- push imm32
+push32 :: Word32 -> CodeGen e s ()
+push32 imm32 = emit8 0x68 >> emit32 imm32
+
+-- call disp32(%eax)
+call32Eax :: Disp -> CodeGen e s ()
+call32Eax (Disp disp32) = emit8 0xff >> emit8 0x90 >> emit32 disp32
+
+-- push disp32(%eax)
+push32RelEax :: Disp -> CodeGen e s ()
+push32RelEax (Disp disp32) = emit8 0xff >> emit8 0xb0 >> emit32 disp32
+
+-- mov %ebx, disp32(%eax)
+mov32RelEbxEax :: Disp -> CodeGen e s ()
+mov32RelEbxEax (Disp disp32) = emit8 0x89 >> emit8 0x98 >> emit32 disp32
projects / mate.git / blobdiff