[commit: ghc] wip/libdw-prof: Debugging output (1d62cee)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/ghc

On branch  : wip/libdw-prof
Link       : http://ghc.haskell.org/trac/ghc/changeset/1d62cee84f1c8300c79f8a867349b54cf032ecd3/ghc

>---------------------------------------------------------------

commit 1d62cee84f1c8300c79f8a867349b54cf032ecd3
Author: Ben Gamari <ben at smart-cactus.org>
Date:   Mon Nov 21 22:26:13 2016 -0500

    Debugging output


>---------------------------------------------------------------

1d62cee84f1c8300c79f8a867349b54cf032ecd3
 compiler/nativeGen/Dwarf.hs       | 7 +++++++
 compiler/nativeGen/Dwarf/Types.hs | 6 +++++-
 2 files changed, 12 insertions(+), 1 deletion(-)

diff --git a/compiler/nativeGen/Dwarf.hs b/compiler/nativeGen/Dwarf.hs
index 1066169..497bb35 100644
--- a/compiler/nativeGen/Dwarf.hs
+++ b/compiler/nativeGen/Dwarf.hs
@@ -14,6 +14,8 @@ import Platform
 import Unique
 import UniqSupply
 
+import ErrUtils
+
 import Dwarf.Constants
 import Dwarf.Types
 
@@ -89,6 +91,11 @@ dwarfGen df modLoc us blocks = do
                | otherwise                 = [DwarfARange lowLabel highLabel]
   let aranges = dwarfARangesSection $$ pprDwarfARanges aranges' unitU
 
+  let extractUnwinds blk = dblUnwind blk : foldMap extractUnwinds (dblBlocks blk)
+  dumpIfSet_dyn df Opt_D_dump_debug "Pre-dwarfGen"
+      (nest 4 $ vcat $ map (ppr . extractUnwinds) blocks)
+  dumpIfSet_dyn df Opt_D_dump_debug "Post-dwarfGen"
+      (nest 4 $ vcat $ foldMap (map ppr . extractUnwinds) procs)
   return (infoSct $$ abbrevSct $$ lineSct $$ frameSct $$ aranges, us'')
 
 -- | Build an address range entry for one proc.
diff --git a/compiler/nativeGen/Dwarf/Types.hs b/compiler/nativeGen/Dwarf/Types.hs
index d4d8e24..ebdbee3 100644
--- a/compiler/nativeGen/Dwarf/Types.hs
+++ b/compiler/nativeGen/Dwarf/Types.hs
@@ -264,6 +264,8 @@ data DwarfFrameProc
     , dwFdeBlocks  :: [DwarfFrameBlock]
       -- ^ List of blocks. Order must match asm!
     }
+instance Outputable DwarfFrameProc where
+    ppr x = ppr (dwFdeProc x) <> colon <+> hsep (map ppr $ dwFdeBlocks x)
 
 -- | Unwind instructions for a block. Will become part of the
 -- containing FDE.
@@ -390,7 +392,9 @@ pprFrameBlock (DwarfFrameBlock hasInfo uws0) =
                                if needsOffset then text "-1" else empty
                       doc = sdocWithPlatform $ \plat ->
                            pprByte dW_CFA_set_loc $$ pprWord lblDoc $$
-                           vcat (map (uncurry $ pprSetUnwind plat) changed)
+                           vcat (map (uncurry $ pprSetUnwind' plat) changed)
+                      pprSetUnwind' plat b c =
+                          ifPprDebug (text "# "<+>ppr changed) $$ pprSetUnwind plat b c
                   in (doc, uws)
 
 -- Note [Info Offset]