X-Git-Url: http://wien.tomnetworks.com/gitweb/?a=blobdiff_plain;f=Mate%2FX86CodeGen.hs;h=c2c336fab736e33ec8cd6cf3b163cb5d169fe186;hb=da245b03d80644c22b011acba31acacb880d8327;hp=de370bea9c5aef3d40047861a8cb11877676f998;hpb=4f8eac54ade38ddb60f47ba28221353aeb1a0e35;p=mate.git diff --git a/Mate/X86CodeGen.hs b/Mate/X86CodeGen.hs index de370be..c2c336f 100644 --- a/Mate/X86CodeGen.hs +++ b/Mate/X86CodeGen.hs @@ -46,22 +46,23 @@ type BBStarts = M.Map BlockID Int type CompileInfo = (EntryPoint, BBStarts, Int, TrapMap) -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 +emitFromBB :: B.ByteString -> MethodSignature -> Class Direct -> RawMethod -> CodeGen e s (CompileInfo, [Instruction]) +emitFromBB methodname sig 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 - -- TODO(bernhard): determine a reasonable value. - -- e.g. (locals used) * 4 - sub esp (0x60 :: Word32) + sub esp (fromIntegral ((rawLocals method) * 4) :: Word32) (calls, bbstarts) <- efBB (0, hmap M.! 0) M.empty M.empty lmap d <- disassemble end <- getCodeOffset return ((ep, bbstarts, end, calls), d) where + hmap = rawMapBB method + getLabel :: BlockID -> [(BlockID, Label)] -> Label getLabel _ [] = error "label not found!" getLabel i ((x,l):xs) = if i==x then l else getLabel i xs @@ -74,11 +75,14 @@ emitFromBB method sig cls hmap = do bb_offset <- getCodeOffset let bbstarts' = M.insert bid bb_offset bbstarts defineLabel $ getLabel bid lmap - cs <- mapM emit' $ code bb + cs <- mapM emit'' $ code bb let calls' = calls `M.union` M.fromList (catMaybes cs) case successor bb of Return -> return (calls', bbstarts') - FallThrough t -> efBB (t, hmap M.! t) calls' bbstarts' lmap + 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 @@ -110,6 +114,22 @@ emitFromBB method sig cls hmap = do -- +2 is for correcting eip in trap context return $ Just (calladdr + 2, StaticMethod l) + 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 @@ -125,19 +145,10 @@ emitFromBB method sig 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 + 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) - -- 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 - let imm8 = is8BitOffset offset - return $ Just (calladdr + (if imm8 then 3 else 6), InterfaceMethod imm8 mi) + invokeEpilog cpidx offset (`InterfaceMethod` mi) emit' (INVOKEVIRTUAL cpidx) = do -- get methodInfo entry let mi@(MethodInfo methodname objname msig@(MethodSignature args _)) = buildMethodID cls cpidx @@ -149,19 +160,10 @@ emitFromBB method sig cls hmap = do -- get method offset 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 + 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) - -- 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 - let imm8 = is8BitOffset offset - return $ Just (calladdr + (if imm8 then 3 else 6), VirtualMethod imm8 mi) + invokeEpilog cpidx offset (`VirtualMethod` mi) emit' (PUTSTATIC cpidx) = do pop eax trapaddr <- getCurrentOffset @@ -178,6 +180,7 @@ emitFromBB method sig cls hmap = do 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 @@ -238,7 +241,8 @@ emitFromBB method sig cls hmap = do emit (INSTANCEOF _) = do pop eax push (1 :: Word32) - emit ATHROW = nop -- TODO(bernhard): ... + emit ATHROW = -- TODO(bernhard): ... + emit32 (0xffffffff :: Word32) emit I2C = do pop eax and eax (0x000000ff :: Word32) @@ -253,14 +257,14 @@ emitFromBB method sig cls hmap = do emit (ICONST_3) = push (3 :: Word32) emit (ICONST_4) = push (4 :: Word32) emit (ICONST_5) = push (5 :: Word32) + emit (ALOAD_ x) = emit (ILOAD_ x) - emit (ILOAD_ x) = push (Disp (cArgs_ x), ebp) + emit (ILOAD_ x) = emit (ILOAD $ cArgs_ x) emit (ALOAD x) = emit (ILOAD x) emit (ILOAD x) = push (Disp (cArgs x), ebp) + emit (ASTORE_ x) = emit (ISTORE_ x) - emit (ISTORE_ x) = do - pop eax - mov (Disp (cArgs_ x), ebp) eax + emit (ISTORE_ x) = emit (ISTORE $ cArgs_ x) emit (ASTORE x) = emit (ISTORE x) emit (ISTORE x) = do pop eax @@ -270,6 +274,7 @@ emitFromBB method sig cls hmap = do emit (LDC2 x) = do value <- case constsPool cls M.! x of (CString s) -> liftIO $ getUniqueStringAddr s + (CInteger i) -> liftIO $ return i e -> error $ "LDCI... missing impl.: " ++ show e push value emit (GETFIELD x) = do @@ -286,6 +291,7 @@ emitFromBB method sig cls hmap = do 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 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) @@ -323,10 +329,17 @@ emitFromBB method sig cls hmap = do emitIF cond = let sid = case successor bb of TwoTarget _ t -> t; _ -> error "bad" l = getLabel sid lmap - in 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 + 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 @@ -342,13 +355,14 @@ emitFromBB method sig cls hmap = do else 4 + (thisMethodArgCnt * 4) - (4 * x') where x' = fromIntegral x - cArgs_ :: IMM -> Word32 - cArgs_ x = cArgs $ case x of I0 -> 0; I1 -> 1; I2 -> 2; I3 -> 3 + 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 - (Just m) = lookupMethodSig method sig cls + 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