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

[mate.git] / Mate / ClassPool.hs

diff --git a/Mate/ClassPool.hs b/Mate/ClassPool.hs
index 816c73b98ef4b7b5e1e9922838dae4776d3e915f..ae6ce4450def203be66630d80ec23e7aa3b07aff 100644 (file)
--- a/Mate/ClassPool.hs
+++ b/Mate/ClassPool.hs
@@ -1,6 +1,5 @@
 {-# LANGUAGE CPP #-}
 {-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE ForeignFunctionInterface #-}
 #include "debug.h"
 module Mate.ClassPool (
   getClassInfo,
@@ -20,6 +19,7 @@ import Data.Word
 import Data.Binary
 import qualified Data.Map as M
 import qualified Data.Set as S
+import Data.List
 import qualified Data.ByteString.Lazy as B
 import Data.String.Utils
 import Control.Monad
@@ -97,9 +97,10 @@ getStaticFieldAddr from = do
   trapmap <- getTrapMap
   let w32_from = fromIntegral from
   let sfi = trapmap M.! w32_from
+  setTrapMap $ M.delete w32_from trapmap
   case sfi of
-    (SFI (StaticFieldInfo cls field)) -> getStaticFieldOffset cls field
-    _ -> error "getFieldAddr: no trapInfo. abort"
+    (StaticField (StaticFieldInfo cls field)) -> getStaticFieldOffset cls field
+    _ -> error "getFieldAddr: no TrapCause found. abort"
 
 -- interface + method + signature plz!
 getInterfaceMethodOffset :: B.ByteString -> B.ByteString -> B.ByteString -> IO Word32
@@ -197,25 +198,25 @@ calculateFields :: Class Direct -> Maybe ClassInfo -> IO (FieldMap, FieldMap)
 calculateFields cf superclass = do
     -- TODO(bernhard): correct sizes. int only atm
 
-    let (sfields, ifields) = span (S.member ACC_STATIC . fieldAccessFlags) (classFields cf)
+    let (sfields, ifields) = partition (S.member ACC_STATIC . fieldAccessFlags) (classFields cf)
 
-    staticbase <- mallocClassData $ fromIntegral (length sfields) * 4
-    let i_sb = fromIntegral $ ptrToIntPtr staticbase
-    let sm = zipbase i_sb sfields
     let sc_sm = getsupermap superclass ciStaticMap
+    staticbase <- mallocClassData $ fromIntegral (length sfields) * 4
+    let sm = zipbase (fromIntegral $ ptrToIntPtr staticbase) sfields
     -- new fields "overwrite" old ones, if they have the same name
-    let staticmap = M.fromList sm `M.union` sc_sm
+    let staticmap = sm `M.union` sc_sm
 
     let sc_im = getsupermap superclass ciFieldMap
     -- "+ 4" for the method table pointer
     let max_off = (4+) $ fromIntegral $ M.size sc_im * 4
     let im = zipbase max_off ifields
     -- new fields "overwrite" old ones, if they have the same name
-    let fieldmap = M.fromList im `M.union` sc_im
+    let fieldmap = im `M.union` sc_im
 
     return (staticmap, fieldmap)
   where
-  zipbase base = zipWith (\x y -> (fieldName y, x + base)) [0,4..]
+  zipbase :: Int32 -> [Field Direct] -> FieldMap
+  zipbase base = foldr (\(x,y) -> M.insert (fieldName y) (x + base)) M.empty . zip [0,4..]
 
 -- helper
 getsupermap :: Maybe ClassInfo -> (ClassInfo -> FieldMap) -> FieldMap
@@ -253,11 +254,11 @@ loadAndInitClass path = do
   -- execute class initializer
   case lookupMethod "<clinit>" (ciFile ci) of
     Just m -> do
-      hmap <- parseMethod (ciFile ci) "<clinit>"
-      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
@@ -276,15 +277,15 @@ readClassFile path' = readIORef classPaths >>= rcf
   where
   path = replace "." "/" path'
   rcf :: [MClassPath] -> IO (Class Direct)
-  rcf [] = error $ "readClassFile: Class \"" ++ (show path) ++ "\" not found."
-  rcf ((Directory pre):xs) = do
+  rcf [] = error $ "readClassFile: Class \"" ++ show path ++ "\" not found."
+  rcf (Directory pre:xs) = do
     let cf = pre ++ path ++ ".class"
     printfCp "rcf: searching @ %s for %s\n" (show pre) (show path)
     b <- doesFileExist cf
     if b
       then parseClassFile cf
       else rcf xs
-  rcf ((JAR p):xs) = do
+  rcf (JAR p:xs) = do
     printfCp "rcf: searching %s in JAR\n" (show path)
     entry <- getEntry p path
     case entry of