X-Git-Url: http://wien.tomnetworks.com/gitweb/?a=blobdiff_plain;f=Mate%2FX86CodeGen.hs;h=c42ccadaf2c185e6457d5d97326aaa4aa7aa9844;hb=040b92a7a38d2518f5603a6c01db59eb983ad20e;hp=68cc70eb185ff9a939cc9c920a117675cdc1131b;hpb=1f89e5ca20462468c9b1620a4ba162cb9a8addef;p=mate.git diff --git a/Mate/X86CodeGen.hs b/Mate/X86CodeGen.hs index 68cc70e..c42ccad 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,13 +28,12 @@ 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 "&mallocObject" +foreign import ccall "&mallocObjectGC" mallocObjectAddr :: FunPtr (Int -> IO CPtrdiff) type EntryPoint = Ptr Word8 @@ -114,12 +112,16 @@ emitFromBB cls method = do -- 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 + 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 @@ -159,6 +161,7 @@ emitFromBB cls method = do 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,18 +172,46 @@ 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 + trapaddr <- getCurrentOffset + -- like: 099db064 ff b0 e4 14 00 00 pushl 5348(%eax) + emit32 (0x9090ffff :: Word32); nop; nop + let patcher reip = do + let (cname, fname) = buildFieldOffset cls x + offset <- liftIO $ fromIntegral <$> getFieldOffset cname fname + push32_rel_eax (Disp offset) -- get field + return reip + return $ Just (trapaddr, ObjectField patcher) + emit' (PUTFIELD x) = do + pop ebx -- value to write + pop eax -- this pointer + trapaddr <- getCurrentOffset + -- like: 4581fc6b 89 98 30 7b 00 00 movl %ebx,31536(%eax) + emit32 (0x9090ffff :: Word32); nop; nop + let patcher reip = do + let (cname, fname) = buildFieldOffset cls x + offset <- liftIO $ fromIntegral <$> getFieldOffset cname fname + mov32_rel_ebx_eax (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) + emit32 (0x9090ffff :: Word32) + push (0 :: Word32) + let patcher reax reip = do + emit32 (0x9090ffff :: Word32) + 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 @@ -189,7 +220,16 @@ emitFromBB cls method = do 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' insn = emit insn >> return Nothing @@ -282,13 +322,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 +357,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" @@ -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 +-- call disp32(%eax) call32_eax :: Disp -> CodeGen e s () call32_eax (Disp disp32) = emit8 0xff >> emit8 0x90 >> emit32 disp32 + +-- push disp32(%eax) +push32_rel_eax :: Disp -> CodeGen e s () +push32_rel_eax (Disp disp32) = emit8 0xff >> emit8 0xb0 >> emit32 disp32 + +-- mov %ebx, disp32(%eax) +mov32_rel_ebx_eax :: Disp -> CodeGen e s () +mov32_rel_ebx_eax (Disp disp32) = emit8 0x89 >> emit8 0x98 >> emit32 disp32