Add kind equalities to GHC.
[ghc.git] / compiler / nativeGen / RegAlloc / Graph / Stats.hs
1 {-# LANGUAGE BangPatterns, CPP #-}
2
3 -- | Carries interesting info for debugging / profiling of the
4 -- graph coloring register allocator.
5 module RegAlloc.Graph.Stats (
6 RegAllocStats (..),
7
8 pprStats,
9 pprStatsSpills,
10 pprStatsLifetimes,
11 pprStatsConflict,
12 pprStatsLifeConflict,
13
14 countSRMs, addSRM
15 ) where
16
17 #include "nativeGen/NCG.h"
18
19 import qualified GraphColor as Color
20 import RegAlloc.Liveness
21 import RegAlloc.Graph.Spill
22 import RegAlloc.Graph.SpillCost
23 import RegAlloc.Graph.TrivColorable
24 import Instruction
25 import RegClass
26 import Reg
27 import TargetReg
28
29 import PprCmm()
30 import Outputable
31 import UniqFM
32 import UniqSet
33 import State
34
35 import Data.List
36
37
38 -- | Holds interesting statistics from the register allocator.
39 data RegAllocStats statics instr
40
41 -- Information about the initial conflict graph.
42 = RegAllocStatsStart
43 { -- | Initial code, with liveness.
44 raLiveCmm :: [LiveCmmDecl statics instr]
45
46 -- | The initial, uncolored graph.
47 , raGraph :: Color.Graph VirtualReg RegClass RealReg
48
49 -- | Information to help choose which regs to spill.
50 , raSpillCosts :: SpillCostInfo }
51
52
53 -- Information about an intermediate graph.
54 -- This is one that we couldn't color, so had to insert spill code
55 -- instruction stream.
56 | RegAllocStatsSpill
57 { -- | Code we tried to allocate registers for.
58 raCode :: [LiveCmmDecl statics instr]
59
60 -- | Partially colored graph.
61 , raGraph :: Color.Graph VirtualReg RegClass RealReg
62
63 -- | The regs that were coaleced.
64 , raCoalesced :: UniqFM VirtualReg
65
66 -- | Spiller stats.
67 , raSpillStats :: SpillStats
68
69 -- | Number of instructions each reg lives for.
70 , raSpillCosts :: SpillCostInfo
71
72 -- | Code with spill instructions added.
73 , raSpilled :: [LiveCmmDecl statics instr] }
74
75
76 -- a successful coloring
77 | RegAllocStatsColored
78 { -- | Code we tried to allocate registers for.
79 raCode :: [LiveCmmDecl statics instr]
80
81 -- | Uncolored graph.
82 , raGraph :: Color.Graph VirtualReg RegClass RealReg
83
84 -- | Coalesced and colored graph.
85 , raGraphColored :: Color.Graph VirtualReg RegClass RealReg
86
87 -- | Regs that were coaleced.
88 , raCoalesced :: UniqFM VirtualReg
89
90 -- | Code with coalescings applied.
91 , raCodeCoalesced :: [LiveCmmDecl statics instr]
92
93 -- | Code with vregs replaced by hregs.
94 , raPatched :: [LiveCmmDecl statics instr]
95
96 -- | Code with unneeded spill\/reloads cleaned out.
97 , raSpillClean :: [LiveCmmDecl statics instr]
98
99 -- | Final code.
100 , raFinal :: [NatCmmDecl statics instr]
101
102 -- | Spill\/reload\/reg-reg moves present in this code.
103 , raSRMs :: (Int, Int, Int) }
104
105
106 instance (Outputable statics, Outputable instr)
107 => Outputable (RegAllocStats statics instr) where
108
109 ppr (s@RegAllocStatsStart{}) = sdocWithPlatform $ \platform ->
110 text "# Start"
111 $$ text "# Native code with liveness information."
112 $$ ppr (raLiveCmm s)
113 $$ text ""
114 $$ text "# Initial register conflict graph."
115 $$ Color.dotGraph
116 (targetRegDotColor platform)
117 (trivColorable platform
118 (targetVirtualRegSqueeze platform)
119 (targetRealRegSqueeze platform))
120 (raGraph s)
121
122
123 ppr (s@RegAllocStatsSpill{}) =
124 text "# Spill"
125
126 $$ text "# Code with liveness information."
127 $$ ppr (raCode s)
128 $$ text ""
129
130 $$ (if (not $ isNullUFM $ raCoalesced s)
131 then text "# Registers coalesced."
132 $$ (vcat $ map ppr $ ufmToList $ raCoalesced s)
133 $$ text ""
134 else empty)
135
136 $$ text "# Spills inserted."
137 $$ ppr (raSpillStats s)
138 $$ text ""
139
140 $$ text "# Code with spills inserted."
141 $$ ppr (raSpilled s)
142
143
144 ppr (s@RegAllocStatsColored { raSRMs = (spills, reloads, moves) })
145 = sdocWithPlatform $ \platform ->
146 text "# Colored"
147
148 $$ text "# Code with liveness information."
149 $$ ppr (raCode s)
150 $$ text ""
151
152 $$ text "# Register conflict graph (colored)."
153 $$ Color.dotGraph
154 (targetRegDotColor platform)
155 (trivColorable platform
156 (targetVirtualRegSqueeze platform)
157 (targetRealRegSqueeze platform))
158 (raGraphColored s)
159 $$ text ""
160
161 $$ (if (not $ isNullUFM $ raCoalesced s)
162 then text "# Registers coalesced."
163 $$ (vcat $ map ppr $ ufmToList $ raCoalesced s)
164 $$ text ""
165 else empty)
166
167 $$ text "# Native code after coalescings applied."
168 $$ ppr (raCodeCoalesced s)
169 $$ text ""
170
171 $$ text "# Native code after register allocation."
172 $$ ppr (raPatched s)
173 $$ text ""
174
175 $$ text "# Clean out unneeded spill/reloads."
176 $$ ppr (raSpillClean s)
177 $$ text ""
178
179 $$ text "# Final code, after rewriting spill/rewrite pseudo instrs."
180 $$ ppr (raFinal s)
181 $$ text ""
182 $$ text "# Score:"
183 $$ (text "# spills inserted: " <> int spills)
184 $$ (text "# reloads inserted: " <> int reloads)
185 $$ (text "# reg-reg moves remaining: " <> int moves)
186 $$ text ""
187
188
189 -- | Do all the different analysis on this list of RegAllocStats
190 pprStats
191 :: [RegAllocStats statics instr]
192 -> Color.Graph VirtualReg RegClass RealReg
193 -> SDoc
194
195 pprStats stats graph
196 = let outSpills = pprStatsSpills stats
197 outLife = pprStatsLifetimes stats
198 outConflict = pprStatsConflict stats
199 outScatter = pprStatsLifeConflict stats graph
200
201 in vcat [outSpills, outLife, outConflict, outScatter]
202
203
204 -- | Dump a table of how many spill loads \/ stores were inserted for each vreg.
205 pprStatsSpills
206 :: [RegAllocStats statics instr] -> SDoc
207
208 pprStatsSpills stats
209 = let
210 finals = [ s | s@RegAllocStatsColored{} <- stats]
211
212 -- sum up how many stores\/loads\/reg-reg-moves were left in the code
213 total = foldl' addSRM (0, 0, 0)
214 $ map raSRMs finals
215
216 in ( text "-- spills-added-total"
217 $$ text "-- (stores, loads, reg_reg_moves_remaining)"
218 $$ ppr total
219 $$ text "")
220
221
222 -- | Dump a table of how long vregs tend to live for in the initial code.
223 pprStatsLifetimes
224 :: [RegAllocStats statics instr] -> SDoc
225
226 pprStatsLifetimes stats
227 = let info = foldl' plusSpillCostInfo zeroSpillCostInfo
228 [ raSpillCosts s
229 | s@RegAllocStatsStart{} <- stats ]
230
231 lifeBins = binLifetimeCount $ lifeMapFromSpillCostInfo info
232
233 in ( text "-- vreg-population-lifetimes"
234 $$ text "-- (instruction_count, number_of_vregs_that_lived_that_long)"
235 $$ (vcat $ map ppr $ eltsUFM lifeBins)
236 $$ text "\n")
237
238
239 binLifetimeCount :: UniqFM (VirtualReg, Int) -> UniqFM (Int, Int)
240 binLifetimeCount fm
241 = let lifes = map (\l -> (l, (l, 1)))
242 $ map snd
243 $ eltsUFM fm
244
245 in addListToUFM_C
246 (\(l1, c1) (_, c2) -> (l1, c1 + c2))
247 emptyUFM
248 lifes
249
250
251 -- | Dump a table of how many conflicts vregs tend to have in the initial code.
252 pprStatsConflict
253 :: [RegAllocStats statics instr] -> SDoc
254
255 pprStatsConflict stats
256 = let confMap = foldl' (plusUFM_C (\(c1, n1) (_, n2) -> (c1, n1 + n2)))
257 emptyUFM
258 $ map Color.slurpNodeConflictCount
259 [ raGraph s | s@RegAllocStatsStart{} <- stats ]
260
261 in ( text "-- vreg-conflicts"
262 $$ text "-- (conflict_count, number_of_vregs_that_had_that_many_conflicts)"
263 $$ (vcat $ map ppr $ eltsUFM confMap)
264 $$ text "\n")
265
266
267 -- | For every vreg, dump it's how many conflicts it has and its lifetime
268 -- good for making a scatter plot.
269 pprStatsLifeConflict
270 :: [RegAllocStats statics instr]
271 -> Color.Graph VirtualReg RegClass RealReg -- ^ global register conflict graph
272 -> SDoc
273
274 pprStatsLifeConflict stats graph
275 = let lifeMap = lifeMapFromSpillCostInfo
276 $ foldl' plusSpillCostInfo zeroSpillCostInfo
277 $ [ raSpillCosts s | s@RegAllocStatsStart{} <- stats ]
278
279 scatter = map (\r -> let lifetime = case lookupUFM lifeMap r of
280 Just (_, l) -> l
281 Nothing -> 0
282 Just node = Color.lookupNode graph r
283 in parens $ hcat $ punctuate (text ", ")
284 [ doubleQuotes $ ppr $ Color.nodeId node
285 , ppr $ sizeUniqSet (Color.nodeConflicts node)
286 , ppr $ lifetime ])
287 $ map Color.nodeId
288 $ eltsUFM
289 $ Color.graphMap graph
290
291 in ( text "-- vreg-conflict-lifetime"
292 $$ text "-- (vreg, vreg_conflicts, vreg_lifetime)"
293 $$ (vcat scatter)
294 $$ text "\n")
295
296
297 -- | Count spill/reload/reg-reg moves.
298 -- Lets us see how well the register allocator has done.
299 countSRMs
300 :: Instruction instr
301 => LiveCmmDecl statics instr -> (Int, Int, Int)
302
303 countSRMs cmm
304 = execState (mapBlockTopM countSRM_block cmm) (0, 0, 0)
305
306
307 countSRM_block
308 :: Instruction instr
309 => GenBasicBlock (LiveInstr instr)
310 -> State (Int, Int, Int) (GenBasicBlock (LiveInstr instr))
311
312 countSRM_block (BasicBlock i instrs)
313 = do instrs' <- mapM countSRM_instr instrs
314 return $ BasicBlock i instrs'
315
316
317 countSRM_instr
318 :: Instruction instr
319 => LiveInstr instr -> State (Int, Int, Int) (LiveInstr instr)
320
321 countSRM_instr li
322 | LiveInstr SPILL{} _ <- li
323 = do modify $ \(s, r, m) -> (s + 1, r, m)
324 return li
325
326 | LiveInstr RELOAD{} _ <- li
327 = do modify $ \(s, r, m) -> (s, r + 1, m)
328 return li
329
330 | LiveInstr instr _ <- li
331 , Just _ <- takeRegRegMoveInstr instr
332 = do modify $ \(s, r, m) -> (s, r, m + 1)
333 return li
334
335 | otherwise
336 = return li
337
338
339 -- sigh..
340 addSRM :: (Int, Int, Int) -> (Int, Int, Int) -> (Int, Int, Int)
341 addSRM (s1, r1, m1) (s2, r2, m2)
342 = let !s = s1 + s2
343 !r = r1 + r2
344 !m = m1 + m2
345 in (s, r, m)
346