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 VirtualReg RegClass RealReg -- ^ the initial, uncolored graph
44 , raSpillCosts :: SpillCostInfo } -- ^ information to help choose which regs to spill
48 { raGraph :: Color.Graph VirtualReg RegClass RealReg -- ^ the partially colored graph
49 , raCoalesced :: UniqFM VirtualReg -- ^ 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 VirtualReg RegClass RealReg -- ^ the uncolored graph
57 , raGraphColored :: Color.Graph VirtualReg RegClass RealReg -- ^ the coalesced and colored graph
58 , raCoalesced :: UniqFM VirtualReg -- ^ 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
136 :: [RegAllocStats instr]
137 -> Color.Graph VirtualReg RegClass RealReg
141 = let outSpills = pprStatsSpills stats
142 outLife = pprStatsLifetimes stats
143 outConflict = pprStatsConflict stats
144 outScatter = pprStatsLifeConflict stats graph
146 in vcat [outSpills, outLife, outConflict, outScatter]
149 -- | Dump a table of how many spill loads \/ stores were inserted for each vreg.
151 :: [RegAllocStats instr] -> SDoc
155 finals = [ s | s@RegAllocStatsColored{} <- stats]
157 -- sum up how many stores\/loads\/reg-reg-moves were left in the code
158 total = foldl' addSRM (0, 0, 0)
161 in ( text "-- spills-added-total"
162 $$ text "-- (stores, loads, reg_reg_moves_remaining)"
167 -- | Dump a table of how long vregs tend to live for in the initial code.
169 :: [RegAllocStats instr] -> SDoc
171 pprStatsLifetimes stats
172 = let info = foldl' plusSpillCostInfo zeroSpillCostInfo
174 | s@RegAllocStatsStart{} <- stats ]
176 lifeBins = binLifetimeCount $ lifeMapFromSpillCostInfo info
178 in ( text "-- vreg-population-lifetimes"
179 $$ text "-- (instruction_count, number_of_vregs_that_lived_that_long)"
180 $$ (vcat $ map ppr $ eltsUFM lifeBins)
183 binLifetimeCount :: UniqFM (VirtualReg, Int) -> UniqFM (Int, Int)
185 = let lifes = map (\l -> (l, (l, 1)))
190 (\(l1, c1) (_, c2) -> (l1, c1 + c2))
195 -- | Dump a table of how many conflicts vregs tend to have in the initial code.
197 :: [RegAllocStats instr] -> SDoc
199 pprStatsConflict stats
200 = let confMap = foldl' (plusUFM_C (\(c1, n1) (_, n2) -> (c1, n1 + n2)))
202 $ map Color.slurpNodeConflictCount
203 [ raGraph s | s@RegAllocStatsStart{} <- stats ]
205 in ( text "-- vreg-conflicts"
206 $$ text "-- (conflict_count, number_of_vregs_that_had_that_many_conflicts)"
207 $$ (vcat $ map ppr $ eltsUFM confMap)
211 -- | For every vreg, dump it's how many conflicts it has and its lifetime
212 -- good for making a scatter plot.
214 :: [RegAllocStats instr]
215 -> Color.Graph VirtualReg RegClass RealReg -- ^ global register conflict graph
218 pprStatsLifeConflict stats graph
219 = let lifeMap = lifeMapFromSpillCostInfo
220 $ foldl' plusSpillCostInfo zeroSpillCostInfo
221 $ [ raSpillCosts s | s@RegAllocStatsStart{} <- stats ]
223 scatter = map (\r -> let lifetime = case lookupUFM lifeMap r of
226 Just node = Color.lookupNode graph r
227 in parens $ hcat $ punctuate (text ", ")
228 [ doubleQuotes $ ppr $ Color.nodeId node
229 , ppr $ sizeUniqSet (Color.nodeConflicts node)
233 $ Color.graphMap graph
235 in ( text "-- vreg-conflict-lifetime"
236 $$ text "-- (vreg, vreg_conflicts, vreg_lifetime)"
241 -- | Count spill/reload/reg-reg moves.
242 -- Lets us see how well the register allocator has done.
246 => LiveCmmTop instr -> (Int, Int, Int)
249 = execState (mapBlockTopM countSRM_block cmm) (0, 0, 0)
251 countSRM_block (BasicBlock i instrs)
252 = do instrs' <- mapM countSRM_instr instrs
253 return $ BasicBlock i instrs'
257 = do modify $ \(s, r, m) -> (s + 1, r, m)
261 = do modify $ \(s, r, m) -> (s, r + 1, m)
264 | Instr instr _ <- li
265 , Just _ <- takeRegRegMoveInstr instr
266 = do modify $ \(s, r, m) -> (s, r, m + 1)
273 addSRM (s1, r1, m1) (s2, r2, m2)
274 = (s1+s2, r1+r2, m1+m2)
283 = let rs = padL 2 '0' (showHex r "")
284 gs = padL 2 '0' (showHex r "")
285 bs = padL 2 '0' (showHex r "")
288 = replicate (n - length s) c ++ s
289 in "#" ++ rs ++ gs ++ bs