import Data.BinaryState
import Data.Int
import Data.Maybe
+import Data.List (genericLength)
import qualified Data.Map as M
-import qualified Data.Set as S
import qualified Data.ByteString.Lazy as B
import Control.Monad
import Harpy.X86Disassembler
import Mate.BasicBlocks
+import Mate.NativeSizes
import Mate.Types
import Mate.Utilities
import Mate.ClassPool
foreign import ccall "&mallocObject"
- mallocObjectAddr :: FunPtr (Int -> IO CUInt)
+ mallocObjectAddr :: FunPtr (Int -> IO CPtrdiff)
type EntryPoint = Ptr Word8
type EntryPointOffset = Int
type CompileInfo = (EntryPoint, BBStarts, Int, TrapMap)
-emitFromBB :: B.ByteString -> MethodSignature -> Class Direct -> RawMethod -> CodeGen e s (CompileInfo, [Instruction])
-emitFromBB methodname sig cls method = do
+emitFromBB :: Class Direct -> RawMethod -> CodeGen e s (CompileInfo, [Instruction])
+emitFromBB cls method = do
let keys = M.keys hmap
llmap <- mapM (newNamedLabel . (++) "bb_" . show) keys
let lmap = zip keys llmap
ep <- getEntryPoint
push ebp
mov ebp esp
- sub esp (fromIntegral ((rawLocals method) * 4) :: Word32)
+ sub esp (fromIntegral (rawLocals method) * ptrSize :: Word32)
(calls, bbstarts) <- efBB (0, hmap M.! 0) M.empty M.empty lmap
d <- disassemble
-- TODO(bernhard): implement `emit' as function which accepts a list of
-- instructions, so we can use patterns for optimizations
where
+ 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
calladdr <- getCurrentOffset
newNamedLabel (show l) >>= defineLabel
-- causes SIGILL. in the signal handler we patch it to the acutal call.
- -- place a nop at the end, therefore the disasm doesn't screw up
- emit32 (0xffff9090 :: Word32) >> emit8 (0x90 :: Word8)
+ -- place two nop's at the end, therefore the disasm doesn't screw up
+ emit32 (0x9090ffff :: Word32); nop
-- discard arguments on stack
- let argcnt = ((if hasThis then 1 else 0) + methodGetArgsCount cls cpidx) * 4
+ 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)
- -- +2 is for correcting eip in trap context
- return $ Just (calladdr + 2, StaticMethod l)
+ return $ Just (calladdr, StaticMethod l)
- 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)
+ if isInterface
+ then mov ebx (Disp 0, ebx) -- get method-table-ptr, keep it in ebx
+ else return () -- invokevirtual
+ -- get method-table-ptr (or interface-table-ptr)
+ mov eax (Disp 0, ebx)
-- make actual (indirect) call
calladdr <- getCurrentOffset
- call (Disp offset, eax)
- -- discard arguments on stack (+4 for "this")
- let argcnt = 4 + 4 * methodGetArgsCount cls cpidx
+ -- will be patched to this: call (Disp 0xXXXXXXXX, eax)
+ emit32 (0x9090ffff :: Word32); nop; nop
+ -- 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' :: 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 ((*4) $ 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 ((*4) $ 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' (INSTANCEOF cpidx) = do
+ pop eax
+ mov eax (Disp 0, eax) -- mtable of objectref
+ trapaddr <- getCurrentOffset
+ -- place something like `mov edx $mtable_of_objref' instead
+ emit32 (0x9090ffff :: Word32); nop
+ cmp eax edx
+ sete al
+ movzxb eax al
+ push eax
+ forceRegDump
+ return $ Just (trapaddr, InstanceOf $ buildClassID cls cpidx)
+ emit' (NEW objidx) = do
+ let objname = buildClassID cls objidx
+ trapaddr <- getCurrentOffset
+ -- place something like `push $objsize' instead
+ emit32 (0x9090ffff :: Word32); nop
+ callMalloc
+ -- 0x13371337 is just a placeholder; will be replaced with mtable ptr
+ mov (Disp 0, eax) (0x13371337 :: Word32)
+ return $ Just (trapaddr, NewObject objname)
+
emit' insn = emit insn >> return Nothing
emit :: J.Instruction -> CodeGen e s ()
- emit POP = add esp (4 :: Word32) -- drop value
+ emit POP = add esp (ptrSize :: Word32) -- drop value
emit DUP = push (Disp 0, esp)
emit DUP_X1 = do pop eax; pop ebx; push eax; push ebx; push eax
emit DUP_X2 = do pop eax; pop ebx; pop ecx; push eax; push ecx; push ebx; push eax
mov ebx (tsize :: Word32)
-- multiple amount with native size of one element
mul ebx -- result is in eax
- add eax (4 :: Word32) -- for "length" entry
+ add eax (ptrSize :: Word32) -- for "length" entry
-- push amount of bytes to allocate
push eax
callMalloc
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
callMalloc :: CodeGen e s ()
callMalloc = do
call mallocObjectAddr
- add esp (4 :: Word32)
+ add esp (ptrSize :: Word32)
push eax
-- for locals we use a different storage
cArgs :: Word8 -> Word32
- cArgs x =
- if x' >= thisMethodArgCnt
- -- TODO(bernhard): maybe s/(-4)/(-8)/
- then fromIntegral $ (-4) * (x' - thisMethodArgCnt + 1)
- else 4 + (thisMethodArgCnt * 4) - (4 * x')
- where x' = fromIntegral x
+ cArgs x = ptrSize * (argcount - x' + isLocal)
+ where
+ x' = fromIntegral x
+ argcount = rawArgCount method
+ isLocal = if x' >= argcount then (-1) else 1
cArgs_ :: IMM -> Word8
cArgs_ x = case x of I0 -> 0; I1 -> 1; I2 -> 2; I3 -> 3
- -- TODO: factor this out to `compileBB'
- thisMethodArgCnt :: Word32
- thisMethodArgCnt = isNonStatic + fromIntegral (length args)
- where
- m = fromJust $ lookupMethodSig methodname sig cls
- (MethodSignature args _) = sig
- isNonStatic = if S.member ACC_STATIC (methodAccessFlags m)
- then 0 else 1 -- one argument for the this pointer
-
-- sign extension from w8 to w32 (over s8)
-- unfortunately, hs-java is using Word8 everywhere (while
s8_w32 :: 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