From: Bernhard Urban <lewurm@gmail.com>
Date: Mon, 20 Aug 2012 16:21:23 +0000 (+0200)
Subject: debug: more readable debuginfo
X-Git-Url: http://wien.tomnetworks.com/gitweb/?p=mate.git;a=commitdiff_plain;h=a60718741f1acee2830528f57e2d48f2df1f7acb

debug: more readable debuginfo
---

diff --git a/Mate/ClassPool.hs b/Mate/ClassPool.hs
index 9064857..b9b8b3c 100644
--- 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 612bbf4..8f234e5 100644
--- 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