X-Git-Url: http://wien.tomnetworks.com/gitweb/?a=blobdiff_plain;f=Mate%2FMethodPool.hs;h=5a0f70e73605fa0e256cfcea9b925cbddd2d1520;hb=120517704ac01a6d957b1904d63ab707a0c4ee95;hp=f0465d6e7e584e0682f738ceeb9790e801f59bb3;hpb=33fee81a6dc52f54beda6819c95e7e4571613ea6;p=mate.git diff --git a/Mate/MethodPool.hs b/Mate/MethodPool.hs index f0465d6..5a0f70e 100644 --- a/Mate/MethodPool.hs +++ b/Mate/MethodPool.hs @@ -18,7 +18,9 @@ import Foreign.C.String import JVM.ClassFile import Harpy +#ifdef DBG_JIT import Harpy.X86Disassembler +#endif #ifdef DEBUG import Text.Printf @@ -102,7 +104,7 @@ lookupMethodRecursive name sig clsnames cls = foreign import ccall safe "lookupSymbol" c_lookupSymbol :: CString -> IO (Ptr a) -loadNativeFunction :: String -> IO Word32 +loadNativeFunction :: String -> IO NativeWord loadNativeFunction sym = do _ <- loadRawObject "ffi/native.o" -- TODO(bernhard): WTF @@ -115,33 +117,36 @@ loadNativeFunction sym = do -- t_01 :: IO () -- t_01 = do -- (entry, _) <- testCase "./tests/Fib.class" "fib" --- let int_entry = ((fromIntegral $ ptrToIntPtr entry) :: Word32) +-- let int_entry = ((fromIntegral $ ptrToIntPtr entry) :: NativeWord) -- let mmap = M.insert ("fib" :: String) int_entry M.empty -- mapM_ (\(x,y) -> printf "%s at 0x%08x\n" x y) $ M.toList mmap -- mmap2ptr mmap >>= set_mmap -- demo_mmap -- access Data.Map from C -addMethodRef :: Word32 -> MethodInfo -> [B.ByteString] -> IO () +addMethodRef :: NativeWord -> 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 Word32 +compileBB :: RawMethod -> MethodInfo -> IO NativeWord compileBB rawmethod methodinfo = do tmap <- getTrapMap cls <- getClassFile (methClassName methodinfo) let ebb = emitFromBB cls rawmethod - (_, Right right) <- runCodeGen ebb () () + let cgconfig = defaultCodeGenConfig { codeBufferSize = fromIntegral $ (rawCodeLength rawmethod) * 32 } + (_, Right right) <- runCodeGenWithConfig ebb () () cgconfig 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" -- UNCOMMENT NEXT LINES FOR GDB FUN -- if (toString $ methName methodinfo) == "thejavamethodIwant2debug" @@ -155,6 +160,6 @@ compileBB rawmethod methodinfo = do return $ fromIntegral $ ptrToIntPtr entry -executeFuncPtr :: Word32 -> IO () +executeFuncPtr :: NativeWord -> IO () executeFuncPtr entry = code_void ((castPtrToFunPtr $ intPtrToPtr $ fromIntegral entry) :: FunPtr (IO ()))