X-Git-Url: http://wien.tomnetworks.com/gitweb/?a=blobdiff_plain;f=Mate%2FX86CodeGen.hs;h=b4b72b179c81b32e5ce6df152971fc3504f96283;hb=e956c113f38ae5cf78d79cf00de776f0331a332c;hp=abe5a39ea528215bef55255dc86517ca901a9b67;hpb=6f979304b8c4334737feeb5dd5e053c03a8a559c;p=mate.git diff --git a/Mate/X86CodeGen.hs b/Mate/X86CodeGen.hs index abe5a39..b4b72b1 100644 --- a/Mate/X86CodeGen.hs +++ b/Mate/X86CodeGen.hs @@ -4,6 +4,7 @@ #include "debug.h" module Mate.X86CodeGen where +import Prelude hiding (and, div) import Data.Binary import Data.BinaryState import Data.Int @@ -28,17 +29,13 @@ import Mate.Types import Mate.Utilities import Mate.ClassPool import Mate.Strings +#ifdef DEBUG +import Text.Printf +#endif -foreign import ccall "dynamic" - code_int :: FunPtr (CInt -> CInt -> IO CInt) -> (CInt -> CInt -> IO CInt) - -foreign import ccall "getMallocObjectAddr" - getMallocObjectAddr :: CUInt - -foreign import ccall "register_signal" - register_signal :: IO () - +foreign import ccall "&mallocObject" + mallocObjectAddr :: FunPtr (Int -> IO CUInt) type EntryPoint = Ptr Word8 type EntryPointOffset = Int @@ -49,8 +46,8 @@ type BBStarts = M.Map BlockID Int type CompileInfo = (EntryPoint, BBStarts, Int, TrapMap) -emitFromBB :: B.ByteString -> Class Resolved -> MapBB -> CodeGen e s (CompileInfo, [Instruction]) -emitFromBB method cls hmap = do +emitFromBB :: B.ByteString -> MethodSignature -> Class Direct -> MapBB -> CodeGen e s (CompileInfo, [Instruction]) +emitFromBB method sig cls hmap = do llmap <- sequence [newNamedLabel ("bb_" ++ show x) | (x,_) <- M.toList hmap] let lmap = zip (Prelude.fst $ unzip $ M.toList hmap) llmap ep <- getEntryPoint @@ -60,7 +57,7 @@ emitFromBB method cls hmap = do -- e.g. (locals used) * 4 sub esp (0x60 :: Word32) - (calls, bbstarts) <- efBB (0,(hmap M.! 0)) M.empty M.empty lmap + (calls, bbstarts) <- efBB (0, hmap M.! 0) M.empty M.empty lmap d <- disassemble end <- getCodeOffset return ((ep, bbstarts, end, calls), d) @@ -77,14 +74,15 @@ emitFromBB method cls hmap = 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) + cs <- mapM emit'' $ code bb + let calls' = calls `M.union` M.fromList (catMaybes cs) case successor bb of Return -> return (calls', bbstarts') 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 -> do - 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 @@ -92,14 +90,14 @@ emitFromBB method cls hmap = do -- TODO(bernhard): implement `emit' as function which accepts a list of -- instructions, so we can use patterns for optimizations where - getCurrentOffset :: CodeGen e s (Word32) + getCurrentOffset :: CodeGen e s Word32 getCurrentOffset = do ep <- getEntryPoint let w32_ep = (fromIntegral $ ptrToIntPtr ep) :: Word32 offset <- getCodeOffset - return $ w32_ep + (fromIntegral offset) + return $ w32_ep + fromIntegral offset - emitInvoke :: Word16 -> Bool -> CodeGen e s (Maybe (Word32, TrapInfo)) + emitInvoke :: Word16 -> Bool -> CodeGen e s (Maybe (Word32, TrapCause)) emitInvoke cpidx hasThis = do let l = buildMethodID cls cpidx calladdr <- getCurrentOffset @@ -108,13 +106,30 @@ emitFromBB method cls hmap = do -- place a nop at the end, therefore the disasm doesn't screw up emit32 (0xffff9090 :: Word32) >> emit8 (0x90 :: Word8) -- 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 cls cpidx) * 4 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, MI l) + -- +2 is for correcting eip in trap context + return $ Just (calladdr + 2, StaticMethod l) - emit' :: J.Instruction -> CodeGen e s (Maybe (Word32, TrapInfo)) + invokeEpilog :: Word16 -> Word32 -> (Bool -> TrapCause) -> CodeGen e s (Maybe (Word32, TrapCause)) + invokeEpilog cpidx offset trapcause = do + -- make actual (indirect) call + calladdr <- getCurrentOffset + call (Disp offset, eax) + -- discard arguments on stack (+4 for "this") + let argcnt = 4 + 4 * methodGetArgsCount 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) + + 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 @@ -129,18 +144,10 @@ emitFromBB method cls hmap = do mov ebx (Disp 0, eax) -- get method offset offset <- liftIO $ getInterfaceMethodOffset ifacename methodname (encode msig) - -- make actual (indirect) call - calladdr <- getCurrentOffset - call (Disp offset, ebx) - -- discard arguments on stack (+4 for "this") - let argcnt = 4 + ((methodGetArgsCount cls cpidx) * 4) - when (argcnt > 0) (add esp argcnt) - -- push result on stack if method has a return value - when (methodHaveReturnValue cls cpidx) (push eax) - -- note, the "mi" has the wrong class reference here. + -- 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, II mi) + invokeEpilog cpidx offset (\x -> InterfaceMethod x mi) emit' (INVOKEVIRTUAL cpidx) = do -- get methodInfo entry let mi@(MethodInfo methodname objname msig@(MethodSignature args _)) = buildMethodID cls cpidx @@ -150,36 +157,29 @@ emitFromBB method cls hmap = do -- get method-table-ptr mov eax (Disp 0, eax) -- get method offset - let nameAndSig = methodname `B.append` (encode msig) + let nameAndSig = methodname `B.append` encode msig offset <- liftIO $ getMethodOffset objname nameAndSig - -- make actual (indirect) call - calladdr <- getCurrentOffset - call (Disp offset, eax) - -- discard arguments on stack (+4 for "this") - let argcnt = 4 + ((methodGetArgsCount cls cpidx) * 4) - when (argcnt > 0) (add esp argcnt) - -- push result on stack if method has a return value - when (methodHaveReturnValue cls cpidx) (push eax) - -- note, the "mi" has the wrong class reference here. + -- 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, VI mi) + invokeEpilog cpidx offset (\x -> VirtualMethod x mi) emit' (PUTSTATIC cpidx) = do pop eax trapaddr <- getCurrentOffset mov (Addr 0x00000000) eax -- it's a trap - return $ Just $ (trapaddr, SFI $ buildStaticFieldID cls cpidx) + return $ Just (trapaddr, StaticField $ buildStaticFieldID cls cpidx) emit' (GETSTATIC cpidx) = do trapaddr <- getCurrentOffset mov eax (Addr 0x00000000) -- it's a trap push eax - return $ Just $ (trapaddr, SFI $ buildStaticFieldID cls cpidx) + return $ Just (trapaddr, StaticField $ buildStaticFieldID cls cpidx) emit' insn = emit insn >> return Nothing emit :: J.Instruction -> CodeGen e s () - emit POP = do -- dropp value - add esp (4 :: Word32) + emit POP = add esp (4 :: 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 emit AASTORE = emit IASTORE emit IASTORE = do pop eax -- value @@ -187,12 +187,23 @@ emitFromBB method cls hmap = do add ebx (1 :: Word32) pop ecx -- aref mov (ecx, ebx, S4) eax + emit CASTORE = do + pop eax -- value + pop ebx -- offset + add ebx (1 :: Word32) + pop ecx -- aref + mov (ecx, ebx, S1) eax -- TODO(bernhard): char is two byte emit AALOAD = emit IALOAD emit IALOAD = do pop ebx -- offset add ebx (1 :: Word32) pop ecx -- aref push (ecx, ebx, S4) + emit CALOAD = do + pop ebx -- offset + add ebx (1 :: Word32) + pop ecx -- aref + push (ecx, ebx, S1) -- TODO(bernhard): char is two byte emit ARRAYLENGTH = do pop eax push (Disp 0, eax) @@ -200,7 +211,8 @@ emitFromBB method cls hmap = do emit (NEWARRAY typ) = do let tsize = case decodeS (0 :: Integer) (B.pack [typ]) of T_INT -> 4 - _ -> error $ "newarray: type not implemented yet" + T_CHAR -> 2 + _ -> error "newarray: type not implemented yet" -- get length from stack, but leave it there mov eax (Disp 0, esp) mov ebx (tsize :: Word32) @@ -224,8 +236,19 @@ emitFromBB method cls hmap = do mtable <- liftIO $ getMethodTable objname mov (Disp 0, eax) mtable emit (CHECKCAST _) = nop -- TODO(bernhard): ... - emit (BIPUSH val) = push ((fromIntegral val) :: Word32) - emit (SIPUSH val) = push ((fromIntegral $ ((fromIntegral val) :: Int16)) :: Word32) + -- TODO(bernhard): ... + emit (INSTANCEOF _) = do + pop eax + push (1 :: Word32) + emit ATHROW = nop -- TODO(bernhard): ... + emit I2C = do + pop eax + and eax (0x000000ff :: Word32) + push eax + emit (BIPUSH val) = push (fromIntegral val :: Word32) + emit (SIPUSH val) = push (fromIntegral (fromIntegral val :: Int16) :: Word32) + emit ACONST_NULL = push (0 :: Word32) + emit (ICONST_M1) = push ((-1) :: Word32) emit (ICONST_0) = push (0 :: Word32) emit (ICONST_1) = push (1 :: Word32) emit (ICONST_2) = push (2 :: Word32) @@ -233,11 +256,9 @@ emitFromBB method cls hmap = do emit (ICONST_4) = push (4 :: Word32) emit (ICONST_5) = push (5 :: Word32) emit (ALOAD_ x) = emit (ILOAD_ x) - emit (ILOAD_ x) = do - push (Disp (cArgs_ x), ebp) + emit (ILOAD_ x) = push (Disp (cArgs_ x), ebp) emit (ALOAD x) = emit (ILOAD x) - emit (ILOAD x) = do - push (Disp (cArgs x), ebp) + emit (ILOAD x) = push (Disp (cArgs x), ebp) emit (ASTORE_ x) = emit (ISTORE_ x) emit (ISTORE_ x) = do pop eax @@ -249,50 +270,43 @@ emitFromBB method cls hmap = do emit (LDC1 x) = emit (LDC2 $ fromIntegral x) emit (LDC2 x) = do - value <- case (constsPool cls) M.! x of + value <- case constsPool cls M.! x of (CString s) -> liftIO $ getUniqueStringAddr s - _ -> error $ "LDCI... missing impl." + (CInteger i) -> liftIO $ return i + e -> error $ "LDCI... missing impl.: " ++ show e push value emit (GETFIELD x) = do - pop eax -- this pointer - let (cname, fname) = buildFieldOffset cls x - offset <- liftIO $ getFieldOffset cname fname - push (Disp (fromIntegral $ offset), eax) -- get field + offset <- emitFieldOffset x + push (Disp (fromIntegral offset), eax) -- get field emit (PUTFIELD x) = do pop ebx -- value to write - pop eax -- this pointer - let (cname, fname) = buildFieldOffset cls x - offset <- liftIO $ getFieldOffset cname fname - mov (Disp (fromIntegral $ offset), eax) ebx -- set field + 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 IMUL = do pop ebx; pop eax; mul ebx; push eax + emit IDIV = do pop ebx; pop eax; xor edx edx; div ebx; push eax + emit IREM = do pop ebx; pop eax; xor edx edx; div ebx; push edx emit IXOR = do pop ebx; pop eax; xor eax ebx; push eax - emit (IINC x imm) = do + emit IUSHR = do pop ecx; pop eax; sar eax cl; push eax + emit INEG = do pop eax; neg eax; push eax + emit (IINC x imm) = add (Disp (cArgs x), ebp) (s8_w32 imm) + emit (IFNONNULL x) = emit (IF C_NE x) + emit (IFNULL x) = emit (IF C_EQ x) emit (IF_ACMP cond x) = emit (IF_ICMP cond x) emit (IF_ICMP cond _) = do pop eax -- value2 pop ebx -- value1 cmp ebx eax -- intel syntax is swapped (TODO(bernhard): test that plz) - let sid = case successor bb of TwoTarget _ t -> t; _ -> error "bad" - let l = getLabel sid lmap - case cond of - C_EQ -> je l; C_NE -> jne l - C_LT -> jl l; C_GT -> jg l - C_GE -> jge l; C_LE -> jle l + emitIF cond emit (IF cond _) = do pop eax -- value1 cmp eax (0 :: Word32) -- TODO(bernhard): test that plz - let sid = case successor bb of TwoTarget _ t -> t; _ -> error "bad" - let l = getLabel sid lmap - case cond of - C_EQ -> je l; C_NE -> jne l - C_LT -> jl l; C_GT -> jg l - C_GE -> jge l; C_LE -> jle l + emitIF cond emit (GOTO _ ) = do let sid = case successor bb of OneTarget t -> t; _ -> error "bad" @@ -300,25 +314,40 @@ emitFromBB method cls hmap = do emit RETURN = do mov esp ebp; pop ebp; ret emit ARETURN = emit IRETURN - emit IRETURN = do - pop eax - mov esp ebp - pop ebp - ret - emit invalid = error $ "insn not implemented yet: " ++ (show invalid) + 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" + l = getLabel sid lmap + sid2 = case successor bb of TwoTarget t _ -> t; _ -> error "bad" + l2 = getLabel sid2 lmap + in do + case cond of + C_EQ -> je l; C_NE -> jne l + C_LT -> jl l; C_GT -> jg l + C_GE -> jge l; C_LE -> jle l + -- TODO(bernhard): ugly workaround, to get broken emitBB working + -- (it didn't work for gnu/classpath/SystemProperties.java) + jmp l2 + callMalloc :: CodeGen e s () callMalloc = do - calladdr <- getCurrentOffset - let w32_calladdr = 5 + calladdr - let malloaddr = (fromIntegral getMallocObjectAddr :: Word32) - call (malloaddr - w32_calladdr) + call mallocObjectAddr add esp (4 :: Word32) push eax -- for locals we use a different storage cArgs :: Word8 -> Word32 - cArgs x = if (x' >= thisMethodArgCnt) + cArgs x = if x' >= thisMethodArgCnt -- TODO(bernhard): maybe s/(-4)/(-8)/ then fromIntegral $ (-4) * (x' - thisMethodArgCnt + 1) else 4 + (thisMethodArgCnt * 4) - (4 * x') @@ -328,13 +357,12 @@ emitFromBB method cls hmap = do cArgs_ x = cArgs $ case x of I0 -> 0; I1 -> 1; I2 -> 2; I3 -> 3 thisMethodArgCnt :: Word32 - thisMethodArgCnt = isNonStatic + (fromIntegral $ length args) + thisMethodArgCnt = isNonStatic + fromIntegral (length args) where - (Just m) = lookupMethod method cls - (MethodSignature args _) = methodSignature m + (Just m) = lookupMethodSig method sig cls + (MethodSignature args _) = sig isNonStatic = if S.member ACC_STATIC (methodAccessFlags m) - then 0 - else 1 -- one argument for the this pointer + then 0 else 1 -- one argument for the this pointer -- sign extension from w8 to w32 (over s8) @@ -342,4 +370,8 @@ emitFromBB method cls hmap = do -- it should be Int8 actually) s8_w32 :: Word8 -> Word32 s8_w32 w8 = fromIntegral s8 - where s8 = (fromIntegral w8) :: Int8 + where s8 = fromIntegral w8 :: Int8 + + is8BitOffset :: Word32 -> Bool + is8BitOffset w32 = s32 < 128 && s32 > (-127) + where s32 = fromIntegral w32 :: Int32