2 -- Carries interesting info for debugging / profiling of the
3 -- graph coloring register allocator.
6 -- The above warning supression flag is a temporary kludge.
7 -- While working on this module you are encouraged to remove it and fix
8 -- any warnings in the module. See
9 -- http://hackage.haskell.org/trac/ghc/wiki/WorkingConventions#Warnings
12 module RegAllocStats (
27 #include "nativeGen/NCG.h"
29 import qualified GraphColor as Color
48 { raLiveCmm :: [LiveCmmTop] -- ^ initial code, with liveness
49 , raGraph :: Color.Graph Reg RegClass Reg -- ^ the initial, uncolored graph
50 , raLifetimes :: UniqFM (Reg, Int) } -- ^ number of instrs each reg lives for
54 { raGraph :: Color.Graph Reg RegClass Reg -- ^ the partially colored graph
55 , raSpillStats :: SpillStats -- ^ spiller stats
56 , raLifetimes :: UniqFM (Reg, Int) -- ^ number of instrs each reg lives for
57 , raSpilled :: [LiveCmmTop] } -- ^ code with spill instructions added
59 -- a successful coloring
60 | RegAllocStatsColored
61 { raGraph :: Color.Graph Reg RegClass Reg -- ^ the colored graph
62 , raPatched :: [LiveCmmTop] -- ^ code with vregs replaced by hregs
63 , raSpillClean :: [LiveCmmTop] -- ^ code with unneeded spill/reloads cleaned out
64 , raFinal :: [NatCmmTop] -- ^ final code
65 , raSRMs :: (Int, Int, Int) } -- ^ spill/reload/reg-reg moves present in this code
67 instance Outputable RegAllocStats where
69 ppr (s@RegAllocStatsStart{})
71 $$ text "# Native code with liveness information."
74 $$ text "# Initial register conflict graph."
75 $$ Color.dotGraph regDotColor trivColorable (raGraph s)
77 ppr (s@RegAllocStatsSpill{})
79 $$ text "# Register conflict graph."
80 $$ Color.dotGraph regDotColor trivColorable (raGraph s)
82 $$ text "# Spills inserted."
83 $$ ppr (raSpillStats s)
85 $$ text "# Code with spills inserted."
86 $$ (ppr (raSpilled s))
88 ppr (s@RegAllocStatsColored { raSRMs = (spills, reloads, moves) })
90 $$ text "# Register conflict graph."
91 $$ Color.dotGraph regDotColor trivColorable (raGraph s)
93 $$ text "# Native code after register allocation."
96 $$ text "# Clean out unneeded spill/reloads."
97 $$ ppr (raSpillClean s)
99 $$ text "# Final code, after rewriting spill/rewrite pseudo instrs."
103 $$ (text "# spills inserted: " <> int spills)
104 $$ (text "# reloads inserted: " <> int reloads)
105 $$ (text "# reg-reg moves remaining: " <> int moves)
108 -- | Do all the different analysis on this list of RegAllocStats
109 pprStats :: [RegAllocStats] -> Color.Graph Reg RegClass Reg -> SDoc
111 = let outSpills = pprStatsSpills stats
112 outLife = pprStatsLifetimes stats
113 outConflict = pprStatsConflict stats
114 outScatter = pprStatsLifeConflict stats graph
116 in vcat [outSpills, outLife, outConflict, outScatter]
119 -- | Dump a table of how many spill loads / stores were inserted for each vreg.
121 :: [RegAllocStats] -> SDoc
125 finals = [ s | s@RegAllocStatsColored{} <- stats]
127 -- sum up how many stores/loads/reg-reg-moves were left in the code
128 total = foldl' addSRM (0, 0, 0)
131 in ( text "-- spills-added-total"
132 $$ text "-- (stores, loads, reg_reg_moves_remaining)"
137 -- | Dump a table of how long vregs tend to live for in the initial code.
139 :: [RegAllocStats] -> SDoc
141 pprStatsLifetimes stats
142 = let lifeMap = foldl' plusUFM emptyUFM
143 [ raLifetimes s | s@RegAllocStatsStart{} <- stats ]
144 lifeBins = binLifetimeCount lifeMap
146 in ( text "-- vreg-population-lifetimes"
147 $$ text "-- (instruction_count, number_of_vregs_that_lived_that_long)"
148 $$ (vcat $ map ppr $ eltsUFM lifeBins)
151 binLifetimeCount :: UniqFM (Reg, Int) -> UniqFM (Int, Int)
153 = let lifes = map (\l -> (l, (l, 1)))
158 (\(l1, c1) (l2, c2) -> (l1, c1 + c2))
163 -- | Dump a table of how many conflicts vregs tend to have in the initial code.
165 :: [RegAllocStats] -> SDoc
167 pprStatsConflict stats
168 = let confMap = foldl' (plusUFM_C (\(c1, n1) (c2, n2) -> (c1, n1 + n2)))
170 $ map Color.slurpNodeConflictCount
171 [ raGraph s | s@RegAllocStatsStart{} <- stats ]
173 in ( text "-- vreg-conflicts"
174 $$ text "-- (conflict_count, number_of_vregs_that_had_that_many_conflicts)"
175 $$ (vcat $ map ppr $ eltsUFM confMap)
179 -- | For every vreg, dump it's how many conflicts it has and its lifetime
180 -- good for making a scatter plot.
183 -> Color.Graph Reg RegClass Reg -- ^ global register conflict graph
186 pprStatsLifeConflict stats graph
187 = let lifeMap = foldl' plusUFM emptyUFM
188 [ raLifetimes s | s@RegAllocStatsStart{} <- stats ]
190 scatter = map (\r -> let lifetime = case lookupUFM lifeMap r of
193 Just node = Color.lookupNode graph r
194 in parens $ hcat $ punctuate (text ", ")
195 [ doubleQuotes $ ppr $ Color.nodeId node
196 , ppr $ sizeUniqSet (Color.nodeConflicts node)
200 $ Color.graphMap graph
202 in ( text "-- vreg-conflict-lifetime"
203 $$ text "-- (vreg, vreg_conflicts, vreg_lifetime)"
208 -- | Count spill/reload/reg-reg moves.
209 -- Lets us see how well the register allocator has done.
211 countSRMs :: LiveCmmTop -> (Int, Int, Int)
213 = execState (mapBlockTopM countSRM_block cmm) (0, 0, 0)
215 countSRM_block (BasicBlock i instrs)
216 = do instrs' <- mapM countSRM_instr instrs
217 return $ BasicBlock i instrs'
219 countSRM_instr li@(Instr instr live)
220 | SPILL reg slot <- instr
221 = do modify $ \(s, r, m) -> (s + 1, r, m)
224 | RELOAD slot reg <- instr
225 = do modify $ \(s, r, m) -> (s, r + 1, m)
228 | Just _ <- isRegRegMove instr
229 = do modify $ \(s, r, m) -> (s, r, m + 1)
236 addSRM (s1, r1, m1) (s2, r2, m2)
237 = (s1+s2, r1+r2, m1+m2)
240 -- Register colors for drawing conflict graphs
241 -- Keep this out of MachRegs.hs because it's specific to the graph coloring allocator.
244 -- reg colors for x86
246 regDotColor :: Reg -> SDoc
248 = let Just str = lookupUFM regColors reg
263 , (fake5, "#5500ff") ]
267 -- reg colors for x86_64
268 #if x86_64_TARGET_ARCH
269 regDotColor :: Reg -> SDoc
271 = let Just str = lookupUFM regColors reg
276 $ [ (rax, "#00ff00"), (eax, "#00ff00")
277 , (rbx, "#0000ff"), (ebx, "#0000ff")
278 , (rcx, "#00ffff"), (ecx, "#00ffff")
279 , (rdx, "#0080ff"), (edx, "#00ffff")
289 ++ zip (map RealReg [16..31]) (repeat "red")
293 -- reg colors for ppc
294 #if powerpc_TARGET_ARCH
295 regDotColor :: Reg -> SDoc
297 = case regClass reg of
298 RcInteger -> text "blue"
299 RcFloat -> text "red"
305 = let rs = padL 2 '0' (showHex r "")
306 gs = padL 2 '0' (showHex r "")
307 bs = padL 2 '0' (showHex r "")
310 = replicate (n - length s) c ++ s
311 in "#" ++ rs ++ gs ++ bs