invokevirtual: get the actual class at run-time

[mate.git] / Mate / Types.hs

diff --git a/Mate/Types.hs b/Mate/Types.hs
index 521a269133c1383a754ec0a547233458c1dd372d..8977143ca1e2b540860e780fe14d17dc86a0518c 100644 (file)
--- a/Mate/Types.hs
+++ b/Mate/Types.hs
@@ -32,7 +32,10 @@ type MapBB = M.Map BlockID BasicBlock
 -- MethodInfo = relevant information about callee
 type TMap = M.Map Word32 TrapInfo
 
-data TrapInfo = MI MethodInfo | SFI StaticFieldInfo
+data TrapInfo =
+  MI MethodInfo |
+  VI MethodInfo | -- for virtual calls
+  SFI StaticFieldInfo
 
 data StaticFieldInfo = StaticFieldInfo {
   sfiClassName :: B.ByteString,
@@ -46,6 +49,11 @@ type ClassMap = M.Map B.ByteString ClassInfo
 
 type FieldMap = M.Map B.ByteString Int32
 
+-- map "methodtable addr" to "classname"
+-- we need that to identify the actual type
+-- on the invokevirtual insn
+type VirtualMap = M.Map Word32 B.ByteString
+
 data ClassInfo = ClassInfo {
   clName :: B.ByteString,
   clFile :: Class Resolved,
@@ -109,6 +117,12 @@ foreign import ccall "get_classmap"
 foreign import ccall "set_classmap"
   set_classmap :: Ptr () -> IO ()
 
+foreign import ccall "get_virtualmap"
+  get_virtualmap :: IO (Ptr ())
+
+foreign import ccall "set_virtualmap"
+  set_virtualmap :: Ptr () -> IO ()
+
 -- TODO(bernhard): make some typeclass magic 'n stuff
 mmap2ptr :: MMap -> IO (Ptr ())
 mmap2ptr mmap = do
@@ -133,3 +147,11 @@ classmap2ptr cmap = do
 
 ptr2classmap :: Ptr () -> IO ClassMap
 ptr2classmap vmap = deRefStablePtr $ ((castPtrToStablePtr vmap) :: StablePtr cmap)
+
+virtualmap2ptr :: VirtualMap -> IO (Ptr ())
+virtualmap2ptr cmap = do
+  ptr_cmap <- newStablePtr cmap
+  return $ castStablePtrToPtr ptr_cmap
+
+ptr2virtualmap :: Ptr () -> IO VirtualMap
+ptr2virtualmap vmap = deRefStablePtr $ ((castPtrToStablePtr vmap) :: StablePtr cmap)