entry <- compileBB rawmethod mi
addMethodRef entry mi [bclspath]
printfInfo "executing `main' now:\n"
- executeFuncPtr entry
+ executeFuncPtr $ fst entry
Nothing -> error "main not found"
entry <- compileBB rawmethod mi
addMethodRef entry mi [path]
printfCp $ printf "executing static initializer from %s now\n" (toString path)
- executeFuncPtr entry
+ executeFuncPtr $ fst entry
printfCp $ printf "static initializer from %s done\n" (toString path)
Nothing -> return ()
foreign import ccall "&printGCStats"
printGCStatsAddr :: FunPtr (IO ())
-getMethodEntry :: MethodInfo -> IO CPtrdiff
+getMethodEntry :: MethodInfo -> IO (CPtrdiff, JpcNpcMap)
getMethodEntry mi@(MethodInfo method cm sig) = do
mmap <- getMethodMap
- entryaddr <- case M.lookup mi mmap of
+ (entryaddr, jnmap) <- case M.lookup mi mmap of
Nothing -> do
cls <- getClassFile cm
printfMp $ printf "getMethodEntry: no method \"%s\" found. compile it\n" (show mi)
if scm == "jmate/lang/MateRuntime" then
case smethod of
"loadLibrary" ->
- return . funPtrToAddr $ loadLibraryAddr
+ return (funPtrToAddr loadLibraryAddr, M.empty)
"printGCStats" ->
- return . funPtrToAddr $ printGCStatsAddr
+ return (funPtrToAddr printGCStatsAddr, M.empty)
"printMemoryUsage" ->
- return . funPtrToAddr $ printMemoryUsageAddr
+ return (funPtrToAddr printMemoryUsageAddr, M.empty)
_ ->
error $ "native-call: " ++ smethod ++ " not found."
else do
symbol = sym1 ++ "__" ++ smethod ++ "__" ++ sym2
printfMp $ printf "native-call: symbol: %s\n" symbol
nf <- loadNativeFunction symbol
- setMethodMap $ M.insert mi nf mmap
- return nf
+ let nf' = (nf, M.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
+ 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
-- 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 -> IO (NativeWord, JpcNpcMap)
compileBB rawmethod methodinfo = do
tmap <- getTrapMap
printfJit $ printf "emit code of \"%s\" from \"%s\":\n" (toString $ methName methodinfo) (toString $ methClassName methodinfo)
let ebb = emitFromBB cls rawmethod
let cgconfig = defaultCodeGenConfig { codeBufferSize = fromIntegral $ rawCodeLength rawmethod * 32 }
- (_, Right right) <- runCodeGenWithConfig ebb () () cgconfig
+ (jnmap, Right right) <- runCodeGenWithConfig ebb () M.empty cgconfig
let ((entry, _, new_tmap), _) = right
setTrapMap $ tmap `M.union` new_tmap -- prefers elements in tmap
-- (2) on getLine, press CTRL+C
-- (3) `br *0x<addr>'; obtain the address from the disasm above
-- (4) `cont' and press enter
- return $ fromIntegral $ ptrToIntPtr entry
+ return (fromIntegral $ ptrToIntPtr entry, jnmap)
executeFuncPtr :: NativeWord -> IO ()
import Foreign.C.Types
-addMethodRef :: NativeWord -> MethodInfo -> [B.ByteString] -> IO ()
-compileBB :: RawMethod -> MethodInfo -> IO NativeWord
+addMethodRef :: (NativeWord, JpcNpcMap) -> MethodInfo -> [B.ByteString] -> IO ()
+compileBB :: RawMethod -> MethodInfo -> IO (NativeWord, JpcNpcMap)
executeFuncPtr :: NativeWord -> IO ()
-getMethodEntry :: MethodInfo -> IO CPtrdiff
+getMethodEntry :: MethodInfo -> IO (CPtrdiff, JpcNpcMap)
, BBEnd(..)
, MapBB
, ExceptionMap
+ , JpcNpcMap
, RawMethod(..)
, TrapMap, MethodMap, ClassMap, FieldMap
, StringMap, VirtualMap, InterfaceMap
type MapBB = M.Map BlockID BasicBlock
type ExceptionMap = M.Map (Word16, Word16) [(B.ByteString, Word16)]
+-- java byte code PC -> native PC
+type JpcNpcMap = M.Map Word32 Int
+
data RawMethod = RawMethod {
rawMapBB :: MapBB,
rawExcpMap :: ExceptionMap,
-- B.ByteString = name of method
-- NativeWord = entrypoint of method
-type MethodMap = M.Map MethodInfo NativeWord
+type MethodMap = M.Map MethodInfo (NativeWord, JpcNpcMap)
data MethodInfo = MethodInfo {
methName :: B.ByteString,
type CompileInfo = (EntryPoint, Int, TrapMap)
-emitFromBB :: Class Direct -> RawMethod -> CodeGen e s (CompileInfo, [Instruction])
+emitFromBB :: Class Direct -> RawMethod -> CodeGen e JpcNpcMap (CompileInfo, [Instruction])
emitFromBB cls method = do
let keys = M.keys hmap
llmap <- mapM (newNamedLabel . (++) "bb_" . show) keys
getLabel bid [] = error $ "label " ++ show bid ++ " not found"
getLabel i ((x,l):xs) = if i==x then l else getLabel i xs
- efBB :: [(BlockID, Label)] -> BlockID -> CodeGen e s [(Maybe (Word32, TrapCause))]
+ efBB :: [(BlockID, Label)] -> BlockID -> CodeGen e JpcNpcMap [(Maybe (Word32, TrapCause))]
efBB lmap bid = do
defineLabel $ getLabel bid lmap
- ret <- mapM emit'' $ code bb
+ retval <- mapM emit'' $ code bb
case successor bb of
FallThrough t -> do
-- TODO(bernhard): le dirty hax. see java/lang/Integer.toString(int, int)
jmp (getLabel t lmap)
_ -> return ()
- return ret
+ return retval
where
bb = hmap M.! bid
-- like: call $0x01234567
calladdr <- emitSigIllTrap 5
let patcher reip = do
- entryAddr <- liftIO $ getMethodEntry l
+ (entryAddr, _) <- liftIO $ getMethodEntry l
call (fromIntegral (entryAddr - (reip + 5)) :: NativeWord)
return reip
-- discard arguments on stack
-- depending on the method-table-ptr
return $ Just (calladdr, VirtualCall isInterface mi offset)
- emit'' :: J.Instruction -> CodeGen e s (Maybe (Word32, TrapCause))
- emit'' insn = newNamedLabel ("jvm_insn: " ++ show insn) >>= defineLabel >> emit' insn
+ emit'' :: J.Instruction -> CodeGen e JpcNpcMap (Maybe (Word32, TrapCause))
+ emit'' insn = do
+ ep <- (fromIntegral . ptrToIntPtr) <$> getEntryPoint
+ jpcrpc <- getState
+ setState (M.insert ep bid jpcrpc)
+ newNamedLabel ("jvm_insn: " ++ show insn) >>= defineLabel >> emit' insn
emit' :: J.Instruction -> CodeGen e s (Maybe (Word32, TrapCause))
emit' (INVOKESPECIAL cpidx) = emitInvoke cpidx True
vmap <- liftIO getVirtualMap
let newmi = MethodInfo methname (vmap M.! fromIntegral method_table) msig
offset <- liftIO io_offset
- entryAddr <- liftIO $ getMethodEntry newmi
+ (entryAddr, _) <- liftIO $ getMethodEntry newmi
call32Eax (Disp offset)
-- patch entry in table
let call_insn = intPtrToPtr . fromIntegral $ table2patch + fromIntegral offset