debug: more readable debuginfo

diff --git a/Mate/ClassPool.hs b/Mate/ClassPool.hs
index 906485729dac5a8f0b6a5c6fe912c892cfa6712d..b9b8b3cafb158366aff27752a250a8cae71b735a 100644 (file)
--- a/Mate/ClassPool.hs
+++ b/Mate/ClassPool.hs
@@ -47,6 +47,7 @@ import Java.JAR
 import Mate.BasicBlocks
 import {-# SOURCE #-} Mate.MethodPool
 import Mate.Types
+import Mate.Utilities
 import Mate.Debug
 import Mate.GarbageAlloc
 import Mate.NativeSizes
@@ -149,11 +150,14 @@ readClass path = do
       let wn_iftable = fromIntegral $ ptrToIntPtr iftable :: NativeWord
       -- store interface-table at offset 0 in method-table
       pokeElemOff (intPtrToPtr $ fromIntegral mbase) 0 wn_iftable
-      printfCp "staticmap: %s @ %s\n" (show staticmap) (toString path)
-      printfCp "fieldmap:  %s @ %s\n" (show fieldmap) (toString path)
-      printfCp "methodmap: %s @ %s\n" (show methodmap) (toString path)
-      printfCp "mbase: 0x%08x\n" mbase
-      printfCp "interfacemethod: %s @ %s\n" (show immap) (toString path)
+      let strpath = toString path
+#ifdef DBG_CLASS
+      hexDumpMap ("staticmap @ " ++ strpath) staticmap
+      hexDumpMap ("fieldmap @ " ++ strpath) fieldmap
+      hexDumpMap ("methodmap @ " ++ strpath) methodmap
+      hexDumpMap ("interfacemap @ " ++ strpath) immap
+#endif
+      printfCp "mbase:   0x%08x\n" mbase
       printfCp "iftable: 0x%08x\n" wn_iftable
       virtual_map <- getVirtualMap
       setVirtualMap $ M.insert mbase path virtual_map

diff --git a/Mate/Utilities.hs b/Mate/Utilities.hs
index 612bbf42231c88d9137ecabab432c323e9449a27..8f234e5394ab5faba2ddc58cae9c019bc3845172 100644 (file)
--- a/Mate/Utilities.hs
+++ b/Mate/Utilities.hs
@@ -14,6 +14,9 @@ import JVM.ClassFile
 import Mate.Types
 import Mate.NativeSizes
 
+#ifdef DEBUG
+import Text.Printf
+#endif
 
 buildMethodID :: Class Direct -> Word16 -> MethodInfo
 buildMethodID cls idx = MethodInfo (ntName nt) rc (ntSignature nt)
@@ -73,3 +76,15 @@ methodIsStatic = S.member ACC_STATIC . methodAccessFlags
 lookupMethodSig :: B.ByteString -> MethodSignature -> Class Direct -> Maybe (Method Direct)
 lookupMethodSig name sig cls =
   find (\x -> methodName x == name && methodSignature x == sig) $ classMethods cls
+
+hexDumpMap :: Integral v => String -> M.Map B.ByteString v -> IO ()
+#ifdef DEBUG
+hexDumpMap header mmap = do
+  let printValue :: B.ByteString -> IO ()
+      printValue key = printf "\t%-70s: 0x%08x\n" (toString key) val
+        where val = fromIntegral (mmap M.! key) :: NativeWord
+  printf "%s\n" header
+  mapM_ printValue (M.keys mmap)
+#else
+hexDumpMap _ _ = return ()
+#endif