- 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 all the regalloc stats
- let stats = concat $ catMaybes $ map cdRegAllocStats dump
-
- ---- Spiller
- -- slurp out the stats from all the spiller stages
- let spillStats = [ s | s@RegAllocStatsSpill{} <- stats]
-
- -- 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]))
-
-
- let outSpill = ( 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")
-
- ---- Lifetimes
- -- slurp out the maps of all the reg lifetimes
- let lifetimes = map raLifetimes stats
- let lifeMap = foldl' plusUFM emptyUFM $ map raLifetimes stats
- let lifeBins = binLifetimeCount lifeMap
-
- let outLife = ( text "-- (vreg-population-lifetimes)"
- $$ text "-- Number of vregs which lived for a certain number of instructions"
- $$ text "-- (instruction_count, number_of_vregs_that_lived_that_long)"
- $$ (vcat $ map ppr $ eltsUFM lifeBins)
- $$ text "\n")
-
- -- write out the file
- writeFile dropFile
- (showSDoc $ vcat [outSpill, outLife])
-
- return ()
-
- return ()