1 {-# OPTIONS -fno-warn-missing-signatures #-}
2 -- Carries interesting info for debugging / profiling of the
3 -- graph coloring register allocator.
6 module RegAlloc.Graph.Stats (
20 #include "nativeGen/NCG.h"
22 import qualified GraphColor as Color
23 import RegAlloc.Liveness
24 import RegAlloc.Graph.Spill
25 import RegAlloc.Graph.SpillCost
38 data RegAllocStats instr
42 { raLiveCmm :: [LiveCmmTop instr] -- ^ initial code, with liveness
43 , raGraph :: Color.Graph Reg RegClass Reg -- ^ the initial, uncolored graph
44 , raSpillCosts :: SpillCostInfo } -- ^ information to help choose which regs to spill
48 { raGraph :: Color.Graph Reg RegClass Reg -- ^ the partially colored graph
49 , raCoalesced :: UniqFM Reg -- ^ the regs that were coaleced
50 , raSpillStats :: SpillStats -- ^ spiller stats
51 , raSpillCosts :: SpillCostInfo -- ^ number of instrs each reg lives for
52 , raSpilled :: [LiveCmmTop instr] } -- ^ code with spill instructions added
54 -- a successful coloring
55 | RegAllocStatsColored
56 { raGraph :: Color.Graph Reg RegClass Reg -- ^ the uncolored graph
57 , raGraphColored :: Color.Graph Reg RegClass Reg -- ^ the coalesced and colored graph
58 , raCoalesced :: UniqFM Reg -- ^ the regs that were coaleced
59 , raPatched :: [LiveCmmTop instr] -- ^ code with vregs replaced by hregs
60 , raSpillClean :: [LiveCmmTop instr] -- ^ code with unneeded spill\/reloads cleaned out
61 , raFinal :: [NatCmmTop instr] -- ^ final code
62 , raSRMs :: (Int, Int, Int) } -- ^ spill\/reload\/reg-reg moves present in this code
64 instance Outputable instr => Outputable (RegAllocStats instr) where
66 ppr (s@RegAllocStatsStart{})
68 $$ text "# Native code with liveness information."
71 -- $$ text "# Initial register conflict graph."
72 -- $$ Color.dotGraph regDotColor trivColorable (raGraph s)
75 ppr (s@RegAllocStatsSpill{})
78 -- $$ text "# Register conflict graph."
79 -- $$ Color.dotGraph regDotColor trivColorable (raGraph s)
82 $$ (if (not $ isNullUFM $ raCoalesced s)
83 then text "# Registers coalesced."
84 $$ (vcat $ map ppr $ ufmToList $ raCoalesced s)
88 -- $$ text "# Spill costs. reg uses defs lifetime degree cost"
89 -- $$ vcat (map (pprSpillCostRecord (raGraph s)) $ eltsUFM $ raSpillCosts s)
92 $$ text "# Spills inserted."
93 $$ ppr (raSpillStats s)
96 $$ text "# Code with spills inserted."
97 $$ (ppr (raSpilled s))
100 ppr (s@RegAllocStatsColored { raSRMs = (spills, reloads, moves) })
103 -- $$ text "# Register conflict graph (initial)."
104 -- $$ Color.dotGraph regDotColor trivColorable (raGraph s)
107 -- $$ text "# Register conflict graph (colored)."
108 -- $$ Color.dotGraph regDotColor trivColorable (raGraphColored s)
111 $$ (if (not $ isNullUFM $ raCoalesced s)
112 then text "# Registers coalesced."
113 $$ (vcat $ map ppr $ ufmToList $ raCoalesced s)
117 $$ text "# Native code after register allocation."
121 $$ text "# Clean out unneeded spill/reloads."
122 $$ ppr (raSpillClean s)
125 $$ text "# Final code, after rewriting spill/rewrite pseudo instrs."
129 $$ (text "# spills inserted: " <> int spills)
130 $$ (text "# reloads inserted: " <> int reloads)
131 $$ (text "# reg-reg moves remaining: " <> int moves)
134 -- | Do all the different analysis on this list of RegAllocStats
135 pprStats :: [RegAllocStats instr] -> Color.Graph Reg RegClass Reg -> SDoc
137 = let outSpills = pprStatsSpills stats
138 outLife = pprStatsLifetimes stats
139 outConflict = pprStatsConflict stats
140 outScatter = pprStatsLifeConflict stats graph
142 in vcat [outSpills, outLife, outConflict, outScatter]
145 -- | Dump a table of how many spill loads \/ stores were inserted for each vreg.
147 :: [RegAllocStats instr] -> SDoc
151 finals = [ s | s@RegAllocStatsColored{} <- stats]
153 -- sum up how many stores\/loads\/reg-reg-moves were left in the code
154 total = foldl' addSRM (0, 0, 0)
157 in ( text "-- spills-added-total"
158 $$ text "-- (stores, loads, reg_reg_moves_remaining)"
163 -- | Dump a table of how long vregs tend to live for in the initial code.
165 :: [RegAllocStats instr] -> SDoc
167 pprStatsLifetimes stats
168 = let info = foldl' plusSpillCostInfo zeroSpillCostInfo
170 | s@RegAllocStatsStart{} <- stats ]
172 lifeBins = binLifetimeCount $ lifeMapFromSpillCostInfo info
174 in ( text "-- vreg-population-lifetimes"
175 $$ text "-- (instruction_count, number_of_vregs_that_lived_that_long)"
176 $$ (vcat $ map ppr $ eltsUFM lifeBins)
179 binLifetimeCount :: UniqFM (Reg, Int) -> UniqFM (Int, Int)
181 = let lifes = map (\l -> (l, (l, 1)))
186 (\(l1, c1) (_, c2) -> (l1, c1 + c2))
191 -- | Dump a table of how many conflicts vregs tend to have in the initial code.
193 :: [RegAllocStats instr] -> SDoc
195 pprStatsConflict stats
196 = let confMap = foldl' (plusUFM_C (\(c1, n1) (_, n2) -> (c1, n1 + n2)))
198 $ map Color.slurpNodeConflictCount
199 [ raGraph s | s@RegAllocStatsStart{} <- stats ]
201 in ( text "-- vreg-conflicts"
202 $$ text "-- (conflict_count, number_of_vregs_that_had_that_many_conflicts)"
203 $$ (vcat $ map ppr $ eltsUFM confMap)
207 -- | For every vreg, dump it's how many conflicts it has and its lifetime
208 -- good for making a scatter plot.
210 :: [RegAllocStats instr]
211 -> Color.Graph Reg RegClass Reg -- ^ global register conflict graph
214 pprStatsLifeConflict stats graph
215 = let lifeMap = lifeMapFromSpillCostInfo
216 $ foldl' plusSpillCostInfo zeroSpillCostInfo
217 $ [ raSpillCosts s | s@RegAllocStatsStart{} <- stats ]
219 scatter = map (\r -> let lifetime = case lookupUFM lifeMap r of
222 Just node = Color.lookupNode graph r
223 in parens $ hcat $ punctuate (text ", ")
224 [ doubleQuotes $ ppr $ Color.nodeId node
225 , ppr $ sizeUniqSet (Color.nodeConflicts node)
229 $ Color.graphMap graph
231 in ( text "-- vreg-conflict-lifetime"
232 $$ text "-- (vreg, vreg_conflicts, vreg_lifetime)"
237 -- | Count spill/reload/reg-reg moves.
238 -- Lets us see how well the register allocator has done.
242 => LiveCmmTop instr -> (Int, Int, Int)
245 = execState (mapBlockTopM countSRM_block cmm) (0, 0, 0)
247 countSRM_block (BasicBlock i instrs)
248 = do instrs' <- mapM countSRM_instr instrs
249 return $ BasicBlock i instrs'
253 = do modify $ \(s, r, m) -> (s + 1, r, m)
257 = do modify $ \(s, r, m) -> (s, r + 1, m)
260 | Instr instr _ <- li
261 , Just _ <- takeRegRegMoveInstr instr
262 = do modify $ \(s, r, m) -> (s, r, m + 1)
269 addSRM (s1, r1, m1) (s2, r2, m2)
270 = (s1+s2, r1+r2, m1+m2)
279 = let rs = padL 2 '0' (showHex r "")
280 gs = padL 2 '0' (showHex r "")
281 bs = padL 2 '0' (showHex r "")
284 = replicate (n - length s) c ++ s
285 in "#" ++ rs ++ gs ++ bs