From aa51cc76fd6ab9e70ae0a0c2e722bdd9e0bd2c55 Mon Sep 17 00:00:00 2001 From: Bernhard Urban Date: Mon, 23 Apr 2012 16:10:21 +0200 Subject: [PATCH] refactor: s/C(aller)Map/T(rap)Map/g we want to store more information for traps, hence an more appropriate name --- Mate/MethodPool.hs | 74 ++++++++++++++++++++++++---------------------- Mate/Types.hs | 28 ++++++++++-------- Mate/X86CodeGen.hs | 8 ++--- ffi/trap.c | 4 +-- 4 files changed, 60 insertions(+), 54 deletions(-) diff --git a/Mate/MethodPool.hs b/Mate/MethodPool.hs index cba2d17..1d74493 100644 --- a/Mate/MethodPool.hs +++ b/Mate/MethodPool.hs @@ -35,40 +35,42 @@ foreign import ccall "dynamic" foreign export ccall getMethodEntry :: CUInt -> Ptr () -> Ptr () -> IO CUInt getMethodEntry :: CUInt -> Ptr () -> Ptr () -> IO CUInt -getMethodEntry signal_from ptr_mmap ptr_cmap = do +getMethodEntry signal_from ptr_mmap ptr_tmap = do mmap <- ptr2mmap ptr_mmap - cmap <- ptr2cmap ptr_cmap + tmap <- ptr2tmap ptr_tmap let w32_from = fromIntegral signal_from - let mi@(MethodInfo method cm sig) = cmap M.! w32_from - -- TODO(bernhard): replace parsing with some kind of classpool - cls <- getClassFile cm - case M.lookup mi mmap of - Nothing -> do - printf "getMethodEntry(from 0x%08x): no method \"%s\" found. compile it\n" w32_from (show mi) - let mm = lookupMethod method cls - case mm of - Just mm' -> do - let flags = methodAccessFlags mm' - case S.member ACC_NATIVE flags of - False -> do - hmap <- parseMethod cls method - printMapBB hmap - case hmap of - Just hmap' -> do - entry <- compileBB hmap' mi - return $ fromIntegral $ ((fromIntegral $ ptrToIntPtr entry) :: Word32) - Nothing -> error $ (show method) ++ " not found. abort" - True -> do - let symbol = (replace "/" "_" $ toString cm) ++ "__" ++ (toString method) ++ "__" ++ (replace "(" "_" (replace ")" "_" $ toString $ encode sig)) - printf "native-call: symbol: %s\n" symbol - nf <- loadNativeFunction symbol - let w32_nf = fromIntegral nf - let mmap' = M.insert mi w32_nf mmap - mmap2ptr mmap' >>= set_methodmap - return nf - Nothing -> error $ (show method) ++ " not found. abort" - Just w32 -> return (fromIntegral w32) + let mi = tmap M.! w32_from + case mi of + (MI mi'@(MethodInfo method cm sig)) -> do + case M.lookup mi' mmap of + Nothing -> do + cls <- getClassFile cm + printf "getMethodEntry(from 0x%08x): no method \"%s\" found. compile it\n" w32_from (show mi') + let mm = lookupMethod method cls + case mm of + Just mm' -> do + let flags = methodAccessFlags mm' + case S.member ACC_NATIVE flags of + False -> do + hmap <- parseMethod cls method + printMapBB hmap + case hmap of + Just hmap' -> do + entry <- compileBB hmap' mi' + return $ fromIntegral $ ((fromIntegral $ ptrToIntPtr entry) :: Word32) + Nothing -> error $ (show method) ++ " not found. abort" + True -> do + let symbol = (replace "/" "_" $ toString cm) ++ "__" ++ (toString method) ++ "__" ++ (replace "(" "_" (replace ")" "_" $ toString $ encode sig)) + printf "native-call: symbol: %s\n" symbol + nf <- loadNativeFunction symbol + let w32_nf = fromIntegral nf + let mmap' = M.insert mi' w32_nf mmap + mmap2ptr mmap' >>= set_methodmap + return nf + Nothing -> error $ (show method) ++ " not found. abort" + Just w32 -> return (fromIntegral w32) + _ -> error $ "getMethodEntry: no trapInfo. abort" -- TODO(bernhard): UBERHAX. ghc patch? foreign import ccall safe "lookupSymbol" @@ -96,24 +98,24 @@ loadNativeFunction sym = do initMethodPool :: IO () initMethodPool = do mmap2ptr M.empty >>= set_methodmap - cmap2ptr M.empty >>= set_callermap + tmap2ptr M.empty >>= set_trapmap classmap2ptr M.empty >>= set_classmap compileBB :: MapBB -> MethodInfo -> IO (Ptr Word8) compileBB hmap methodinfo = do mmap <- get_methodmap >>= ptr2mmap - cmap <- get_callermap >>= ptr2cmap + tmap <- get_trapmap >>= ptr2tmap -- TODO(bernhard): replace parsing with some kind of classpool cls <- getClassFile (cName methodinfo) let ebb = emitFromBB cls hmap - (_, Right ((entry, _, _, new_cmap), disasm)) <- runCodeGen ebb () () + (_, Right ((entry, _, _, new_tmap), disasm)) <- runCodeGen ebb () () let w32_entry = ((fromIntegral $ ptrToIntPtr entry) :: Word32) let mmap' = M.insert methodinfo w32_entry mmap - let cmap' = M.union cmap new_cmap -- prefers elements in cmap + let tmap' = M.union tmap new_tmap -- prefers elements in cmap mmap2ptr mmap' >>= set_methodmap - cmap2ptr cmap' >>= set_callermap + tmap2ptr tmap' >>= set_trapmap printf "disasm:\n" mapM_ (putStrLn . showAtt) disasm diff --git a/Mate/Types.hs b/Mate/Types.hs index 8432e9d..832160e 100644 --- a/Mate/Types.hs +++ b/Mate/Types.hs @@ -31,7 +31,12 @@ type MapBB = M.Map BlockID BasicBlock -- Word32 = point of method call in generated code -- MethodInfo = relevant information about callee -type CMap = M.Map Word32 MethodInfo +type TMap = M.Map Word32 TrapInfo + +data TrapInfo = MI MethodInfo | SFI StaticFieldInfo + +data StaticFieldInfo = StaticFieldInfo { + dunnoyet :: Int } -- B.ByteString = name of method -- Word32 = entrypoint of method @@ -43,7 +48,6 @@ data ClassInfo = ClassInfo { clName :: B.ByteString, clFile :: Class Resolved } - data MethodInfo = MethodInfo { methName :: B.ByteString, cName :: B.ByteString, @@ -80,11 +84,11 @@ toString bstr = decodeString $ map (chr . fromIntegral) $ B.unpack bstr -- global map hax -foreign import ccall "get_callermap" - get_callermap :: IO (Ptr ()) +foreign import ccall "get_trapmap" + get_trapmap :: IO (Ptr ()) -foreign import ccall "set_callermap" - set_callermap :: Ptr () -> IO () +foreign import ccall "set_trapmap" + set_trapmap :: Ptr () -> IO () foreign import ccall "get_methodmap" get_methodmap :: IO (Ptr ()) @@ -107,13 +111,13 @@ mmap2ptr mmap = do ptr2mmap :: Ptr () -> IO MMap ptr2mmap vmap = deRefStablePtr $ ((castPtrToStablePtr vmap) :: StablePtr MMap) -cmap2ptr :: CMap -> IO (Ptr ()) -cmap2ptr cmap = do - ptr_cmap <- newStablePtr cmap - return $ castStablePtrToPtr ptr_cmap +tmap2ptr :: TMap -> IO (Ptr ()) +tmap2ptr tmap = do + ptr_tmap <- newStablePtr tmap + return $ castStablePtrToPtr ptr_tmap -ptr2cmap :: Ptr () -> IO CMap -ptr2cmap vmap = deRefStablePtr $ ((castPtrToStablePtr vmap) :: StablePtr cmap) +ptr2tmap :: Ptr () -> IO TMap +ptr2tmap vmap = deRefStablePtr $ ((castPtrToStablePtr vmap) :: StablePtr tmap) classmap2ptr :: ClassMap -> IO (Ptr ()) classmap2ptr cmap = do diff --git a/Mate/X86CodeGen.hs b/Mate/X86CodeGen.hs index 82ec9d8..ccaee0e 100644 --- a/Mate/X86CodeGen.hs +++ b/Mate/X86CodeGen.hs @@ -113,7 +113,7 @@ type PatchInfo = (BlockID, EntryPointOffset) type BBStarts = M.Map BlockID Int -type CompileInfo = (EntryPoint, BBStarts, Int, CMap) +type CompileInfo = (EntryPoint, BBStarts, Int, TMap) emitFromBB :: Class Resolved -> MapBB -> CodeGen e s (CompileInfo, [Instruction]) @@ -133,7 +133,7 @@ emitFromBB cls hmap = do getLabel _ [] = error "label not found!" getLabel i ((x,l):xs) = if i==x then l else getLabel i xs - efBB :: (BlockID, BasicBlock) -> CMap -> BBStarts -> [(BlockID, Label)] -> CodeGen e s (CMap, BBStarts) + efBB :: (BlockID, BasicBlock) -> TMap -> BBStarts -> [(BlockID, Label)] -> CodeGen e s (TMap, BBStarts) efBB (bid, bb) calls bbstarts lmap = if M.member bid bbstarts then return (calls, bbstarts) @@ -156,7 +156,7 @@ emitFromBB cls hmap = do -- TODO(bernhard): implement `emit' as function which accepts a list of -- instructions, so we can use patterns for optimizations where - emit' :: J.Instruction -> CodeGen e s (Maybe (Word32, MethodInfo)) + emit' :: J.Instruction -> CodeGen e s (Maybe (Word32, TrapInfo)) emit' (INVOKESTATIC cpidx) = do ep <- getEntryPoint let w32_ep = (fromIntegral $ ptrToIntPtr ep) :: Word32 @@ -172,7 +172,7 @@ emitFromBB cls hmap = do when (argcnt > 0) (add esp argcnt) -- push result on stack if method has a return value when (methodHaveReturnValue cls cpidx) (push eax) - return $ Just $ (w32_calladdr, l) + return $ Just $ (w32_calladdr, MI l) emit' insn = emit insn >> return Nothing emit :: J.Instruction -> CodeGen e s () diff --git a/ffi/trap.c b/ffi/trap.c index 4440cd7..14a8034 100644 --- a/ffi/trap.c +++ b/ffi/trap.c @@ -32,7 +32,7 @@ unsigned int getMethodEntry(unsigned int, void *, void *); } NEW_MAP(method) -NEW_MAP(caller) +NEW_MAP(trap) NEW_MAP(class) @@ -45,7 +45,7 @@ void callertrap(int nSignal, siginfo_t *info, void *ctx) { struct ucontext *uctx = (struct ucontext *) ctx; unsigned int from = (unsigned int) uctx->uc_mcontext.eip - 2; - unsigned int patchme = getMethodEntry(from, method_map, caller_map); + unsigned int patchme = getMethodEntry(from, method_map, trap_map); printf("callertrap(mctx) by 0x%08x\n", from); -- 2.25.1