From de849ccd03dca9b978457042cb3082d758f68c2c Mon Sep 17 00:00:00 2001 From: Bernhard Urban Date: Tue, 1 May 2012 00:37:13 +0200 Subject: [PATCH] classpool: add interface-table-ptr to method-table-ptr at codegen it's very similiar to invokevirtual, but in the classpool we have to build a quite big table for interface methods offsets for each class. misc notes: - introduced a traptype lookup for trap.c - interface-table-ptr is stored at offset 0 of the method-table --- Mate/ClassPool.hs | 76 ++++++++++++++++++++++++++++++++++++++++--- Mate/MethodPool.hs | 19 +++++++++++ Mate/Types.hs | 42 ++++++++++++++++++++++-- Mate/Utilities.hs | 16 ++++++--- Mate/X86CodeGen.hs | 28 +++++++++++++--- ffi/trap.c | 33 +++++++++++++++---- tests/Interface1.java | 25 ++++++++++++++ tests/Interface2.java | 51 +++++++++++++++++++++++++++++ 8 files changed, 269 insertions(+), 21 deletions(-) create mode 100644 tests/Interface1.java create mode 100644 tests/Interface2.java diff --git a/Mate/ClassPool.hs b/Mate/ClassPool.hs index eeae3de..29cef29 100644 --- a/Mate/ClassPool.hs +++ b/Mate/ClassPool.hs @@ -8,7 +8,8 @@ module Mate.ClassPool ( getObjectSize, getMethodOffset, getFieldOffset, - getStaticFieldAddr + getStaticFieldAddr, + getInterfaceMethodOffset ) where import Data.Int @@ -26,6 +27,7 @@ import Text.Printf import Foreign.Ptr import Foreign.C.Types import Foreign.Marshal.Alloc +import Foreign.Storable import JVM.ClassFile import JVM.Converter @@ -61,7 +63,8 @@ getFieldOffset path field = do getMethodOffset :: B.ByteString -> B.ByteString -> IO (Word32) getMethodOffset path method = do ci <- getClassInfo path - return $ fromIntegral $ (ciMethodMap ci) M.! method + -- (4+) one slot for "interface-table-ptr" + return $ (+4) $ fromIntegral $ (ciMethodMap ci) M.! method getMethodTable :: B.ByteString -> IO (Word32) getMethodTable path = do @@ -87,6 +90,16 @@ getStaticFieldAddr from ptr_trapmap = do getStaticFieldOffset cls field _ -> error $ "getFieldAddr: no trapInfo. abort" +-- interface + method + signature plz! +getInterfaceMethodOffset :: B.ByteString -> B.ByteString -> B.ByteString -> IO (Word32) +getInterfaceMethodOffset ifname meth sig = do + loadInterface ifname + ifmmap <- get_interfacemethodmap >>= ptr2interfacemethodmap + let k = ifname `B.append` meth `B.append` sig + case M.lookup k ifmmap of + Just w32 -> return $ (+4) w32 + Nothing -> error $ "getInterfaceMethodOffset: no offset set" + loadClass :: B.ByteString -> IO ClassInfo loadClass path = do #ifdef DEBUG @@ -94,6 +107,8 @@ loadClass path = do #endif let rpath = toString $ path `B.append` ".class" cfile <- parseClassFile rpath + -- load all interfaces, which are implemented by this class + sequence_ [ loadInterface i | i <- interfaces cfile ] superclass <- case (path /= "java/lang/Object") of True -> do sc <- loadClass $ superClass cfile @@ -102,13 +117,24 @@ loadClass path = do (staticmap, fieldmap) <- calculateFields cfile superclass (methodmap, mbase) <- calculateMethodMap cfile superclass + immap <- get_interfacemethodmap >>= ptr2interfacemethodmap + + -- allocate interface offset table for this class + -- TODO(bernhard): we have some duplicates in immap (i.e. some + -- entries have the same offset), so we could + -- save some memory here. + iftable <- mallocBytes ((4*) $ M.size immap) + let w32_iftable = fromIntegral $ ptrToIntPtr iftable :: Word32 + -- store interface-table at offset 0 in method-table + pokeElemOff (intPtrToPtr $ fromIntegral mbase) 0 w32_iftable #ifdef DEBUG printf "staticmap: %s @ %s\n" (show staticmap) (toString path) printf "fieldmap: %s @ %s\n" (show fieldmap) (toString path) printf "methodmap: %s @ %s\n" (show methodmap) (toString path) printf "mbase: 0x%08x\n" mbase + printf "interfacemethod: %s @ %s\n" (show immap) (toString path) + printf "iftable: 0x%08x\n" w32_iftable #endif - virtual_map <- get_virtualmap >>= ptr2virtualmap let virtual_map' = M.insert mbase path virtual_map virtualmap2ptr virtual_map' >>= set_virtualmap @@ -120,6 +146,47 @@ loadClass path = do return new_ci +loadInterface :: B.ByteString -> IO () +loadInterface path = do + imap <- get_interfacesmap >>= ptr2interfacesmap + -- interface already loaded? + case M.lookup path imap of + Just _ -> return () + Nothing -> do +#ifdef DEBUG + printf "interface: loading \"%s\"\n" $ toString path +#endif + let ifpath = toString $ path `B.append` ".class" + cfile <- parseClassFile ifpath + -- load "superinterfaces" first + sequence_ [ loadInterface i | i <- interfaces cfile ] + immap <- get_interfacemethodmap >>= ptr2interfacemethodmap + + -- load map again, because there could be new entries now + -- due to loading superinterfaces + imap' <- get_interfacesmap >>= ptr2interfacesmap + let max_off = fromIntegral $ (M.size immap) * 4 + -- create index of methods by this interface + let mm = zipbase max_off (classMethods cfile) + + -- create for each method from *every* superinterface a entry to, + -- but just put in the same offset as it is already in the map + let (ifnames, methodnames) = unzip $ concat $ + [ zip (repeat ifname) (classMethods $ imap' M.! ifname) + | ifname <- interfaces cfile ] + let sm = zipWith (\x y -> (entry y, immap M.! (getname x y))) ifnames methodnames + + -- merge all offset tables + let methodmap = (M.fromList sm) `M.union` (M.fromList mm) `M.union` immap + interfacemethodmap2ptr methodmap >>= set_interfacemethodmap + + interfacesmap2ptr (M.insert path cfile imap') >>= set_interfacesmap + where + zipbase base = zipWith (\x y -> (entry y, x + base)) [0,4..] + entry = getname path + getname p y = p `B.append` (methodName y) `B.append` (encode $ methodSignature y) + + calculateFields :: Class Resolved -> Maybe ClassInfo -> IO (FieldMap, FieldMap) calculateFields cf superclass = do -- TODO(bernhard): correct sizes. int only atm @@ -160,7 +227,8 @@ calculateMethodMap cf superclass = do let mm = zipbase max_off methods let methodmap = (M.fromList mm) `M.union` sc_mm - methodbase <- mallocBytes ((fromIntegral $ M.size methodmap) * 4) + -- (+1): one slot for the interface-table-ptr + methodbase <- mallocBytes (((+1) $ fromIntegral $ M.size methodmap) * 4) return (methodmap, fromIntegral $ ptrToIntPtr $ methodbase) where zipbase base = zipWith (\x y -> (entry y, x + base)) [0,4..] where entry y = (methodName y) `B.append` (encode $ methodSignature y) diff --git a/Mate/MethodPool.hs b/Mate/MethodPool.hs index a9aee0f..85010eb 100644 --- a/Mate/MethodPool.hs +++ b/Mate/MethodPool.hs @@ -33,6 +33,21 @@ import Mate.ClassPool foreign import ccall "dynamic" code_void :: FunPtr (IO ()) -> (IO ()) +foreign export ccall getTrapType :: CUInt -> CUInt -> IO CUInt +getTrapType :: CUInt -> CUInt -> IO CUInt +getTrapType signal_from from2 = do + tmap <- get_trapmap >>= ptr2trapmap + case M.lookup (fromIntegral signal_from) tmap of + (Just (MI _)) -> return 0 + (Just (VI _)) -> return 1 + (Just (SFI _)) -> return 2 + (Just (II _)) -> return 4 + -- maybe we've a hit on the second `from' value + Nothing -> case M.lookup (fromIntegral from2) tmap of + (Just (VI _)) -> return 1 + (Just (II _)) -> return 4 + (Just _) -> error $ "getTrapType: abort #1 :-(" + Nothing -> error $ "getTrapType: abort #2 :-(" foreign export ccall getMethodEntry :: CUInt -> CUInt -> IO CUInt getMethodEntry :: CUInt -> CUInt -> IO CUInt @@ -48,6 +63,8 @@ getMethodEntry signal_from methodtable = do (MI x) -> x (VI (MethodInfo methname _ msig)) -> (MethodInfo methname (vmap M.! (fromIntegral methodtable)) msig) + (II (MethodInfo methname _ msig)) -> + (MethodInfo methname (vmap M.! (fromIntegral methodtable)) msig) _ -> error $ "getMethodEntry: no trapInfo. abort." case M.lookup mi' mmap of Nothing -> do @@ -128,6 +145,8 @@ initMethodPool = do classmap2ptr M.empty >>= set_classmap virtualmap2ptr M.empty >>= set_virtualmap stringsmap2ptr M.empty >>= set_stringsmap + interfacesmap2ptr M.empty >>= set_interfacesmap + interfacemethodmap2ptr M.empty >>= set_interfacemethodmap addMethodRef :: Word32 -> MethodInfo -> [B.ByteString] -> IO () diff --git a/Mate/Types.hs b/Mate/Types.hs index 7d1583d..88455bc 100644 --- a/Mate/Types.hs +++ b/Mate/Types.hs @@ -36,11 +36,12 @@ type TrapMap = M.Map Word32 TrapInfo data TrapInfo = MI MethodInfo | -- for static calls VI MethodInfo | -- for virtual calls - SFI StaticFieldInfo + II MethodInfo | -- for interface calls + SFI StaticFieldInfo deriving Show data StaticFieldInfo = StaticFieldInfo { sfiClassName :: B.ByteString, - sfiFieldName :: B.ByteString } + sfiFieldName :: B.ByteString } deriving Show @@ -97,6 +98,13 @@ type StringsMap = M.Map B.ByteString Word32 type VirtualMap = M.Map Word32 B.ByteString +-- store each parsed Interface upon first loading +type InterfacesMap = M.Map B.ByteString (Class Resolved) + +-- store offset for each pair +type InterfaceMethodMap = M.Map B.ByteString Word32 + + toString :: B.ByteString -> String toString bstr = decodeString $ map (chr . fromIntegral) $ B.unpack bstr @@ -133,6 +141,18 @@ foreign import ccall "get_stringsmap" foreign import ccall "set_stringsmap" set_stringsmap :: Ptr () -> IO () +foreign import ccall "get_interfacesmap" + get_interfacesmap :: IO (Ptr ()) + +foreign import ccall "set_interfacesmap" + set_interfacesmap :: Ptr () -> IO () + +foreign import ccall "get_interfacemethodmap" + get_interfacemethodmap :: IO (Ptr ()) + +foreign import ccall "set_interfacemethodmap" + set_interfacemethodmap :: Ptr () -> IO () + -- TODO(bernhard): make some typeclass magic 'n stuff -- or remove that sh** methodmap2ptr :: MethodMap -> IO (Ptr ()) @@ -175,3 +195,21 @@ stringsmap2ptr cmap = do ptr2stringsmap :: Ptr () -> IO StringsMap ptr2stringsmap vmap = deRefStablePtr $ ((castPtrToStablePtr vmap) :: StablePtr cmap) + + +interfacesmap2ptr :: InterfacesMap -> IO (Ptr ()) +interfacesmap2ptr cmap = do + ptr_cmap <- newStablePtr cmap + return $ castStablePtrToPtr ptr_cmap + +ptr2interfacesmap :: Ptr () -> IO InterfacesMap +ptr2interfacesmap vmap = deRefStablePtr $ ((castPtrToStablePtr vmap) :: StablePtr cmap) + + +interfacemethodmap2ptr :: InterfaceMethodMap -> IO (Ptr ()) +interfacemethodmap2ptr cmap = do + ptr_cmap <- newStablePtr cmap + return $ castStablePtrToPtr ptr_cmap + +ptr2interfacemethodmap :: Ptr () -> IO InterfaceMethodMap +ptr2interfacemethodmap vmap = deRefStablePtr $ ((castPtrToStablePtr vmap) :: StablePtr cmap) diff --git a/Mate/Utilities.hs b/Mate/Utilities.hs index 05220fc..50e7a56 100644 --- a/Mate/Utilities.hs +++ b/Mate/Utilities.hs @@ -22,8 +22,10 @@ lookupMethod name cls = look (classMethods cls) buildMethodID :: Class Resolved -> Word16 -> MethodInfo buildMethodID cls idx = MethodInfo (ntName nt) rc (ntSignature nt) - where - (CMethod rc nt) = (constsPool cls) M.! idx + where (rc, nt) = case (constsPool cls) M.! idx of + (CMethod rc' nt') -> (rc', nt') + (CIfaceMethod rc' nt') -> (rc', nt') + _ -> error $ "buildMethodID: something wrong. abort." buildStaticFieldID :: Class Resolved -> Word16 -> StaticFieldInfo buildStaticFieldID cls idx = StaticFieldInfo rc (ntName fnt) @@ -40,7 +42,10 @@ buildClassID cls idx = cl methodGetArgsCount :: Class Resolved -> Word16 -> Word32 methodGetArgsCount cls idx = fromIntegral $ length args where - (CMethod _ nt) = (constsPool cls) M.! idx + nt = case (constsPool cls) M.! idx of + (CMethod _ nt') -> nt' + (CIfaceMethod _ nt') -> nt' + _ -> error $ "methodGetArgsCount: something wrong. abort." (MethodSignature args _) = ntSignature nt -- TODO(bernhard): Extend it to more than just int, and provide typeinformation @@ -51,5 +56,8 @@ methodHaveReturnValue cls idx = case ret of (Returns (ObjectType _)) -> True; _ -> error "methodHaveReturnValue: todo" where - (CMethod _ nt) = (constsPool cls) M.! idx + nt = case (constsPool cls) M.! idx of + (CMethod _ nt') -> nt' + (CIfaceMethod _ nt') -> nt' + _ -> error $ "methodHaveReturnValue: something wrong. abort." (MethodSignature _ ret) = ntSignature nt diff --git a/Mate/X86CodeGen.hs b/Mate/X86CodeGen.hs index 15397fa..cc2ace3 100644 --- a/Mate/X86CodeGen.hs +++ b/Mate/X86CodeGen.hs @@ -15,10 +15,6 @@ import Control.Monad import Foreign hiding (xor) import Foreign.C.Types -#ifdef DEFINE -import Text.Printf -#endif - import qualified JVM.Assembler as J import JVM.Assembler hiding (Instruction) import JVM.ClassFile @@ -123,6 +119,30 @@ emitFromBB method cls hmap = do emit' :: J.Instruction -> CodeGen e s (Maybe (Word32, TrapInfo)) emit' (INVOKESPECIAL cpidx) = emitInvoke cpidx True emit' (INVOKESTATIC cpidx) = emitInvoke cpidx False + emit' (INVOKEINTERFACE cpidx _) = do + -- get methodInfo entry + let mi@(MethodInfo methodname ifacename msig@(MethodSignature args _)) = buildMethodID cls cpidx + newNamedLabel (show mi) >>= defineLabel + -- objref lives somewhere on the argument stack + mov eax (Disp ((*4) $ fromIntegral $ length args), esp) + -- get method-table-ptr, keep it in eax (for trap handling) + mov eax (Disp 0, eax) + -- get interface-table-ptr + mov ebx (Disp 0, eax) + -- get method offset + offset <- liftIO $ getInterfaceMethodOffset ifacename methodname (encode msig) + -- make actual (indirect) call + calladdr <- getCurrentOffset + call (Disp offset, ebx) + -- discard arguments on stack (+4 for "this") + let argcnt = 4 + ((methodGetArgsCount cls cpidx) * 4) + when (argcnt > 0) (add esp argcnt) + -- push result on stack if method has a return value + when (methodHaveReturnValue cls cpidx) (push eax) + -- note, the "mi" has the wrong class reference here. + -- we figure that out at run-time, in the methodpool, + -- depending on the method-table-ptr + return $ Just $ (calladdr, II mi) emit' (INVOKEVIRTUAL cpidx) = do -- get methodInfo entry let mi@(MethodInfo methodname objname msig@(MethodSignature args _)) = buildMethodID cls cpidx diff --git a/ffi/trap.c b/ffi/trap.c index 21426ff..bbe14a4 100644 --- a/ffi/trap.c +++ b/ffi/trap.c @@ -21,6 +21,7 @@ unsigned int getMethodEntry(unsigned int, unsigned int); unsigned int getStaticFieldAddr(unsigned int, void*); +unsigned int getTrapType(unsigned int, unsigned int); #ifdef DEBUG #define dprintf(args...) do { printf (args); } while (0); @@ -46,6 +47,8 @@ NEW_MAP(trap) NEW_MAP(class) NEW_MAP(virtual) NEW_MAP(strings) +NEW_MAP(interfaces) +NEW_MAP(interfacemethod) void mainresult(unsigned int a) @@ -79,24 +82,40 @@ void staticfieldtrap(int nSignal, siginfo_t *info, void *ctx) /* TODO(bernhard): more generic and cleaner please... */ mcontext_t *mctx = &((ucontext_t *) ctx)->uc_mcontext; unsigned int from = (unsigned int) mctx->gregs[REG_EIP]; - if (from < 0x10000) { // invokevirtual + unsigned int *esp = (unsigned int *) mctx->gregs[REG_ESP]; + /* if from is not *the* eip: get actual eip from stack storage */ + unsigned int from_stack = (*esp) - 3; + unsigned int type = getTrapType(from, from_stack); + if (type == 0) { + dprintf("something is wrong here: abort\n"); + exit(1); + } else if (type == 1) { if (from > 0) { dprintf("from: 0x%08x but should be 0 :-(\n", from); } unsigned int method_table_ptr = (unsigned int) mctx->gregs[REG_EAX]; - unsigned int *esp = (unsigned int *) mctx->gregs[REG_ESP]; - /* get actual eip from stack storage */ - unsigned int from = (*esp) - 3; unsigned char offset = *((unsigned char *) (*esp) - 1); /* method entry to patch */ unsigned int *to_patch = (unsigned int*) (method_table_ptr + offset); - dprintf("invokevirtual by 0x%08x with offset 0x%08x\n", from, offset); + dprintf("invokevirtual by 0x%08x with offset 0x%08x\n", from_stack, offset); dprintf(" to_patch: 0x%08x\n", (unsigned int) to_patch); dprintf("*to_patch: 0x%08x\n", *to_patch); - *to_patch = getMethodEntry(from, method_table_ptr); + *to_patch = getMethodEntry(from_stack, method_table_ptr); mctx->gregs[REG_EIP] = *to_patch; dprintf("*to_patch: 0x%08x\n", *to_patch); - } else { + } else if (type == 4) { + unsigned int method_table_ptr = (unsigned int) mctx->gregs[REG_EAX]; + unsigned int interface_table_ptr = (unsigned int) mctx->gregs[REG_EBX]; + unsigned char offset = *((unsigned char *) (*esp) - 1); + /* interface entry to patch */ + unsigned int *to_patch = (unsigned int*) (interface_table_ptr + offset); + dprintf("invokeinterface by 0x%08x with offset 0x%08x\n", from_stack, offset); + dprintf(" to_patch: 0x%08x\n", (unsigned int) to_patch); + dprintf("*to_patch: 0x%08x\n", *to_patch); + *to_patch = getMethodEntry(from_stack, method_table_ptr); + mctx->gregs[REG_EIP] = *to_patch; + dprintf("*to_patch: 0x%08x\n", *to_patch); + } else if (type == 2) { unsigned int *to_patch = (unsigned int *) (from + 2); dprintf("staticfieldtrap by 0x%08x\n", from); if (*to_patch != 0x00000000) { diff --git a/tests/Interface1.java b/tests/Interface1.java new file mode 100644 index 0000000..a21cd05 --- /dev/null +++ b/tests/Interface1.java @@ -0,0 +1,25 @@ +package tests; + +public class Interface1 implements Inf1_I1_local { + public int x; + + public Interface1() { + this.x = 0x1337; + } + + public int func1(int a) { + this.x = a; + return this.x; + } + + public static void main(String []args) { + Interface1 o1 = new Interface1(); + System.out.printf("o1.x: 0x%08x\n", o1.x); + Inf1_I1_local i1 = o1; + System.out.printf("o1.func1(0x11): 0x%08x\n", i1.func1(0x11)); + } +} + +interface Inf1_I1_local { + int func1(int a); +} diff --git a/tests/Interface2.java b/tests/Interface2.java new file mode 100644 index 0000000..071bc79 --- /dev/null +++ b/tests/Interface2.java @@ -0,0 +1,51 @@ +package tests; + +public class Interface2 implements Inf2_I1_local, Inf2_I2_local, Inf2_I3_local { + public int x; + + public Interface2() { + this.x = 0x1337; + } + + public int func1(int a) { + this.x = a; + return this.x; + } + + public int func2(int a, int b) { + return a + b; + } + + public int func3(int a, int b) { + return a - b; + } + + public static void main(String []args) { + Interface2 o1 = new Interface2(); + Inf2_I1_local i1 = o1; + Inf2_I2_local i2 = o1; + Inf2_I3_local i3 = o1; + System.out.printf("this.x: 0x%08x\n", i1.func1(0x1122)); + System.out.printf("this.x: 0x%08x\n", i2.func1(0x22)); + System.out.printf("this.x: 0x%08x\n", i3.func1(0x33)); + + System.out.printf("func2: 0x%08x\n", i2.func2(0x22, 0x44)); + System.out.printf("func2: 0x%08x\n", i3.func2(0x22, 0x44)); + + System.out.printf("func3: 0x%08x\n", i3.func3(0x111, 0x11)); + } +} + +interface Inf2_I1_local { + int func1 (int a); +} + +interface Inf2_I2_local { + int func1 (int a); + int func2 (int a, int b); +} + +interface Inf2_I3_local extends Inf2_I2_local, Inf2_I1_local { + int func1 (int a); + int func3 (int a, int b); +} -- 2.25.1