instanceOf: make decision at runtime
[mate.git] / Mate / X86CodeGen.hs
index 68cc70eb185ff9a939cc9c920a117675cdc1131b..fe1fe5d0c76fed2ad38e22b09c673b7d81f316fe 100644 (file)
@@ -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,54 @@ 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)
+      push (0 :: Word32)
+      let patcher reax reip = do
+            -- mtable <- liftIO $ getMethodTable (buildClassID cls cpidx)
+            -- mov edx mtable
+            emit32 (0x9090ffff :: Word32); nop
+            let classname = buildClassID cls cpidx
+            check <- liftIO $ isInstanceOf (fromIntegral reax) classname
+            if check
+              then push (1 :: Word32)
+              else push (0 :: Word32)
+            return (reip + 5)
+      -- cmp eax edx
+      -- sete al
+      -- movzxb eax al
+      -- push eax
+      -- forceRegDump
+      return $ Just (trapaddr, InstanceOf patcher)
     emit' (NEW objidx) = do
       let objname = buildClassID cls objidx
       trapaddr <- getCurrentOffset
@@ -189,7 +228,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 +330,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 +365,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 +406,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