maxlocals: store it in new data type RawMethod, with MapBB & Co

we need that information, in order to reserve enough memory on the stack (was
hardcoded so far)

diff --git a/Mate/BasicBlocks.hs b/Mate/BasicBlocks.hs
index fbb61f7a06ecf6a471d5b33385953f58228ee19b..2a8ac22513df29f49bd56b55f912a1ee1a6425e6 100644 (file)
--- a/Mate/BasicBlocks.hs
+++ b/Mate/BasicBlocks.hs
@@ -3,9 +3,10 @@
 #include "debug.h"
 module Mate.BasicBlocks(
   BlockID,
 #include "debug.h"
 module Mate.BasicBlocks(
   BlockID,

-  BasicBlock (..),
-  BBEnd (..),
+  BasicBlock,
+  BBEnd,

   MapBB,
   MapBB,

+  Method,

 #ifdef DBG_BB
   printMapBB,
 #endif
 #ifdef DBG_BB
   printMapBB,
 #endif


@@ -37,9 +38,8 @@ type OffIns = (Offset, Instruction)
 
 
 #ifdef DBG_BB
 
 
 #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
                      putStr "BlockIDs: "
                      let keys = M.keys hmap
                      mapM_ (putStr . (flip (++)) ", " . show) keys


@@ -87,13 +87,15 @@ test_04 = testInstance "./tests/Fac.class" "fac"
 #endif
 
 
 #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
 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
 #endif
                      -- small example how to get information about
                      -- exceptions of a method


@@ -101,15 +103,20 @@ parseMethod cls method sig = do
                      let (Just m) = lookupMethodSig method sig cls
                      case attrByName m "Code" of
                       Nothing -> printfBb "exception: no handler for this method\n"
                      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
 
 
                      return maybe_bb
 
 

-testCFG :: Maybe (Method Direct) -> Maybe MapBB
+testCFG :: Maybe (Method Direct) -> Maybe RawMethod

 testCFG m = do
   m' <- m
 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
 
 
 buildCFG :: [Instruction] -> MapBB

diff --git a/Mate/ClassPool.hs b/Mate/ClassPool.hs
index 8788e75ab9261caa320d425cdd55d2a31a00d66e..ae6ce4450def203be66630d80ec23e7aa3b07aff 100644 (file)
--- a/Mate/ClassPool.hs
+++ b/Mate/ClassPool.hs
@@ -254,11 +254,11 @@ loadAndInitClass path = do
   -- execute class initializer
   case lookupMethod "<clinit>" (ciFile ci) of
     Just m -> do
   -- 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)
           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
           addMethodRef entry mi [path]
           printfCp "executing static initializer from %s now\n" (toString path)
           executeFuncPtr entry

diff --git a/Mate/MethodPool.hs b/Mate/MethodPool.hs
index 7f0779c2627e1b905c0bf159b626a553f6e2424a..508ff117c6365961b3a7ffb3f4f42fc8b0569be4 100644 (file)
--- a/Mate/MethodPool.hs
+++ b/Mate/MethodPool.hs
@@ -131,18 +131,19 @@ addMethodRef entry (MethodInfo mmname _ msig) clsnames = do
   setMethodMap $ mmap `M.union` newmap
 
 
   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)
   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)
   (_, 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
   mapM_ (printfJit "%s\n" . showAtt) (snd right)
   printfJit "\n\n"
   -- UNCOMMENT NEXT LINES FOR GDB FUN

diff --git a/Mate/MethodPool.hs-boot b/Mate/MethodPool.hs-boot
index f17cfb48c0214af01953a2adb10f5bc1ce906094..9392619e199851dc432e106fd5e60d64a4a329a9 100644 (file)
--- a/Mate/MethodPool.hs-boot
+++ b/Mate/MethodPool.hs-boot
@@ -9,5 +9,5 @@ import Mate.Types
 
 
 addMethodRef :: Word32 -> MethodInfo -> [B.ByteString] -> IO ()
 
 
 addMethodRef :: Word32 -> MethodInfo -> [B.ByteString] -> IO ()

-compileBB :: MapBB -> MethodInfo -> IO Word32
+compileBB :: RawMethod -> MethodInfo -> IO Word32

 executeFuncPtr :: Word32 -> IO ()
 executeFuncPtr :: Word32 -> IO ()

diff --git a/Mate/Types.hs b/Mate/Types.hs
index dbf7e73806cc3fe0a3fd1d7531474732f3475ba6..1978bb38fe3d8564b4ce87d2868015916239eaad 100644 (file)
--- a/Mate/Types.hs
+++ b/Mate/Types.hs
@@ -25,6 +25,10 @@ data BBEnd = Return | FallThrough BlockID | OneTarget BlockID | TwoTarget BlockI
 
 type MapBB = M.Map BlockID BasicBlock
 
 
 type MapBB = M.Map BlockID BasicBlock
 

+data RawMethod = RawMethod {
+  rawMapBB :: MapBB,
+  rawLocals :: Int,
+  rawStackSize :: Int }

 
 
 -- Word32 = point of method call in generated code
 
 
 -- Word32 = point of method call in generated code

diff --git a/Mate/X86CodeGen.hs b/Mate/X86CodeGen.hs
index 8b3c39f49d94b14c3953e6641c673b8a418fbcd4..c2c336fab736e33ec8cd6cf3b163cb5d169fe186 100644 (file)
--- a/Mate/X86CodeGen.hs
+++ b/Mate/X86CodeGen.hs
@@ -46,23 +46,23 @@ type BBStarts = M.Map BlockID Int
 type CompileInfo = (EntryPoint, BBStarts, Int, TrapMap)
 
 
 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
         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
 
         (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
   getLabel :: BlockID -> [(BlockID, Label)] -> Label
   getLabel _ [] = error "label not found!"
   getLabel i ((x,l):xs) = if i==x then l else getLabel i xs


@@ -358,10 +358,11 @@ emitFromBB method sig cls hmap =  do
   cArgs_ :: IMM -> Word8
   cArgs_ x = case x of I0 -> 0; I1 -> 1; I2 -> 2; I3 -> 3
 
   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
   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
     (MethodSignature args _) = sig
     isNonStatic = if S.member ACC_STATIC (methodAccessFlags m)
         then 0 else 1 -- one argument for the this pointer