+-- Dump output of native code generator passes
+-- stripe across the outputs for each block so all the information for a
+-- certain stage is concurrent in the dumps.
+--
+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 "Native code"
+ (vcat $ map (docToSDoc . pprNatCmmTop) $ concatMap cdNative dump)
+
+ dumpIfSet_dyn dflags
+ Opt_D_dump_asm_liveness "Liveness annotations added"
+ (vcat $ map (ppr . cdLiveness) dump)
+
+ dumpIfSet_dyn dflags
+ 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 "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.
+ 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 "Register conflict graph"
+ $ Color.dotGraph Color.regDotColor trivColorable
+ $ foldl Color.union Color.initGraph
+ $ catMaybes $ map cdColoredGraph dump
+
+ -- 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 all the regalloc stats
+ let stats = concat $ catMaybes $ map cdRegAllocStats dump
+
+ -- build a global conflict graph
+ let graph = foldl Color.union Color.initGraph $ map raGraph stats
+
+ -- 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
+
+ writeFile dropFile
+ (showSDoc $ vcat [outSpills, outLife, outConflict, outScatter])
+
+ return ()
+