instanceOf: make decision at runtime

preperation for a serious instanceOf implementation

diff --git a/Mate/ClassHierarchy.hs b/Mate/ClassHierarchy.hs
new file mode 100644 (file)
index 0000000..c501ed9
--- /dev/null
+++ b/Mate/ClassHierarchy.hs
@@ -0,0 +1,30 @@
+module Mate.ClassHierarchy
+  ( isInstanceOf
+  ) where
+
+import qualified Data.ByteString.Lazy as B
+import Control.Applicative
+import Text.Printf
+
+import Mate.NativeSizes
+import Mate.ClassPool
+
+
+data Class
+  = Class
+    { clMtable :: NativeWord
+    , clSuperClass :: Class
+    , clInterfaces :: [Interface]
+    }
+  | JavaLangObject
+    { clMtable :: NativeWord
+    }
+
+data Interface
+  = Interface
+    { ifSuperInterfaces :: [Interface]
+    }
+
+isInstanceOf :: NativeWord -> B.ByteString -> IO Bool
+isInstanceOf obj_mtable classname = do
+  (== obj_mtable) <$> getMethodTable classname

diff --git a/Mate/Types.hs b/Mate/Types.hs
index ec76a4cb7d41f5b3631b550e296ee479ba085708..7de8493a8523dddf9c8b6084e42e238a26d0fe22 100644 (file)
--- a/Mate/Types.hs
+++ b/Mate/Types.hs
@@ -67,12 +67,13 @@ data RawMethod = RawMethod {
 type TrapMap = M.Map NativeWord TrapCause
 
 type TrapPatcher = CPtrdiff -> CodeGen () () CPtrdiff
 type TrapMap = M.Map NativeWord TrapCause
 
 type TrapPatcher = CPtrdiff -> CodeGen () () CPtrdiff

+type TrapPatcherEax = CPtrdiff -> CPtrdiff -> CodeGen () () CPtrdiff

 
 data TrapCause
   = StaticMethod TrapPatcher -- for static calls
   | VirtualCall Bool MethodInfo (IO NativeWord) -- for invoke{interface,virtual}
 
 data TrapCause
   = StaticMethod TrapPatcher -- for static calls
   | VirtualCall Bool MethodInfo (IO NativeWord) -- for invoke{interface,virtual}

-  | InstanceOf B.ByteString -- class name
-  | NewObject TrapPatcher -- class name
+  | InstanceOf TrapPatcherEax
+  | NewObject TrapPatcher

   | StaticField StaticFieldInfo
   | ObjectField TrapPatcher
 
   | StaticField StaticFieldInfo
   | ObjectField TrapPatcher
 

diff --git a/Mate/X86CodeGen.hs b/Mate/X86CodeGen.hs
index 1097e8565035257771068e76e3b9291ae0819c68..fe1fe5d0c76fed2ad38e22b09c673b7d81f316fe 100644 (file)
--- a/Mate/X86CodeGen.hs
+++ b/Mate/X86CodeGen.hs
@@ -28,6 +28,7 @@ import Mate.NativeSizes
 import Mate.Types
 import Mate.Utilities
 import Mate.ClassPool
 import Mate.Types
 import Mate.Utilities
 import Mate.ClassPool

+import Mate.ClassHierarchy

 import {-# SOURCE #-} Mate.MethodPool
 import Mate.Strings
 
 import {-# SOURCE #-} Mate.MethodPool
 import Mate.Strings
 


@@ -202,12 +203,23 @@ emitFromBB cls method = do
       trapaddr <- getCurrentOffset
       -- place something like `mov edx $mtable_of_objref' instead
       emit32 (0x9090ffff :: Word32); nop
       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
     emit' (NEW objidx) = do
       let objname = buildClassID cls objidx
       trapaddr <- getCurrentOffset

diff --git a/Mate/X86TrapHandling.hs b/Mate/X86TrapHandling.hs
index 7a5c5494a57f6011b8b9ad45622b3e95a22210c3..0df63b866479fac4d2a8d0bcedc508c067dc8d76 100644 (file)
--- a/Mate/X86TrapHandling.hs
+++ b/Mate/X86TrapHandling.hs
@@ -12,7 +12,7 @@ import qualified Data.ByteString.Lazy as B
 import Foreign
 import Foreign.C.Types
 
 import Foreign
 import Foreign.C.Types
 

-import Harpy
+import Harpy hiding (fst)

 
 import Mate.Types
 import Mate.NativeSizes
 
 import Mate.Types
 import Mate.NativeSizes


@@ -38,8 +38,8 @@ mateHandler reip reax rebx resi = do
         staticFieldHandler reip >>= delTrue
     (Just (ObjectField patcher)) ->
         patchWithHarpy patcher reip >>= delTrue
         staticFieldHandler reip >>= delTrue
     (Just (ObjectField patcher)) ->
         patchWithHarpy patcher reip >>= delTrue

-    (Just (InstanceOf cn))  ->
-        patchWithHarpy (`patchInstanceOf` cn) reip >>= delFalse
+    (Just (InstanceOf patcher))  ->
+        patchWithHarpy (patcher reax) reip >>= delFalse

     (Just (NewObject patcher))   ->
         patchWithHarpy patcher reip >>= delTrue
     (Just (VirtualCall False mi io_offset)) ->
     (Just (NewObject patcher))   ->
         patchWithHarpy patcher reip >>= delTrue
     (Just (VirtualCall False mi io_offset)) ->


@@ -72,7 +72,7 @@ patchWithHarpy patcher reip = do
   if mateDEBUG
     then mapM_ (printfJit . printf "patched: %s\n" . showAtt) $ snd right
     else return ()
   if mateDEBUG
     then mapM_ (printfJit . printf "patched: %s\n" . showAtt) $ snd right
     else return ()

-  return reip
+  return $ fst right

 
 withDisasm :: CodeGen e s CPtrdiff -> CodeGen e s (CPtrdiff, [Instruction])
 withDisasm patcher = do
 
 withDisasm :: CodeGen e s CPtrdiff -> CodeGen e s (CPtrdiff, [Instruction])
 withDisasm patcher = do


@@ -91,12 +91,6 @@ staticFieldHandler reip = do
       return reip
     else error "staticFieldHandler: something is wrong here. abort.\n"
 
       return reip
     else error "staticFieldHandler: something is wrong here. abort.\n"
 

-patchInstanceOf :: CPtrdiff -> B.ByteString -> CodeGen e s CPtrdiff
-patchInstanceOf reip classname = do
-  mtable <- liftIO $ getMethodTable classname
-  mov edx mtable
-  return reip
-

 patchInvoke :: MethodInfo -> CPtrdiff -> CPtrdiff -> IO NativeWord -> CPtrdiff -> CodeGen e s CPtrdiff
 patchInvoke (MethodInfo methname _ msig)  method_table table2patch io_offset reip = do
   vmap <- liftIO $ getVirtualMap
 patchInvoke :: MethodInfo -> CPtrdiff -> CPtrdiff -> IO NativeWord -> CPtrdiff -> CodeGen e s CPtrdiff
 patchInvoke (MethodInfo methname _ msig)  method_table table2patch io_offset reip = do
   vmap <- liftIO $ getVirtualMap