instanceOf: class hierarchy are considered properly now

[mate.git] / Mate / X86CodeGen.hs

diff --git a/Mate/X86CodeGen.hs b/Mate/X86CodeGen.hs
index 9abe1f4cb0ff17bd9b9ca46787cb4fe4f1ca52dc..c42ccadaf2c185e6457d5d97326aaa4aa7aa9844 100644 (file)
--- a/Mate/X86CodeGen.hs
+++ b/Mate/X86CodeGen.hs
@@ -11,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
@@ -27,6 +28,7 @@ import Mate.NativeSizes
 import Mate.Types
 import Mate.Utilities
 import Mate.ClassPool
+import Mate.ClassHierarchy
 import {-# SOURCE #-} Mate.MethodPool
 import Mate.Strings
 
@@ -178,8 +180,8 @@ emitFromBB cls method = do
       emit32 (0x9090ffff :: Word32); nop; nop
       let patcher reip = do
             let (cname, fname) = buildFieldOffset cls x
-            offset <- liftIO $ getFieldOffset cname fname
-            push32_rel_eax (Disp (fromIntegral offset)) -- get field
+            offset <- liftIO $ fromIntegral <$> getFieldOffset cname fname
+            push32_rel_eax (Disp offset) -- get field
             return reip
       return $ Just (trapaddr, ObjectField patcher)
     emit' (PUTFIELD x) = do
@@ -190,23 +192,26 @@ emitFromBB cls method = do
       emit32 (0x9090ffff :: Word32); nop; nop
       let patcher reip = do
             let (cname, fname) = buildFieldOffset cls x
-            offset <- liftIO $ getFieldOffset cname fname
-            mov32_rel_ebx_eax (Disp (fromIntegral offset)) -- set field
+            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
@@ -215,12 +220,14 @@ emitFromBB cls method = do
       callMalloc
       -- 0x13371337 is just a placeholder; will be replaced with mtable ptr
       mov (Disp 0, eax) (0x13371337 :: Word32)
+      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)