debug: use #ifdef guards

[mate.git] / Mate / ClassPool.hs

diff --git a/Mate/ClassPool.hs b/Mate/ClassPool.hs
index fd5fc8ebb328bb897e9cf3f15202ef0000701969..eeae3de5a5e1f55336a60bf20779ae6d12820f56 100644 (file)
--- a/Mate/ClassPool.hs
+++ b/Mate/ClassPool.hs
@@ -1,10 +1,11 @@
+{-# LANGUAGE CPP #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE ForeignFunctionInterface #-}
 module Mate.ClassPool (
   getClassInfo,
   getClassFile,
   getMethodTable,
-  getMethodSize,
+  getObjectSize,
   getMethodOffset,
   getFieldOffset,
   getStaticFieldAddr
@@ -18,7 +19,9 @@ import qualified Data.Set as S
 import qualified Data.ByteString.Lazy as B
 import Control.Monad
 
+#ifdef DEBUG
 import Text.Printf
+#endif
 
 import Foreign.Ptr
 import Foreign.C.Types
@@ -42,40 +45,41 @@ getClassInfo path = do
 getClassFile :: B.ByteString -> IO (Class Resolved)
 getClassFile path = do
   ci <- getClassInfo path
-  return $ clFile ci
+  return $ ciFile ci
 
 getStaticFieldOffset :: B.ByteString -> B.ByteString -> IO (CUInt)
 getStaticFieldOffset path field = do
   ci <- getClassInfo path
-  return $ fromIntegral $ (clStaticMap ci) M.! field
+  return $ fromIntegral $ (ciStaticMap ci) M.! field
 
 getFieldOffset :: B.ByteString -> B.ByteString -> IO (Int32)
 getFieldOffset path field = do
   ci <- getClassInfo path
-  return $ (clFieldMap ci) M.! field
+  return $ (ciFieldMap ci) M.! field
 
 -- method + signature plz!
 getMethodOffset :: B.ByteString -> B.ByteString -> IO (Word32)
 getMethodOffset path method = do
   ci <- getClassInfo path
-  return $ fromIntegral $ (clMethodMap ci) M.! method
+  return $ fromIntegral $ (ciMethodMap ci) M.! method
 
 getMethodTable :: B.ByteString -> IO (Word32)
 getMethodTable path = do
   ci <- getClassInfo path
-  return $ clMethodBase ci
+  return $ ciMethodBase ci
 
-getMethodSize :: B.ByteString -> IO (Word32)
-getMethodSize path = do
+getObjectSize :: B.ByteString -> IO (Word32)
+getObjectSize path = do
   ci <- getClassInfo path
   -- TODO(bernhard): correct sizes for different types...
-  let msize = fromIntegral $ M.size $ clMethodMap ci
-  return $ (1 + msize) * 4
+  let fsize = fromIntegral $ M.size $ ciFieldMap ci
+  -- one slot for "method-table-ptr"
+  return $ (1 + fsize) * 4
 
 foreign export ccall getStaticFieldAddr :: CUInt -> Ptr () -> IO CUInt
 getStaticFieldAddr :: CUInt -> Ptr () -> IO CUInt
 getStaticFieldAddr from ptr_trapmap = do
-  trapmap <- ptr2tmap ptr_trapmap
+  trapmap <- ptr2trapmap ptr_trapmap
   let w32_from = fromIntegral from
   let sfi = trapmap M.! w32_from
   case sfi of
@@ -85,7 +89,9 @@ getStaticFieldAddr from ptr_trapmap = do
 
 loadClass :: B.ByteString -> IO ClassInfo
 loadClass path = do
+#ifdef DEBUG
   printf "loadClass: \"%s\"\n" $ toString path
+#endif
   let rpath = toString $ path `B.append` ".class"
   cfile <- parseClassFile rpath
   superclass <- case (path /= "java/lang/Object") of
@@ -95,11 +101,13 @@ loadClass path = do
       False -> return $ Nothing
 
   (staticmap, fieldmap) <- calculateFields cfile superclass
+  (methodmap, mbase) <- calculateMethodMap cfile superclass
+#ifdef DEBUG
   printf "staticmap: %s @ %s\n" (show staticmap) (toString path)
   printf "fieldmap:  %s @ %s\n" (show fieldmap) (toString path)
-  (methodmap, mbase) <- calculateMethodMap cfile superclass
   printf "methodmap: %s @ %s\n" (show methodmap) (toString path)
   printf "mbase: 0x%08x\n" mbase
+#endif
 
   virtual_map <- get_virtualmap >>= ptr2virtualmap
   let virtual_map' = M.insert mbase path virtual_map
@@ -121,11 +129,11 @@ calculateFields cf superclass = do
     staticbase <- mallocBytes ((fromIntegral $ length sfields) * 4)
     let i_sb = fromIntegral $ ptrToIntPtr $ staticbase
     let sm = zipbase i_sb sfields
-    let sc_sm = getsupermap superclass clStaticMap
+    let sc_sm = getsupermap superclass ciStaticMap
     -- new fields "overwrite" old ones, if they have the same name
     let staticmap = (M.fromList sm) `M.union` sc_sm
 
-    let sc_im = getsupermap superclass clFieldMap
+    let sc_im = getsupermap superclass ciFieldMap
     -- "+ 4" for the method table pointer
     let max_off = (fromIntegral $ (M.size sc_im) * 4) + 4
     let im = zipbase max_off ifields
@@ -147,7 +155,7 @@ calculateMethodMap cf superclass = do
                   (\x -> (not . S.member ACC_STATIC . methodAccessFlags) x &&
                          ((/=) "<init>" . methodName) x)
                   (classMethods cf)
-    let sc_mm = getsupermap superclass clMethodMap
+    let sc_mm = getsupermap superclass ciMethodMap
     let max_off = fromIntegral $ (M.size sc_mm) * 4
     let mm = zipbase max_off methods
     let methodmap = (M.fromList mm) `M.union` sc_mm
@@ -166,26 +174,29 @@ loadAndInitClass path = do
     Just x -> return x
 
   -- first try to execute class initializer of superclass
-  when (path /= "java/lang/Object") ((loadAndInitClass $ superClass $ clFile ci) >> return ())
+  when (path /= "java/lang/Object") ((loadAndInitClass $ superClass $ ciFile ci) >> return ())
 
   -- execute class initializer
-  case lookupMethod "<clinit>" (clFile ci) of
+  case lookupMethod "<clinit>" (ciFile ci) of
     Just m -> do
-      hmap <- parseMethod (clFile ci) "<clinit>"
-      printMapBB hmap
+      hmap <- parseMethod (ciFile ci) "<clinit>"
       case hmap of
         Just hmap' -> do
           let mi = (MethodInfo "<clinit>" path (methodSignature m))
           entry <- compileBB hmap' mi
           addMethodRef entry mi [path]
+#ifdef DEBUG
           printf "executing static initializer from %s now\n" (toString path)
+#endif
           executeFuncPtr entry
+#ifdef DEBUG
           printf "static initializer from %s done\n" (toString path)
+#endif
         Nothing -> error $ "loadClass: static initializer not found (WTF?). abort"
     Nothing -> return ()
 
   class_map' <- get_classmap >>= ptr2classmap
-  let new_ci = ci { clInitDone = True }
+  let new_ci = ci { ciInitDone = True }
   let class_map'' = M.insert path new_ci class_map'
   classmap2ptr class_map'' >>= set_classmap
   return new_ci