codegen: handle exceptions of a method

[mate.git] / Mate / ClassPool.hs

diff --git a/Mate/ClassPool.hs b/Mate/ClassPool.hs
index c99478a17e0930a7c3bab71c6f70cf986d1739b6..245b1a4d13aa0c22b8a81d1dd69b8638931cf64f 100644 (file)
--- a/Mate/ClassPool.hs
+++ b/Mate/ClassPool.hs
@@ -43,6 +43,7 @@ import Mate.Types
 import Mate.Debug
 import Mate.GarbageAlloc
 import Mate.NativeSizes
+import {-# SOURCE #-} Mate.ClassHierarchy
 
 getClassInfo :: B.ByteString -> IO ClassInfo
 getClassInfo path = do
@@ -149,22 +150,27 @@ readClass path = do
                   where val = fromIntegral (mmap M.! key) :: NativeWord
             printfCp $ printf "%s\n" header
             mapM_ printValue (M.keys mmap)
-      if mateDEBUG
-        then do
-          let strpath = toString path
-          hexDumpMap ("staticmap @ " ++ strpath) staticmap
-          hexDumpMap ("fieldmap @ " ++ strpath) fieldmap
-          hexDumpMap ("methodmap @ " ++ strpath) methodmap
-          hexDumpMap ("interfacemap @ " ++ strpath) immap
-          printfCp $ printf "mbase:   0x%08x\n" mbase
-          printfCp $ printf "iftable: 0x%08x\n" wn_iftable
-        else return ()
+      when mateDEBUG $ do
+        let strpath = toString path
+        hexDumpMap ("staticmap @ " ++ strpath) staticmap
+        hexDumpMap ("fieldmap @ " ++ strpath) fieldmap
+        hexDumpMap ("methodmap @ " ++ strpath) methodmap
+        hexDumpMap ("interfacemap @ " ++ strpath) immap
+        printfCp $ printf "mbase:   0x%08x\n" mbase
+        printfCp $ printf "iftable: 0x%08x\n" wn_iftable
       virtual_map <- getVirtualMap
       setVirtualMap $ M.insert mbase path virtual_map
 
       class_map <- getClassMap
       let new_ci = ClassInfo path cfile staticmap fieldmap methodmap mbase False
       setClassMap $ M.insert path new_ci class_map
+
+      -- add Class to Hierarchy
+      super_mtable <- case superclass of
+        Nothing -> return 0
+        Just x -> getMethodTable $ ciName x
+      addClassEntry mbase super_mtable (interfaces cfile)
+
       return new_ci
 
 
@@ -188,7 +194,7 @@ loadInterface path = do
       -- create index of methods by this interface
       let mm = zipbase max_off (classMethods cfile)
 
-      -- create for each method from *every* superinterface a entry to,
+      -- create for each method from *every* superinterface an entry too,
       -- but just put in the same offset as it is already in the map
       let (ifnames, methodnames) = unzip $ concat
             [ zip (repeat ifname) (classMethods $ imap' M.! ifname)
@@ -198,6 +204,9 @@ loadInterface path = do
       -- merge all offset tables
       setInterfaceMethodMap $ M.fromList sm `M.union` M.fromList mm `M.union` immap
       setInterfaceMap $ M.insert path cfile imap'
+
+      -- add Interface to Hierarchy
+      addInterfaceEntry path (interfaces cfile)
   where
     zipbase base = zipWith (\x y -> (entry y, x + base)) [0,ptrSize..]
     entry = getname path
@@ -266,10 +275,11 @@ loadAndInitClass path = do
     Just m -> do
       rawmethod <- parseMethod (ciFile ci) "<clinit>" $ MethodSignature [] ReturnsVoid
       let mi = MethodInfo "<clinit>" path (methodSignature m)
-      entry <- compileBB rawmethod mi
+      -- TODO(bernhard): test exception handling in static initalizer
+      entry <- compileBB mi 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 ()