From: Bernhard Urban Date: Thu, 17 May 2012 22:43:49 +0000 (+0200) Subject: refactor: reduce global var in trap.c to one pointer X-Git-Url: http://wien.tomnetworks.com/gitweb/?p=mate.git;a=commitdiff_plain;h=55d3b7af8c3a1fdef0c5e470e649d180dc0a3911 refactor: reduce global var in trap.c to one pointer still not really what we want :/ --- diff --git a/Mate/ClassPool.hs b/Mate/ClassPool.hs index b7c394c..5260063 100644 --- a/Mate/ClassPool.hs +++ b/Mate/ClassPool.hs @@ -44,7 +44,7 @@ import Mate.GarbageAlloc getClassInfo :: B.ByteString -> IO ClassInfo getClassInfo path = do - class_map <- get_classmap >>= ptr2classmap + class_map <- getClassMap case M.lookup path class_map of Nothing -> loadAndInitClass path Just ci -> return ci @@ -87,7 +87,7 @@ getObjectSize path = do foreign export ccall getStaticFieldAddr :: CUInt -> IO CUInt getStaticFieldAddr :: CUInt -> IO CUInt getStaticFieldAddr from = do - trapmap <- get_trapmap >>= ptr2trapmap + trapmap <- getTrapMap let w32_from = fromIntegral from let sfi = trapmap M.! w32_from case sfi of @@ -98,7 +98,7 @@ getStaticFieldAddr from = do getInterfaceMethodOffset :: B.ByteString -> B.ByteString -> B.ByteString -> IO Word32 getInterfaceMethodOffset ifname meth sig = do loadInterface ifname - ifmmap <- get_interfacemethodmap >>= ptr2interfacemethodmap + ifmmap <- getInterfaceMethodMap let k = ifname `B.append` meth `B.append` sig case M.lookup k ifmmap of Just w32 -> return $ w32 + 4 @@ -122,7 +122,7 @@ loadClass path = do (staticmap, fieldmap) <- calculateFields cfile superclass (methodmap, mbase) <- calculateMethodMap cfile superclass - immap <- get_interfacemethodmap >>= ptr2interfacemethodmap + immap <- getInterfaceMethodMap -- allocate interface offset table for this class -- TODO(bernhard): we have some duplicates in immap (i.e. some @@ -138,20 +138,18 @@ loadClass path = do printfCp "mbase: 0x%08x\n" mbase printfCp "interfacemethod: %s @ %s\n" (show immap) (toString path) printfCp "iftable: 0x%08x\n" w32_iftable - virtual_map <- get_virtualmap >>= ptr2virtualmap - let virtual_map' = M.insert mbase path virtual_map - virtualmap2ptr virtual_map' >>= set_virtualmap + virtual_map <- getVirtualMap + setVirtualMap $ M.insert mbase path virtual_map - class_map <- get_classmap >>= ptr2classmap + class_map <- getClassMap let new_ci = ClassInfo path cfile staticmap fieldmap methodmap mbase False - let class_map' = M.insert path new_ci class_map - classmap2ptr class_map' >>= set_classmap + setClassMap $ M.insert path new_ci class_map return new_ci loadInterface :: B.ByteString -> IO () loadInterface path = do - imap <- get_interfacesmap >>= ptr2interfacesmap + imap <- getInterfaceMap -- interface already loaded? case M.lookup path imap of Just _ -> return () @@ -161,11 +159,11 @@ loadInterface path = do cfile <- parseClassFile ifpath -- load "superinterfaces" first sequence_ [ loadInterface i | i <- interfaces cfile ] - immap <- get_interfacemethodmap >>= ptr2interfacemethodmap + immap <- getInterfaceMethodMap -- load map again, because there could be new entries now -- due to loading superinterfaces - imap' <- get_interfacesmap >>= ptr2interfacesmap + imap' <- getInterfaceMap let max_off = fromIntegral $ M.size immap * 4 -- create index of methods by this interface let mm = zipbase max_off (classMethods cfile) @@ -178,10 +176,8 @@ loadInterface path = do 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 + setInterfaceMethodMap $ M.fromList sm `M.union` M.fromList mm `M.union` immap + setInterfaceMap $ M.insert path cfile imap' where zipbase base = zipWith (\x y -> (entry y, x + base)) [0,4..] entry = getname path @@ -237,7 +233,7 @@ calculateMethodMap cf superclass = do loadAndInitClass :: B.ByteString -> IO ClassInfo loadAndInitClass path = do - class_map <- get_classmap >>= ptr2classmap + class_map <- getClassMap ci <- case M.lookup path class_map of Nothing -> loadClass path Just x -> return x @@ -260,8 +256,7 @@ loadAndInitClass path = do Nothing -> error "loadClass: static initializer not found (WTF?). abort" Nothing -> return () - class_map' <- get_classmap >>= ptr2classmap + class_map' <- getClassMap let new_ci = ci { ciInitDone = True } - let class_map'' = M.insert path new_ci class_map' - classmap2ptr class_map'' >>= set_classmap + setClassMap $ M.insert path new_ci class_map' return new_ci diff --git a/Mate/MethodPool.hs b/Mate/MethodPool.hs index 672c70c..21c1795 100644 --- a/Mate/MethodPool.hs +++ b/Mate/MethodPool.hs @@ -37,7 +37,7 @@ foreign import ccall "dynamic" foreign export ccall getTrapType :: CUInt -> CUInt -> IO CUInt getTrapType :: CUInt -> CUInt -> IO CUInt getTrapType signal_from from2 = do - tmap <- get_trapmap >>= ptr2trapmap + tmap <- getTrapMap case M.lookup (fromIntegral signal_from) tmap of (Just (MI _)) -> return 0 (Just (VI _)) -> return 1 @@ -53,9 +53,9 @@ getTrapType signal_from from2 = do foreign export ccall getMethodEntry :: CUInt -> CUInt -> IO CUInt getMethodEntry :: CUInt -> CUInt -> IO CUInt getMethodEntry signal_from methodtable = do - mmap <- get_methodmap >>= ptr2methodmap - tmap <- get_trapmap >>= ptr2trapmap - vmap <- get_virtualmap >>= ptr2virtualmap + mmap <- getMethodMap + tmap <- getTrapMap + vmap <- getVirtualMap let w32_from = fromIntegral signal_from let mi = tmap M.! w32_from @@ -85,8 +85,7 @@ getMethodEntry signal_from methodtable = do printfMp "native-call: symbol: %s\n" symbol nf <- loadNativeFunction symbol let w32_nf = fromIntegral nf - let mmap' = M.insert mi' w32_nf mmap - methodmap2ptr mmap' >>= set_methodmap + setMethodMap $ M.insert mi' w32_nf mmap return nf else do hmap <- parseMethod cls' method @@ -139,34 +138,26 @@ loadNativeFunction sym = do -- demo_mmap -- access Data.Map from C initMethodPool :: IO () -initMethodPool = do - methodmap2ptr M.empty >>= set_methodmap - trapmap2ptr M.empty >>= set_trapmap - 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 +initMethodPool = ctx2ptr emptyMateCtx >>= set_mate_context addMethodRef :: Word32 -> MethodInfo -> [B.ByteString] -> IO () addMethodRef entry (MethodInfo mmname _ msig) clsnames = do - mmap <- get_methodmap >>= ptr2methodmap + mmap <- getMethodMap let newmap = M.fromList $ map (\x -> (MethodInfo mmname x msig, entry)) clsnames - methodmap2ptr (mmap `M.union` newmap) >>= set_methodmap + setMethodMap $ mmap `M.union` newmap compileBB :: MapBB -> MethodInfo -> IO Word32 compileBB hmap methodinfo = do - tmap <- get_trapmap >>= ptr2trapmap + tmap <- getTrapMap cls <- getClassFile (methClassName methodinfo) let ebb = emitFromBB (methName methodinfo) cls hmap (_, Right right) <- runCodeGen ebb () () let ((entry, _, _, new_tmap), _) = right - let tmap' = tmap `M.union` new_tmap -- prefers elements in tmap - trapmap2ptr tmap' >>= set_trapmap + setTrapMap $ tmap `M.union` new_tmap -- prefers elements in tmap printfJit "generated code of \"%s\":\n" (toString $ methName methodinfo) mapM_ (printfJit "%s\n" . showAtt) (snd right) diff --git a/Mate/Strings.hs b/Mate/Strings.hs index 74a0e17..794af0f 100644 --- a/Mate/Strings.hs +++ b/Mate/Strings.hs @@ -24,12 +24,11 @@ import Mate.GarbageAlloc getUniqueStringAddr :: B.ByteString -> IO Word32 getUniqueStringAddr str = do - smap <- get_stringsmap >>= ptr2stringsmap + smap <- getStringMap case M.lookup str smap of Nothing -> do addr <- allocateJavaString str - let smap' = M.insert str addr smap - stringsmap2ptr smap' >>= set_stringsmap + setStringMap $ M.insert str addr smap return addr Just addr -> return addr diff --git a/Mate/Types.hs b/Mate/Types.hs index 2c181b0..2cdad11 100644 --- a/Mate/Types.hs +++ b/Mate/Types.hs @@ -88,7 +88,7 @@ type FieldMap = M.Map B.ByteString Int32 -- java strings are allocated only once, therefore we -- use a hashmap to store the address for a String -type StringsMap = M.Map B.ByteString Word32 +type StringMap = M.Map B.ByteString Word32 -- map "methodtable addr" to "classname" @@ -98,7 +98,7 @@ type VirtualMap = M.Map Word32 B.ByteString -- store each parsed Interface upon first loading -type InterfacesMap = M.Map B.ByteString (Class Resolved) +type InterfaceMap = M.Map B.ByteString (Class Resolved) -- store offset for each pair type InterfaceMethodMap = M.Map B.ByteString Word32 @@ -110,105 +110,105 @@ toString bstr = decodeString $ map (chr . fromIntegral) $ B.unpack bstr -- those functions are for the "global map hax" -- TODO(bernhard): other solution please -foreign import ccall "get_trapmap" - get_trapmap :: IO (Ptr ()) +foreign import ccall "set_mate_context" + set_mate_context :: Ptr () -> IO () -foreign import ccall "set_trapmap" - set_trapmap :: Ptr () -> IO () +foreign import ccall "get_mate_context" + get_mate_context :: IO (Ptr ()) -foreign import ccall "get_methodmap" - get_methodmap :: IO (Ptr ()) +data MateCtx = MateCtx { + ctxMethodMap :: MethodMap, + ctxTrapMap :: TrapMap, + ctxClassMap :: ClassMap, + ctxVirtualMap :: VirtualMap, + ctxStringMap :: StringMap, + ctxInterfaceMap :: InterfaceMap, + ctxInterfaceMethodMap :: InterfaceMethodMap } -foreign import ccall "set_methodmap" - set_methodmap :: Ptr () -> IO () +emptyMateCtx :: MateCtx +emptyMateCtx = MateCtx M.empty M.empty M.empty M.empty M.empty M.empty M.empty -foreign import ccall "get_classmap" - get_classmap :: IO (Ptr ()) +ctx2ptr :: MateCtx -> IO (Ptr ()) +ctx2ptr ctx = do + ptr <- newStablePtr ctx + return $ castStablePtrToPtr ptr -foreign import ccall "set_classmap" - set_classmap :: Ptr () -> IO () +ptr2ctx :: Ptr () -> IO MateCtx +ptr2ctx ptr = deRefStablePtr (castPtrToStablePtr ptr :: StablePtr MateCtx) -foreign import ccall "get_virtualmap" - get_virtualmap :: IO (Ptr ()) -foreign import ccall "set_virtualmap" - set_virtualmap :: Ptr () -> IO () +setMethodMap :: MethodMap -> IO () +setMethodMap m = do + ctx <- get_mate_context >>= ptr2ctx + ctx2ptr ctx { ctxMethodMap = m } >>= set_mate_context -foreign import ccall "get_stringsmap" - get_stringsmap :: IO (Ptr ()) +getMethodMap :: IO MethodMap +getMethodMap = do + ctx <- get_mate_context >>= ptr2ctx + return $ ctxMethodMap ctx -foreign import ccall "set_stringsmap" - set_stringsmap :: Ptr () -> IO () -foreign import ccall "get_interfacesmap" - get_interfacesmap :: IO (Ptr ()) +setTrapMap :: TrapMap -> IO () +setTrapMap m = do + ctx <- get_mate_context >>= ptr2ctx + ctx2ptr ctx { ctxTrapMap = m } >>= set_mate_context -foreign import ccall "set_interfacesmap" - set_interfacesmap :: Ptr () -> IO () +getTrapMap :: IO TrapMap +getTrapMap = do + ctx <- get_mate_context >>= ptr2ctx + return $ ctxTrapMap ctx -foreign import ccall "get_interfacemethodmap" - get_interfacemethodmap :: IO (Ptr ()) -foreign import ccall "set_interfacemethodmap" - set_interfacemethodmap :: Ptr () -> IO () +setClassMap :: ClassMap -> IO () +setClassMap m = do + ctx <- get_mate_context >>= ptr2ctx + ctx2ptr ctx { ctxClassMap = m } >>= set_mate_context --- TODO(bernhard): make some typeclass magic 'n stuff --- or remove that sh** -methodmap2ptr :: MethodMap -> IO (Ptr ()) -methodmap2ptr methodmap = do - ptr_methodmap <- newStablePtr methodmap - return $ castStablePtrToPtr ptr_methodmap +getClassMap :: IO ClassMap +getClassMap = do + ctx <- get_mate_context >>= ptr2ctx + return $ ctxClassMap ctx -ptr2methodmap :: Ptr () -> IO MethodMap -ptr2methodmap methodmap = deRefStablePtr (castPtrToStablePtr methodmap :: StablePtr MethodMap) -trapmap2ptr :: TrapMap -> IO (Ptr ()) -trapmap2ptr trapmap = do - ptr_trapmap <- newStablePtr trapmap - return $ castStablePtrToPtr ptr_trapmap +setVirtualMap :: VirtualMap -> IO () +setVirtualMap m = do + ctx <- get_mate_context >>= ptr2ctx + ctx2ptr ctx { ctxVirtualMap = m } >>= set_mate_context -ptr2trapmap :: Ptr () -> IO TrapMap -ptr2trapmap vmap = deRefStablePtr (castPtrToStablePtr vmap :: StablePtr trapmap) +getVirtualMap :: IO VirtualMap +getVirtualMap = do + ctx <- get_mate_context >>= ptr2ctx + return $ ctxVirtualMap ctx -classmap2ptr :: ClassMap -> IO (Ptr ()) -classmap2ptr cmap = do - ptr_cmap <- newStablePtr cmap - return $ castStablePtrToPtr ptr_cmap -ptr2classmap :: Ptr () -> IO ClassMap -ptr2classmap vmap = deRefStablePtr (castPtrToStablePtr vmap :: StablePtr cmap) +setStringMap :: StringMap -> IO () +setStringMap m = do + ctx <- get_mate_context >>= ptr2ctx + ctx2ptr ctx { ctxStringMap = m } >>= set_mate_context -virtualmap2ptr :: VirtualMap -> IO (Ptr ()) -virtualmap2ptr cmap = do - ptr_cmap <- newStablePtr cmap - return $ castStablePtrToPtr ptr_cmap +getStringMap :: IO StringMap +getStringMap = do + ctx <- get_mate_context >>= ptr2ctx + return $ ctxStringMap ctx -ptr2virtualmap :: Ptr () -> IO VirtualMap -ptr2virtualmap vmap = deRefStablePtr (castPtrToStablePtr vmap :: StablePtr cmap) +setInterfaceMap :: InterfaceMap -> IO () +setInterfaceMap m = do + ctx <- get_mate_context >>= ptr2ctx + ctx2ptr ctx { ctxInterfaceMap = m } >>= set_mate_context -stringsmap2ptr :: StringsMap -> IO (Ptr ()) -stringsmap2ptr cmap = do - ptr_cmap <- newStablePtr cmap - return $ castStablePtrToPtr ptr_cmap +getInterfaceMap :: IO InterfaceMap +getInterfaceMap = do + ctx <- get_mate_context >>= ptr2ctx + return $ ctxInterfaceMap ctx -ptr2stringsmap :: Ptr () -> IO StringsMap -ptr2stringsmap vmap = deRefStablePtr (castPtrToStablePtr vmap :: StablePtr cmap) +setInterfaceMethodMap :: InterfaceMethodMap -> IO () +setInterfaceMethodMap m = do + ctx <- get_mate_context >>= ptr2ctx + ctx2ptr ctx { ctxInterfaceMethodMap = m } >>= set_mate_context -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) +getInterfaceMethodMap :: IO InterfaceMethodMap +getInterfaceMethodMap = do + ctx <- get_mate_context >>= ptr2ctx + return $ ctxInterfaceMethodMap ctx diff --git a/ffi/trap.c b/ffi/trap.c index 5230c0c..0302c5e 100644 --- a/ffi/trap.c +++ b/ffi/trap.c @@ -32,27 +32,17 @@ unsigned int mallocObject(int); #define dprintf(args...) #endif -#define NEW_MAP(prefix) \ - void* prefix ## _map = NULL; \ - void set_ ## prefix ## map(void *map) \ - { \ - dprintf("set_%s: 0x%08x\n", #prefix , (unsigned int) map); \ - prefix ## _map = map; \ - } \ - void *get_ ## prefix ## map() \ - { \ - dprintf("get_%s: 0x%08x\n", #prefix , (unsigned int) prefix ## _map); \ - return prefix ## _map; \ - } +void *mate_ctx = NULL; -NEW_MAP(method) -NEW_MAP(trap) -NEW_MAP(class) -NEW_MAP(virtual) -NEW_MAP(strings) -NEW_MAP(interfaces) -NEW_MAP(interfacemethod) +void *get_mate_context() +{ + return mate_ctx; +} +void *set_mate_context(void *ctx) +{ + mate_ctx = ctx; +} void mainresult(unsigned int a) {