NCG debugging cleanup

[ghc-hetmet.git] / compiler / nativeGen / AsmCodeGen.lhs

diff --git a/compiler/nativeGen/AsmCodeGen.lhs b/compiler/nativeGen/AsmCodeGen.lhs
index 177ef0e..13f620f 100644 (file)
--- a/compiler/nativeGen/AsmCodeGen.lhs
+++ b/compiler/nativeGen/AsmCodeGen.lhs
@@ -23,7 +23,6 @@ import RegAllocLinear
 import RegAllocStats
 import RegLiveness
 import RegCoalesce
-import qualified RegSpill      as Spill
 import qualified RegAllocColor as Color
 import qualified GraphColor    as Color
 
@@ -372,79 +371,68 @@ x86fp_kludge top@(CmmProc info lbl params code) =
 cmmNativeGenDump :: DynFlags -> Module -> ModLocation -> [CmmNativeGenDump] -> IO ()
 cmmNativeGenDump dflags mod modLocation dump
  = do
-
        dumpIfSet_dyn dflags
                Opt_D_dump_opt_cmm "Optimised Cmm"
                (pprCmm $ Cmm $ map cdCmmOpt dump)
 
        dumpIfSet_dyn dflags
-               Opt_D_dump_asm_native   "(asm-native) Native code"
+               Opt_D_dump_asm_native   "Native code"
                (vcat $ map (docToSDoc . pprNatCmmTop)  $ concatMap cdNative dump)
 
        dumpIfSet_dyn dflags
-               Opt_D_dump_asm_liveness "(asm-liveness) Liveness info added"
+               Opt_D_dump_asm_liveness "Liveness annotations added"
                (vcat $ map (ppr . cdLiveness) dump)
 
        dumpIfSet_dyn dflags
-               Opt_D_dump_asm_coalesce "(asm-coalesce) Register moves coalesced."
-               (vcat $ map (ppr . (\(Just c) -> c) . cdCoalesce) dump)
+               Opt_D_dump_asm_coalesce "Reg-Reg moves coalesced"
+               (vcat $ map (fromMaybe empty . liftM ppr . cdCoalesce) dump)
 
        dumpIfSet_dyn dflags
-               Opt_D_dump_asm_regalloc "(asm-regalloc) Registers allocated"
+               Opt_D_dump_asm_regalloc "Registers allocated"
                (vcat $ map (docToSDoc . pprNatCmmTop) $ concatMap cdAlloced dump)
 
        -- with the graph coloring allocator, show the result of each build/spill stage
        --        for each block in turn.
-       mapM_ (\codeGraphs
-        -> dumpIfSet_dyn dflags
-               Opt_D_dump_asm_regalloc_stages "(asm-regalloc-stages)"
-               (vcat $ map (\(stage, stats) ->
-                                text "-- Stage " <> int stage
-                                $$ ppr stats)
-                               (zip [0..] codeGraphs)))
-        $ map ((\(Just c) -> c) . cdRegAllocStats) dump
+       when (dopt Opt_D_dump_asm_regalloc_stages dflags)
+        $ do   mapM_ (\stats
+                        -> printDump
+                        $  vcat $ map (\(stage, stats) ->
+                                        text "-- Stage " <> int stage
+                                        $$ ppr stats)
+                                       (zip [0..] stats))
+                $ map (fromMaybe [] . cdRegAllocStats) dump
 
        -- Build a global register conflict graph.
        --      If you want to see the graph for just one basic block then use asm-regalloc-stages instead.
        dumpIfSet_dyn dflags
-               Opt_D_dump_asm_conflicts "(asm-conflicts) Register conflict graph"
+               Opt_D_dump_asm_conflicts "Register conflict graph"
                $ Color.dotGraph Color.regDotColor trivColorable
                $ foldl Color.union Color.initGraph
                $ catMaybes $ map cdColoredGraph dump
 
-
-       -- Drop native code gen statistics.
-       --      This is potentially a large amount of information, so we make a new file instead
-       --      of dumping it to stdout.
+       -- Drop native code generator statistics.
+       --      This is potentially a large amount of information, and we want to be able
+       --      to collect it while running nofib. Drop a new file instead of emitting
+       --      it to stdout/stderr.
        --
        when (dopt Opt_D_drop_asm_stats dflags)
         $ do   -- make the drop file name based on the object file name
                let dropFile    = (init $ ml_obj_file modLocation) ++ "drop-asm-stats"
 
-               -- slurp out the stats from all the spiller stages
-               let spillStats  = [ s   | s@RegAllocStatsSpill{}
-                                       <- concat [ c | Just c <- map cdRegAllocStats dump]]
-
-               -- build a map of how many spill load/stores were inserted for each vreg
-               let spillLS     = foldl' (plusUFM_C Spill.accSpillLS) emptyUFM
-                               $ map (Spill.spillLoadStore . raSpillStats) spillStats
-
-               -- print the count of load/spills as a tuple so we can read back from the file easilly
-               let pprSpillLS :: (Reg, Int, Int) -> SDoc
-                   pprSpillLS  (r, loads, stores) =
-                       (parens $ (hcat $ punctuate (text ", ") [doubleQuotes (ppr r), int loads, int stores]))
+               -- slurp out all the regalloc stats
+               let stats       = concat $ catMaybes $ map cdRegAllocStats dump
 
-               -- write out the file
-               let out         = showSDoc
-                               (  text "-- (spills-added)"
-                               $$ text "--    Spill instructions inserted for each virtual reg."
-                               $$ text "--    (reg name, spill loads added, spill stores added)."
-                               $$ (vcat $ map pprSpillLS $ eltsUFM spillLS)
-                               $$ text "\n")
+               -- build a global conflict graph
+               let graph       = foldl Color.union Color.initGraph $ map raGraph stats
 
-               writeFile dropFile out
+               -- pretty print the various sections and write out the file.
+               let outSpills   = pprStatsSpills    stats
+               let outLife     = pprStatsLifetimes stats
+               let outConflict = pprStatsConflict  stats
+               let outScatter  = pprStatsLifeConflict stats graph
 
-               return ()
+               writeFile dropFile
+                       (showSDoc $ vcat [outSpills, outLife, outConflict, outScatter])
 
        return ()