+-- 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 "(asm-native) Native code"
+ (vcat $ map (docToSDoc . pprNatCmmTop) $ concatMap cdNative dump)
+
+ dumpIfSet_dyn dflags
+ Opt_D_dump_asm_liveness "(asm-liveness) Liveness info 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)
+
+ dumpIfSet_dyn dflags
+ Opt_D_dump_asm_regalloc "(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
+
+ -- 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"
+ $ 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.
+ --
+ 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]))
+
+ -- 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")
+
+ writeFile dropFile out
+
+ return ()
+
+ return ()
+