From 4c360eaabc8e7259b3011f69397501dcfca17786 Mon Sep 17 00:00:00 2001 From: Bernhard Urban Date: Wed, 29 Aug 2012 00:58:08 +0200 Subject: [PATCH] hlint: style cleanup --- Mate/BasicBlocks.hs | 14 +++++------ Mate/ClassPool.hs | 18 +++++++------- Mate/Debug.hs | 5 ++-- Mate/MethodPool.hs | 9 ++++--- Mate/X86CodeGen.hs | 52 +++++++++++++++++++++-------------------- Mate/X86TrapHandling.hs | 26 +++++++++------------ 6 files changed, 59 insertions(+), 65 deletions(-) diff --git a/Mate/BasicBlocks.hs b/Mate/BasicBlocks.hs index 04a2c3b..c94e6d1 100644 --- a/Mate/BasicBlocks.hs +++ b/Mate/BasicBlocks.hs @@ -34,21 +34,21 @@ printMapBB :: MapBB -> IO () printMapBB hmap = do printfBb "BlockIDs: " let keys = M.keys hmap - mapM_ (printfBb. (flip (++)) ", " . show) keys - printfBb "\n\nBasicBlocks:" + mapM_ (printfBb . flip (++) ", " . show) keys + printfBb "\n\nBasicBlocks:\n" printMapBB' keys hmap where printMapBB' :: [BlockID] -> MapBB -> IO () printMapBB' [] _ = return () printMapBB' (i:is) hmap' = case M.lookup i hmap' of Just bb -> do - printfBb $ "Block " ++ (show i) - mapM_ printfBb (map ((++) "\t" . show) $ code bb) + printfBb $ "Block " ++ show i ++ "\n" + mapM_ (printfBb . flip (++) "\n" . (++) "\t" . show) $ code bb printfBb $ case successor bb of Return -> "" - FallThrough t1 -> "Sucessor: " ++ (show t1) ++ "\n" - OneTarget t1 -> "Sucessor: " ++ (show t1) ++ "\n" - TwoTarget t1 t2 -> "Sucessor: " ++ (show t1) ++ ", " ++ (show t2) ++ "\n" + FallThrough t1 -> "Sucessor: " ++ show t1 ++ "\n" + OneTarget t1 -> "Sucessor: " ++ show t1 ++ "\n" + TwoTarget t1 t2 -> "Sucessor: " ++ show t1 ++ ", " ++ show t2 ++ "\n" printMapBB' is hmap Nothing -> error $ "BlockID " ++ show i ++ " not found." diff --git a/Mate/ClassPool.hs b/Mate/ClassPool.hs index 8b1cb41..0f235c0 100644 --- a/Mate/ClassPool.hs +++ b/Mate/ClassPool.hs @@ -150,16 +150,14 @@ readClass path = do where val = fromIntegral (mmap M.! key) :: NativeWord printfCp $ printf "%s\n" header mapM_ printValue (M.keys mmap) - if mateDEBUG - then do - let strpath = toString path - hexDumpMap ("staticmap @ " ++ strpath) staticmap - hexDumpMap ("fieldmap @ " ++ strpath) fieldmap - hexDumpMap ("methodmap @ " ++ strpath) methodmap - hexDumpMap ("interfacemap @ " ++ strpath) immap - printfCp $ printf "mbase: 0x%08x\n" mbase - printfCp $ printf "iftable: 0x%08x\n" wn_iftable - else return () + when mateDEBUG $ do + let strpath = toString path + hexDumpMap ("staticmap @ " ++ strpath) staticmap + hexDumpMap ("fieldmap @ " ++ strpath) fieldmap + hexDumpMap ("methodmap @ " ++ strpath) methodmap + hexDumpMap ("interfacemap @ " ++ strpath) immap + printfCp $ printf "mbase: 0x%08x\n" mbase + printfCp $ printf "iftable: 0x%08x\n" wn_iftable virtual_map <- getVirtualMap setVirtualMap $ M.insert mbase path virtual_map diff --git a/Mate/Debug.hs b/Mate/Debug.hs index 7acd3cd..1fb65e9 100644 --- a/Mate/Debug.hs +++ b/Mate/Debug.hs @@ -14,6 +14,7 @@ module Mate.Debug import Text.Printf import System.IO import System.IO.Unsafe +import Control.Monad {-# NOINLINE logHandle #-} @@ -27,9 +28,7 @@ mateDEBUG = False {-# INLINE printString #-} printString :: String -> String -> IO () -printString prefix str = if mateDEBUG - then hPutStr logHandle . (++) prefix $ str - else return () +printString prefix str = when mateDEBUG $ hPutStr logHandle . (++) prefix $ str printfJit, printfBb, printfMp, printfCp, printfStr, printfInfo :: String -> IO () diff --git a/Mate/MethodPool.hs b/Mate/MethodPool.hs index e04b709..0b1eae3 100644 --- a/Mate/MethodPool.hs +++ b/Mate/MethodPool.hs @@ -8,6 +8,7 @@ import qualified Data.Map as M import qualified Data.Set as S import qualified Data.ByteString.Lazy as B import System.Plugins +import Control.Monad import Foreign.Ptr import Foreign.C.Types @@ -53,7 +54,7 @@ getMethodEntry mi@(MethodInfo method cm sig) = do if S.member ACC_NATIVE flags then do let scm = toString cm; smethod = toString method - if scm == "jmate/lang/MateRuntime" then do + if scm == "jmate/lang/MateRuntime" then case smethod of "loadLibrary" -> return . funPtrToAddr $ loadLibraryAddr @@ -137,7 +138,7 @@ compileBB rawmethod methodinfo = do cls <- getClassFile (methClassName methodinfo) let ebb = emitFromBB cls rawmethod - let cgconfig = defaultCodeGenConfig { codeBufferSize = fromIntegral $ (rawCodeLength rawmethod) * 32 } + let cgconfig = defaultCodeGenConfig { codeBufferSize = fromIntegral $ rawCodeLength rawmethod * 32 } (_, Right right) <- runCodeGenWithConfig ebb () () cgconfig let ((entry, _, _, new_tmap), _) = right @@ -145,9 +146,7 @@ compileBB rawmethod methodinfo = do printfJit $ printf "generated code of \"%s\" from \"%s\":\n" (toString $ methName methodinfo) (toString $ methClassName methodinfo) printfJit $ printf "\tstacksize: 0x%04x, locals: 0x%04x\n" (rawStackSize rawmethod) (rawLocals rawmethod) - if mateDEBUG - then mapM_ (printfJit . printf "%s\n" . showAtt) (snd right) - else return () + when mateDEBUG $ mapM_ (printfJit . printf "%s\n" . showAtt) (snd right) printfJit $ printf "\n\n" -- UNCOMMENT NEXT LINES FOR GDB FUN -- if (toString $ methName methodinfo) == "thejavamethodIwant2debug" diff --git a/Mate/X86CodeGen.hs b/Mate/X86CodeGen.hs index c42ccad..23cf7a3 100644 --- a/Mate/X86CodeGen.hs +++ b/Mate/X86CodeGen.hs @@ -107,11 +107,9 @@ emitFromBB cls method = do emitInvoke :: Word16 -> Bool -> CodeGen e s (Maybe (Word32, TrapCause)) emitInvoke cpidx hasThis = do let l = buildMethodID cls cpidx - calladdr <- getCurrentOffset newNamedLabel (show l) >>= defineLabel - -- causes SIGILL. in the signal handler we patch it to the acutal call. - -- place two nop's at the end, therefore the disasm doesn't screw up - emit32 (0x9090ffff :: Word32); nop + -- like: call $0x01234567 + calladdr <- emitSigIllTrap 5 let patcher reip = do entryAddr <- liftIO $ getMethodEntry l call (fromIntegral (entryAddr - (reip + 5)) :: NativeWord) @@ -134,15 +132,14 @@ emitFromBB cls method = do let argsLen = genericLength args -- objref lives somewhere on the argument stack mov ebx (Disp (argsLen * ptrSize), esp) - if isInterface - then mov ebx (Disp 0, ebx) -- get method-table-ptr, keep it in ebx - else return () -- invokevirtual + when isInterface $ + mov ebx (Disp 0, ebx) -- get method-table-ptr, keep it in ebx -- get method-table-ptr (or interface-table-ptr) mov eax (Disp 0, ebx) -- make actual (indirect) call calladdr <- getCurrentOffset -- will be patched to this: call (Disp 0xXXXXXXXX, eax) - emit32 (0x9090ffff :: Word32); nop; nop + emitSigIllTrap 6 -- discard arguments on stack (`+1' for "this") let argcnt = ptrSize * (1 + methodGetArgsCount (methodNameTypeByIdx cls cpidx)) when (argcnt > 0) (add esp argcnt) @@ -175,36 +172,33 @@ emitFromBB cls method = do emit' (GETFIELD x) = do pop eax -- this pointer - trapaddr <- getCurrentOffset -- like: 099db064 ff b0 e4 14 00 00 pushl 5348(%eax) - emit32 (0x9090ffff :: Word32); nop; nop + trapaddr <- emitSigIllTrap 6 let patcher reip = do let (cname, fname) = buildFieldOffset cls x offset <- liftIO $ fromIntegral <$> getFieldOffset cname fname - push32_rel_eax (Disp offset) -- get field + push32RelEax (Disp offset) -- get field return reip return $ Just (trapaddr, ObjectField patcher) emit' (PUTFIELD x) = do pop ebx -- value to write pop eax -- this pointer - trapaddr <- getCurrentOffset -- like: 4581fc6b 89 98 30 7b 00 00 movl %ebx,31536(%eax) - emit32 (0x9090ffff :: Word32); nop; nop + trapaddr <- emitSigIllTrap 6 let patcher reip = do let (cname, fname) = buildFieldOffset cls x offset <- liftIO $ fromIntegral <$> getFieldOffset cname fname - mov32_rel_ebx_eax (Disp offset) -- set field + mov32RelEbxEax (Disp offset) -- set field return reip return $ Just (trapaddr, ObjectField patcher) emit' (INSTANCEOF cpidx) = do pop eax - trapaddr <- getCurrentOffset -- place something like `mov edx $mtable_of_objref' instead - emit32 (0x9090ffff :: Word32) + trapaddr <- emitSigIllTrap 4 push (0 :: Word32) let patcher reax reip = do - emit32 (0x9090ffff :: Word32) + emitSigIllTrap 4 let classname = buildClassID cls cpidx check <- liftIO $ isInstanceOf (fromIntegral reax) classname if check @@ -214,9 +208,8 @@ emitFromBB cls method = do return $ Just (trapaddr, InstanceOf patcher) emit' (NEW objidx) = do let objname = buildClassID cls objidx - trapaddr <- getCurrentOffset -- place something like `push $objsize' instead - emit32 (0x9090ffff :: Word32); nop + trapaddr <- emitSigIllTrap 5 callMalloc -- 0x13371337 is just a placeholder; will be replaced with mtable ptr mov (Disp 0, eax) (0x13371337 :: Word32) @@ -372,6 +365,15 @@ emitFromBB cls method = do -- (it didn't work for gnu/classpath/SystemProperties.java) jmp l2 + emitSigIllTrap :: Int -> CodeGen e s NativeWord + emitSigIllTrap traplen = do + trapaddr <- getCurrentOffset + -- 0xffff causes SIGILL + emit8 (0xff :: Word8); emit8 (0xff :: Word8) + -- fill rest up with NOPs + sequence_ [nop | _ <- [1 .. (traplen - 2)]] + return trapaddr + -- for locals we use a different storage cArgs :: Word8 -> Word32 @@ -407,13 +409,13 @@ push32 :: Word32 -> CodeGen e s () push32 imm32 = emit8 0x68 >> emit32 imm32 -- call disp32(%eax) -call32_eax :: Disp -> CodeGen e s () -call32_eax (Disp disp32) = emit8 0xff >> emit8 0x90 >> emit32 disp32 +call32Eax :: Disp -> CodeGen e s () +call32Eax (Disp disp32) = emit8 0xff >> emit8 0x90 >> emit32 disp32 -- push disp32(%eax) -push32_rel_eax :: Disp -> CodeGen e s () -push32_rel_eax (Disp disp32) = emit8 0xff >> emit8 0xb0 >> emit32 disp32 +push32RelEax :: Disp -> CodeGen e s () +push32RelEax (Disp disp32) = emit8 0xff >> emit8 0xb0 >> emit32 disp32 -- mov %ebx, disp32(%eax) -mov32_rel_ebx_eax :: Disp -> CodeGen e s () -mov32_rel_ebx_eax (Disp disp32) = emit8 0x89 >> emit8 0x98 >> emit32 disp32 +mov32RelEbxEax :: Disp -> CodeGen e s () +mov32RelEbxEax (Disp disp32) = emit8 0x89 >> emit8 0x98 >> emit32 disp32 diff --git a/Mate/X86TrapHandling.hs b/Mate/X86TrapHandling.hs index 0df63b8..e8695aa 100644 --- a/Mate/X86TrapHandling.hs +++ b/Mate/X86TrapHandling.hs @@ -7,7 +7,7 @@ module Mate.X86TrapHandling ( import Numeric import qualified Data.Map as M -import qualified Data.ByteString.Lazy as B +import Control.Monad import Foreign import Foreign.C.Types @@ -49,16 +49,14 @@ mateHandler reip reax rebx resi = do patchWithHarpy (patchInvoke mi rebx reax io_offset) reip >>= delFalse Nothing -> case resi of - 0x13371234 -> return (-1) >>= delFalse - _ -> error $ "getTrapType: abort :-( " ++ (showHex reip ". ") - ++ (concatMap (`showHex` ", ") (M.keys tmap)) - if deleteMe - then setTrapMap $ M.delete reipw32 tmap - else return () + 0x13371234 -> delFalse (-1) + _ -> error $ "getTrapType: abort :-( " ++ showHex reip ". " + ++ concatMap (`showHex` ", ") (M.keys tmap) + when deleteMe $ setTrapMap $ M.delete reipw32 tmap return ret_nreip - where - delTrue = (\nreip -> return (True, nreip)) - delFalse = (\nreip -> return (False, nreip)) + where + delTrue x = return (True,x) + delFalse x = return (False,x) patchWithHarpy :: (CPtrdiff -> CodeGen () () CPtrdiff) -> CPtrdiff -> IO CPtrdiff @@ -69,9 +67,7 @@ patchWithHarpy patcher reip = do let entry = Just (intPtrToPtr (fromIntegral reip), fixme) let cgconfig = defaultCodeGenConfig { customCodeBuffer = entry } (_, Right right) <- runCodeGenWithConfig (withDisasm $ patcher reip) () () cgconfig - if mateDEBUG - then mapM_ (printfJit . printf "patched: %s\n" . showAtt) $ snd right - else return () + when mateDEBUG $ mapM_ (printfJit . printf "patched: %s\n" . showAtt) $ snd right return $ fst right withDisasm :: CodeGen e s CPtrdiff -> CodeGen e s (CPtrdiff, [Instruction]) @@ -93,11 +89,11 @@ staticFieldHandler reip = do patchInvoke :: MethodInfo -> CPtrdiff -> CPtrdiff -> IO NativeWord -> CPtrdiff -> CodeGen e s CPtrdiff patchInvoke (MethodInfo methname _ msig) method_table table2patch io_offset reip = do - vmap <- liftIO $ getVirtualMap + vmap <- liftIO getVirtualMap let newmi = MethodInfo methname (vmap M.! fromIntegral method_table) msig offset <- liftIO io_offset entryAddr <- liftIO $ getMethodEntry newmi - call32_eax (Disp offset) + call32Eax (Disp offset) -- patch entry in table let call_insn = intPtrToPtr . fromIntegral $ table2patch + fromIntegral offset liftIO $ poke call_insn entryAddr -- 2.25.1