X-Git-Url: http://wien.tomnetworks.com/gitweb/?a=blobdiff_plain;f=Mate%2FTypes.hs;h=8977143ca1e2b540860e780fe14d17dc86a0518c;hb=54a2170d22bb853afa42d87eeeffd8b633efcd36;hp=521a269133c1383a754ec0a547233458c1dd372d;hpb=15833bb85e8b1b82f30024ff7261a208327ceb32;p=mate.git diff --git a/Mate/Types.hs b/Mate/Types.hs index 521a269..8977143 100644 --- 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)