X-Git-Url: http://wien.tomnetworks.com/gitweb/?a=blobdiff_plain;f=Mate%2FX86CodeGen.hs;h=a61fac314b6d142c4f8dff0289a290c1a252e18f;hb=HEAD;hp=23cf7a32a348c4ba726e2093fdc734507ba026c3;hpb=4c360eaabc8e7259b3011f69397501dcfca17786;p=mate.git diff --git a/Mate/X86CodeGen.hs b/Mate/X86CodeGen.hs index 23cf7a3..a61fac3 100644 --- a/Mate/X86CodeGen.hs +++ b/Mate/X86CodeGen.hs @@ -7,8 +7,9 @@ import Data.Binary import Data.BinaryState import Data.Int import Data.Maybe -import Data.List (genericLength) +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 @@ -20,7 +21,7 @@ import qualified JVM.Assembler as J import JVM.Assembler hiding (Instruction) import JVM.ClassFile -import Harpy +import Harpy hiding (fst) import Harpy.X86Disassembler import Mate.BasicBlocks @@ -31,6 +32,7 @@ import Mate.ClassPool import Mate.ClassHierarchy import {-# SOURCE #-} Mate.MethodPool import Mate.Strings +import Mate.Debug foreign import ccall "&mallocObjectGC" @@ -42,11 +44,11 @@ type PatchInfo = (BlockID, EntryPointOffset) 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 @@ -54,42 +56,30 @@ emitFromBB cls method = do 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 @@ -99,10 +89,9 @@ emitFromBB cls method = do 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 @@ -111,7 +100,7 @@ emitFromBB cls method = do -- like: call $0x01234567 calladdr <- emitSigIllTrap 5 let patcher reip = do - entryAddr <- liftIO $ getMethodEntry l + (entryAddr, _) <- liftIO $ getMethodEntry l call (fromIntegral (entryAddr - (reip + 5)) :: NativeWord) return reip -- discard arguments on stack @@ -150,8 +139,12 @@ emitFromBB cls method = do -- 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 @@ -224,6 +217,43 @@ emitFromBB cls method = do 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 () @@ -279,8 +309,6 @@ emitFromBB cls method = do push eax -- push ref again emit (CHECKCAST _) = nop -- TODO(bernhard): ... - emit ATHROW = -- TODO(bernhard): ... - emit32 (0xffffffff :: Word32) emit I2C = do pop eax and eax (0x000000ff :: Word32) @@ -367,6 +395,7 @@ emitFromBB cls method = do 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)