X-Git-Url: http://wien.tomnetworks.com/gitweb/?a=blobdiff_plain;f=Mate%2FMethodPool.hs;h=d1df9cf1bb27fe95354b4a2a2daa72c7eab8081c;hb=HEAD;hp=5330ade2e6a5b8d1eac3b3878fd08622a9f91a25;hpb=c803146cc80b61305fde8279f0a36f8fe6ef7eb2;p=mate.git diff --git a/Mate/MethodPool.hs b/Mate/MethodPool.hs index 5330ade..d1df9cf 100644 --- a/Mate/MethodPool.hs +++ b/Mate/MethodPool.hs @@ -1,15 +1,15 @@ -{-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ForeignFunctionInterface #-} -#include "debug.h" module Mate.MethodPool where import Data.Binary import Data.String.Utils import qualified Data.Map as M +import qualified Data.Bimap as BI 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 @@ -18,13 +18,7 @@ import Foreign.C.String import JVM.ClassFile import Harpy -#ifdef DBG_JIT import Harpy.X86Disassembler -#endif - -#ifdef DEBUG -import Text.Printf -#endif import Mate.BasicBlocks import Mate.Types @@ -32,56 +26,67 @@ import Mate.NativeMachine import Mate.ClassPool import Mate.Debug import Mate.Utilities +import Mate.Rts() foreign import ccall "dynamic" code_void :: FunPtr (IO ()) -> IO () +foreign import ccall "&printMemoryUsage" + printMemoryUsageAddr :: FunPtr (IO ()) + +foreign import ccall "&loadLibrary" + loadLibraryAddr :: FunPtr (IO ()) + +foreign import ccall "&printGCStats" + printGCStatsAddr :: FunPtr (IO ()) -getMethodEntry :: CPtrdiff -> CPtrdiff -> IO CPtrdiff -getMethodEntry signal_from methodtable = do +getMethodEntry :: MethodInfo -> IO (CPtrdiff, JpcNpcMap) +getMethodEntry mi@(MethodInfo method cm sig) = do mmap <- getMethodMap - tmap <- getTrapMap - vmap <- getVirtualMap - - let w32_from = fromIntegral signal_from - let mi = tmap M.! w32_from - let mi'@(MethodInfo method cm sig) = - case mi of - (StaticMethod x) -> x - (VirtualCall _ (MethodInfo methname _ msig) _) -> newMi methname msig - _ -> error "getMethodEntry: no TrapCause found. abort." - where newMi mn = MethodInfo mn (vmap M.! fromIntegral methodtable) - -- bernhard (TODO): doesn't work with gnu classpath at some point. didn't - -- figured out the problem yet :/ therefore, I have no - -- testcase for replaying the situation. - -- setTrapMap $ M.delete w32_from tmap - entryaddr <- case M.lookup mi' mmap of + + (entryaddr, jnmap) <- case M.lookup mi mmap of Nothing -> do cls <- getClassFile cm - printfMp "getMethodEntry(from 0x%08x): no method \"%s\" found. compile it\n" w32_from (show mi') + printfMp $ printf "getMethodEntry: no method \"%s\" found. compile it\n" (show mi) mm <- lookupMethodRecursive method sig [] cls case mm of Just (mm', clsnames, cls') -> do let flags = methodAccessFlags mm' if S.member ACC_NATIVE flags then do - -- TODO(bernhard): cleaner please... *do'h* - let sym1 = replace "/" "_" $ toString cm - parenth = replace "(" "_" $ replace ")" "_" $ toString $ encode sig - sym2 = replace ";" "_" $ replace "/" "_" parenth - symbol = sym1 ++ "__" ++ toString method ++ "__" ++ sym2 - printfMp "native-call: symbol: %s\n" symbol - nf <- loadNativeFunction symbol - setMethodMap $ M.insert mi' nf mmap - return nf + let scm = toString cm; smethod = toString method + if scm == "jmate/lang/MateRuntime" then + case smethod of + "loadLibrary" -> + return (funPtrToAddr loadLibraryAddr, BI.empty) + "printGCStats" -> + return (funPtrToAddr printGCStatsAddr, BI.empty) + "printMemoryUsage" -> + return (funPtrToAddr printMemoryUsageAddr, BI.empty) + _ -> + error $ "native-call: " ++ smethod ++ " not found." + else do + -- TODO(bernhard): cleaner please... *do'h* + let sym1 = replace "/" "_" scm + parenth = replace "(" "_" $ replace ")" "_" $ toString $ encode sig + sym2 = replace ";" "_" $ replace "/" "_" parenth + symbol = sym1 ++ "__" ++ smethod ++ "__" ++ sym2 + printfMp $ printf "native-call: symbol: %s\n" symbol + nf <- loadNativeFunction symbol + let nf' = (nf, BI.empty) + setMethodMap $ M.insert mi nf' mmap + return nf' else do rawmethod <- parseMethod cls' method sig - entry <- compileBB rawmethod (MethodInfo method (thisClass cls') sig) - addMethodRef entry mi' clsnames - return $ fromIntegral entry + entry <- compileBB mi rawmethod (MethodInfo method (thisClass cls') sig) + addMethodRef entry mi clsnames + return entry Nothing -> error $ show method ++ " not found. abort" Just w32 -> return w32 - return $ fromIntegral entryaddr + return (fromIntegral entryaddr, jnmap) + +funPtrToAddr :: Num b => FunPtr a -> b +funPtrToAddr = fromIntegral . ptrToIntPtr . castFunPtrToPtr lookupMethodRecursive :: B.ByteString -> MethodSignature -> [B.ByteString] -> Class Direct -> IO (Maybe (Method Direct, [B.ByteString], Class Direct)) @@ -122,31 +127,30 @@ loadNativeFunction sym = do -- mmap2ptr mmap >>= set_mmap -- demo_mmap -- access Data.Map from C -addMethodRef :: NativeWord -> MethodInfo -> [B.ByteString] -> IO () +addMethodRef :: (NativeWord, JpcNpcMap) -> MethodInfo -> [B.ByteString] -> IO () addMethodRef entry (MethodInfo mmname _ msig) clsnames = do mmap <- getMethodMap let newmap = foldr (\i -> M.insert (MethodInfo mmname i msig) entry) M.empty clsnames setMethodMap $ mmap `M.union` newmap -compileBB :: RawMethod -> MethodInfo -> IO NativeWord -compileBB rawmethod methodinfo = do +compileBB :: MethodInfo -> RawMethod -> MethodInfo -> IO (NativeWord, JpcNpcMap) +compileBB mi rawmethod methodinfo = do tmap <- getTrapMap cls <- getClassFile (methClassName methodinfo) - let ebb = emitFromBB cls rawmethod - let cgconfig = defaultCodeGenConfig { codeBufferSize = fromIntegral $ (rawCodeLength rawmethod) * 32 } - (_, Right right) <- runCodeGenWithConfig ebb () () cgconfig + printfJit $ printf "emit code of \"%s\" from \"%s\":\n" (toString $ methName methodinfo) (toString $ methClassName methodinfo) + let ebb = emitFromBB cls mi rawmethod + let cgconfig = defaultCodeGenConfig { codeBufferSize = fromIntegral $ rawCodeLength rawmethod * 32 } + (jnmap, Right right) <- runCodeGenWithConfig ebb () BI.empty cgconfig - let ((entry, _, _, new_tmap), _) = right + let ((entry, _, new_tmap), _) = right setTrapMap $ tmap `M.union` new_tmap -- prefers elements in tmap - printfJit "generated code of \"%s\" from \"%s\":\n" (toString $ methName methodinfo) (toString $ methClassName methodinfo) - printfJit "\tstacksize: 0x%04x, locals: 0x%04x\n" (rawStackSize rawmethod) (rawLocals rawmethod) -#ifdef DBG_JIT - mapM_ (printfJit "%s\n" . showAtt) (snd right) -#endif - printfJit "\n\n" + 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) + when mateDEBUG $ mapM_ (printfJit . printf "%s\n" . showIntel) (snd right) + printfJit $ printf "\n\n" -- UNCOMMENT NEXT LINES FOR GDB FUN -- if (toString $ methName methodinfo) == "thejavamethodIwant2debug" -- then putStrLn "press CTRL+C now for setting a breakpoint. then `c' and ENTER for continue" >> getLine @@ -156,7 +160,7 @@ compileBB rawmethod methodinfo = do -- (2) on getLine, press CTRL+C -- (3) `br *0x'; obtain the address from the disasm above -- (4) `cont' and press enter - return $ fromIntegral $ ptrToIntPtr entry + return (fromIntegral $ ptrToIntPtr entry, jnmap) executeFuncPtr :: NativeWord -> IO ()