type BBStarts = M.Map BlockID Int
-type CompileInfo = (EntryPoint, BBStarts, Int, TrapMap)
+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
push ebp
mov ebp esp
sub esp (fromIntegral (rawLocals method) * ptrSize :: Word32)
-
- (calls, bbstarts) <- efBB (0, hmap M.! 0) M.empty M.empty lmap
+ calls <- M.fromList . catMaybes . concat <$> mapM (efBB lmap) keys
d <- disassemble
end <- getCodeOffset
- return ((ep, bbstarts, end, calls), d)
+ return ((ep, end, calls), d)
where
hmap = rawMapBB method
getLabel :: BlockID -> [(BlockID, Label)] -> Label
- getLabel _ [] = error "label not found!"
+ getLabel bid [] = error $ "label " ++ show bid ++ " not found"
getLabel i ((x,l):xs) = if i==x then l else getLabel i xs
- efBB :: (BlockID, BasicBlock) -> TrapMap -> BBStarts -> [(BlockID, Label)] -> CodeGen e s (TrapMap, BBStarts)
- efBB (bid, bb) calls bbstarts lmap =
- if M.member bid bbstarts then
- return (calls, bbstarts)
- else do
- bb_offset <- getCodeOffset
- let bbstarts' = M.insert bid bb_offset bbstarts
- defineLabel $ getLabel bid lmap
- cs <- mapM emit'' $ code bb
- let calls' = calls `M.union` M.fromList (catMaybes cs)
- case successor bb of
- Return -> return (calls', bbstarts')
+ efBB :: [(BlockID, Label)] -> BlockID -> CodeGen e JpcNpcMap [(Maybe (Word32, TrapCause))]
+ efBB lmap bid = do
+ defineLabel $ getLabel bid lmap
+ 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)
- efBB (t, hmap M.! t) calls' bbstarts' lmap
- OneTarget t -> efBB (t, hmap M.! t) calls' bbstarts' lmap
- TwoTarget t1 t2 -> do
- (calls'', bbstarts'') <- efBB (t1, hmap M.! t1) calls' bbstarts' lmap
- efBB (t2, hmap M.! t2) calls'' bbstarts'' lmap
- -- TODO(bernhard): also use metainformation
- -- TODO(bernhard): implement `emit' as function which accepts a list of
- -- instructions, so we can use patterns for optimizations
+ _ -> return ()
+ return retval
where
+ bb = hmap M.! bid
+
forceRegDump :: CodeGen e s ()
forceRegDump = do
push esi
getCurrentOffset :: CodeGen e s Word32
getCurrentOffset = do
- ep <- getEntryPoint
- let w32_ep = (fromIntegral $ ptrToIntPtr ep) :: Word32
- offset <- getCodeOffset
- return $ w32_ep + fromIntegral offset
+ ep <- (fromIntegral . ptrToIntPtr) <$> getEntryPoint
+ offset <- fromIntegral <$> getCodeOffset
+ return $ ep + offset
emitInvoke :: Word16 -> Bool -> CodeGen e s (Maybe (Word32, TrapCause))
emitInvoke cpidx hasThis = do
-- 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
emit' ATHROW = do
trapaddr <- emitSigIllTrap 2
let patcher resp reip = do
+ error "no athrow for you, sorry"
emitSigIllTrap 2
return reip
return $ Just (trapaddr, ThrowException patcher)