#include "debug.h"
module Mate.BasicBlocks(
BlockID,
- BasicBlock (..),
- BBEnd (..),
+ BasicBlock,
+ BBEnd,
MapBB,
+ Method,
#ifdef DBG_BB
printMapBB,
#endif
#ifdef DBG_BB
-printMapBB :: Maybe MapBB -> IO ()
-printMapBB Nothing = putStrLn "No BasicBlock"
-printMapBB (Just hmap) = do
+printMapBB :: MapBB -> IO ()
+printMapBB hmap = do
putStr "BlockIDs: "
let keys = M.keys hmap
mapM_ (putStr . (flip (++)) ", " . show) keys
#endif
-parseMethod :: Class Direct -> B.ByteString -> MethodSignature -> IO (Maybe MapBB)
+parseMethod :: Class Direct -> B.ByteString -> MethodSignature -> IO (Maybe RawMethod)
parseMethod cls method sig = do
let maybe_bb = testCFG $ lookupMethodSig method sig cls
let msig = methodSignature $ classMethods cls !! 1
printfBb "BB: analysing \"%s\"\n" $ toString (method `B.append` ": " `B.append` encode msig)
#ifdef DBG_BB
- printMapBB maybe_bb
+ case maybe_bb of
+ Just m -> printMapBB $ rawMapBB m
+ Nothing -> return ()
#endif
-- small example how to get information about
-- exceptions of a method
let (Just m) = lookupMethodSig method sig cls
case attrByName m "Code" of
Nothing -> printfBb "exception: no handler for this method\n"
- Just exceptionstream -> printfBb "exception: \"%s\"\n" (show $ codeExceptions $ decodeMethod exceptionstream)
+ Just exceptionstream -> do
+ printfBb "exception: \"%s\"\n" (show $ codeExceptions $ decodeMethod exceptionstream)
return maybe_bb
-testCFG :: Maybe (Method Direct) -> Maybe MapBB
+testCFG :: Maybe (Method Direct) -> Maybe RawMethod
testCFG m = do
m' <- m
- bytecode <- attrByName m' "Code"
- return $ buildCFG $ codeInstructions $ decodeMethod bytecode
+ codeseg <- attrByName m' "Code"
+ let decoded = decodeMethod codeseg
+ let mapbb = buildCFG $ codeInstructions decoded
+ let locals = fromIntegral (codeMaxLocals decoded)
+ let stacks = fromIntegral (codeStackSize decoded)
+ return $ RawMethod mapbb locals stacks
buildCFG :: [Instruction] -> MapBB
-- execute class initializer
case lookupMethod "<clinit>" (ciFile ci) of
Just m -> do
- hmap <- parseMethod (ciFile ci) "<clinit>" $ MethodSignature [] ReturnsVoid
- case hmap of
- Just hmap' -> do
+ method <- parseMethod (ciFile ci) "<clinit>" $ MethodSignature [] ReturnsVoid
+ case method of
+ Just rawmethod -> do
let mi = MethodInfo "<clinit>" path (methodSignature m)
- entry <- compileBB hmap' mi
+ entry <- compileBB rawmethod mi
addMethodRef entry mi [path]
printfCp "executing static initializer from %s now\n" (toString path)
executeFuncPtr entry
setMethodMap $ mmap `M.union` newmap
-compileBB :: MapBB -> MethodInfo -> IO Word32
-compileBB hmap methodinfo = do
+compileBB :: RawMethod -> MethodInfo -> IO Word32
+compileBB rawmethod methodinfo = do
tmap <- getTrapMap
cls <- getClassFile (methClassName methodinfo)
- let ebb = emitFromBB (methName methodinfo) (methSignature methodinfo) cls hmap
+ let ebb = emitFromBB (methName methodinfo) (methSignature methodinfo) cls rawmethod
(_, Right right) <- runCodeGen ebb () ()
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)
mapM_ (printfJit "%s\n" . showAtt) (snd right)
printfJit "\n\n"
-- UNCOMMENT NEXT LINES FOR GDB FUN
addMethodRef :: Word32 -> MethodInfo -> [B.ByteString] -> IO ()
-compileBB :: MapBB -> MethodInfo -> IO Word32
+compileBB :: RawMethod -> MethodInfo -> IO Word32
executeFuncPtr :: Word32 -> IO ()
type MapBB = M.Map BlockID BasicBlock
+data RawMethod = RawMethod {
+ rawMapBB :: MapBB,
+ rawLocals :: Int,
+ rawStackSize :: Int }
-- Word32 = point of method call in generated code
type CompileInfo = (EntryPoint, BBStarts, Int, TrapMap)
-emitFromBB :: B.ByteString -> MethodSignature -> Class Direct -> MapBB -> CodeGen e s (CompileInfo, [Instruction])
-emitFromBB method sig cls hmap = do
+emitFromBB :: B.ByteString -> MethodSignature -> Class Direct -> RawMethod -> CodeGen e s (CompileInfo, [Instruction])
+emitFromBB methodname sig cls method = do
let keys = M.keys hmap
llmap <- mapM (newNamedLabel . (++) "bb_" . show) keys
let lmap = zip keys llmap
ep <- getEntryPoint
push ebp
mov ebp esp
- -- TODO(bernhard): determine a reasonable value.
- -- e.g. (locals used) * 4
- sub esp (0x60 :: Word32)
+ sub esp (fromIntegral ((rawLocals method) * 4) :: Word32)
(calls, bbstarts) <- efBB (0, hmap M.! 0) M.empty M.empty lmap
d <- disassemble
end <- getCodeOffset
return ((ep, bbstarts, end, calls), d)
where
+ hmap = rawMapBB method
+
getLabel :: BlockID -> [(BlockID, Label)] -> Label
getLabel _ [] = error "label not found!"
getLabel i ((x,l):xs) = if i==x then l else getLabel i xs
cArgs_ :: IMM -> Word8
cArgs_ x = case x of I0 -> 0; I1 -> 1; I2 -> 2; I3 -> 3
+ -- TODO: factor this out to `compileBB'
thisMethodArgCnt :: Word32
thisMethodArgCnt = isNonStatic + fromIntegral (length args)
where
- m = fromJust $ lookupMethodSig method sig cls
+ m = fromJust $ lookupMethodSig methodname sig cls
(MethodSignature args _) = sig
isNonStatic = if S.member ACC_STATIC (methodAccessFlags m)
then 0 else 1 -- one argument for the this pointer