X-Git-Url: http://wien.tomnetworks.com/gitweb/?a=blobdiff_plain;f=Mate%2FX86CodeGen.hs;h=03333ce0d35d5163a3b31da763a60eb3d20b6ad6;hb=3398391fa883278959063506c8051943aba9c4ee;hp=40b826214bb7dc0561a8bf8f53b742f8e909cf89;hpb=ccc1ff2921984cfd36595e935e3634842fa2cb7d;p=mate.git diff --git a/Mate/X86CodeGen.hs b/Mate/X86CodeGen.hs index 40b8262..03333ce 100644 --- a/Mate/X86CodeGen.hs +++ b/Mate/X86CodeGen.hs @@ -1,7 +1,5 @@ -{-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ForeignFunctionInterface #-} -#include "debug.h" module Mate.X86CodeGen where import Prelude hiding (and, div) @@ -13,6 +11,7 @@ import Data.List (genericLength) import qualified Data.Map as M import qualified Data.ByteString.Lazy as B import Control.Monad +import Control.Applicative import Foreign hiding (xor) import Foreign.C.Types @@ -29,10 +28,9 @@ import Mate.NativeSizes 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 foreign import ccall "&mallocObjectGC" @@ -44,10 +42,10 @@ 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 :: Class Direct -> RawMethod -> CodeGen e JpcNpcMap (CompileInfo, [Instruction]) emitFromBB cls method = do let keys = M.keys hmap llmap <- mapM (newNamedLabel . (++) "bb_" . show) keys @@ -56,42 +54,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 @@ -101,25 +87,26 @@ 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 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); nop + -- 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) virtualCall :: Word16 -> Bool -> CodeGen e s (Maybe (Word32, TrapCause)) virtualCall cpidx isInterface = do @@ -132,15 +119,14 @@ emitFromBB cls method = do 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 + 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 -- will be patched to this: call (Disp 0xXXXXXXXX, eax) - emit32 (0x9090ffff :: Word32); nop; nop + emitSigIllTrap 6 -- discard arguments on stack (`+1' for "this") let argcnt = ptrSize * (1 + methodGetArgsCount (methodNameTypeByIdx cls cpidx)) when (argcnt > 0) (add esp argcnt) @@ -151,14 +137,19 @@ 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'' :: J.Instruction -> CodeGen e JpcNpcMap (Maybe (Word32, TrapCause)) + emit'' insn = do + ep <- (fromIntegral . ptrToIntPtr) <$> getEntryPoint + jpcrpc <- getState + setState (M.insert ep bid 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 _) = virtualCall cpidx True emit' (INVOKEVIRTUAL cpidx) = virtualCall cpidx False + emit' (PUTSTATIC cpidx) = do pop eax trapaddr <- getCurrentOffset @@ -169,27 +160,68 @@ emitFromBB cls method = do 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 - 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) + 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 - trapaddr <- getCurrentOffset -- place something like `push $objsize' instead - emit32 (0x9090ffff :: Word32); nop + trapaddr <- emitSigIllTrap 5 callMalloc -- 0x13371337 is just a placeholder; will be replaced with mtable ptr mov (Disp 0, eax) (0x13371337 :: Word32) - return $ Just (trapaddr, NewObject objname) + 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 + trapaddr <- emitSigIllTrap 2 + let patcher resp reip = do + error "no athrow for you, sorry" + emitSigIllTrap 2 + return reip + return $ Just (trapaddr, ThrowException patcher) emit' insn = emit insn >> return Nothing @@ -246,8 +278,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) @@ -282,13 +312,6 @@ emitFromBB cls method = do (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 @@ -324,12 +347,6 @@ emitFromBB cls method = do 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" @@ -345,6 +362,16 @@ emitFromBB cls method = do -- (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 + -- for locals we use a different storage cArgs :: Word8 -> Word32 @@ -371,11 +398,22 @@ callMalloc = do add esp (ptrSize :: Word32) push eax --- the regular push implementation, considers the provided immediate and selects --- a different instruction if it fits in 8bit. but this is not useful for --- patching. + +-- 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 -call32_eax :: Disp -> CodeGen e s () -call32_eax (Disp disp32) = emit8 0xff >> emit8 0x90 >> emit32 disp32 +-- 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