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 , raCoalesced :: UniqFM Reg -- ^ the regs that were coaleced
56 , raSpillStats :: SpillStats -- ^ spiller stats
57 , raLifetimes :: UniqFM (Reg, Int) -- ^ number of instrs each reg lives for
58 , raSpilled :: [LiveCmmTop] } -- ^ code with spill instructions added
60 -- a successful coloring
61 | RegAllocStatsColored
62 { raGraph :: Color.Graph Reg RegClass Reg -- ^ the colored graph
63 , raCoalesced :: UniqFM Reg -- ^ the regs that were coaleced
64 , raPatched :: [LiveCmmTop] -- ^ code with vregs replaced by hregs
65 , raSpillClean :: [LiveCmmTop] -- ^ code with unneeded spill/reloads cleaned out
66 , raFinal :: [NatCmmTop] -- ^ final code
67 , raSRMs :: (Int, Int, Int) } -- ^ spill/reload/reg-reg moves present in this code
69 instance Outputable RegAllocStats where
71 ppr (s@RegAllocStatsStart{})
73 $$ text "# Native code with liveness information."
76 $$ text "# Initial register conflict graph."
77 $$ Color.dotGraph regDotColor trivColorable (raGraph s)
80 ppr (s@RegAllocStatsSpill{})
83 $$ text "# Register conflict graph."
84 $$ Color.dotGraph regDotColor trivColorable (raGraph s)
87 $$ (if (not $ isNullUFM $ raCoalesced s)
88 then text "# Registers coalesced."
89 $$ (vcat $ map ppr $ ufmToList $ raCoalesced s)
93 $$ text "# Spills inserted."
94 $$ ppr (raSpillStats s)
97 $$ text "# Code with spills inserted."
98 $$ (ppr (raSpilled s))
101 ppr (s@RegAllocStatsColored { raSRMs = (spills, reloads, moves) })
104 $$ text "# Register conflict graph."
105 $$ Color.dotGraph regDotColor trivColorable (raGraph s)
108 $$ (if (not $ isNullUFM $ raCoalesced s)
109 then text "# Registers coalesced."
110 $$ (vcat $ map ppr $ ufmToList $ raCoalesced s)
114 $$ text "# Native code after register allocation."
118 $$ text "# Clean out unneeded spill/reloads."
119 $$ ppr (raSpillClean s)
122 $$ text "# Final code, after rewriting spill/rewrite pseudo instrs."
126 $$ (text "# spills inserted: " <> int spills)
127 $$ (text "# reloads inserted: " <> int reloads)
128 $$ (text "# reg-reg moves remaining: " <> int moves)
131 -- | Do all the different analysis on this list of RegAllocStats
132 pprStats :: [RegAllocStats] -> Color.Graph Reg RegClass Reg -> SDoc
134 = let outSpills = pprStatsSpills stats
135 outLife = pprStatsLifetimes stats
136 outConflict = pprStatsConflict stats
137 outScatter = pprStatsLifeConflict stats graph
139 in vcat [outSpills, outLife, outConflict, outScatter]
142 -- | Dump a table of how many spill loads / stores were inserted for each vreg.
144 :: [RegAllocStats] -> SDoc
148 finals = [ s | s@RegAllocStatsColored{} <- stats]
150 -- sum up how many stores/loads/reg-reg-moves were left in the code
151 total = foldl' addSRM (0, 0, 0)
154 in ( text "-- spills-added-total"
155 $$ text "-- (stores, loads, reg_reg_moves_remaining)"
160 -- | Dump a table of how long vregs tend to live for in the initial code.
162 :: [RegAllocStats] -> SDoc
164 pprStatsLifetimes stats
165 = let lifeMap = foldl' plusUFM emptyUFM
166 [ raLifetimes s | s@RegAllocStatsStart{} <- stats ]
167 lifeBins = binLifetimeCount lifeMap
169 in ( text "-- vreg-population-lifetimes"
170 $$ text "-- (instruction_count, number_of_vregs_that_lived_that_long)"
171 $$ (vcat $ map ppr $ eltsUFM lifeBins)
174 binLifetimeCount :: UniqFM (Reg, Int) -> UniqFM (Int, Int)
176 = let lifes = map (\l -> (l, (l, 1)))
181 (\(l1, c1) (l2, c2) -> (l1, c1 + c2))
186 -- | Dump a table of how many conflicts vregs tend to have in the initial code.
188 :: [RegAllocStats] -> SDoc
190 pprStatsConflict stats
191 = let confMap = foldl' (plusUFM_C (\(c1, n1) (c2, n2) -> (c1, n1 + n2)))
193 $ map Color.slurpNodeConflictCount
194 [ raGraph s | s@RegAllocStatsStart{} <- stats ]
196 in ( text "-- vreg-conflicts"
197 $$ text "-- (conflict_count, number_of_vregs_that_had_that_many_conflicts)"
198 $$ (vcat $ map ppr $ eltsUFM confMap)
202 -- | For every vreg, dump it's how many conflicts it has and its lifetime
203 -- good for making a scatter plot.
206 -> Color.Graph Reg RegClass Reg -- ^ global register conflict graph
209 pprStatsLifeConflict stats graph
210 = let lifeMap = foldl' plusUFM emptyUFM
211 [ raLifetimes s | s@RegAllocStatsStart{} <- stats ]
213 scatter = map (\r -> let lifetime = case lookupUFM lifeMap r of
216 Just node = Color.lookupNode graph r
217 in parens $ hcat $ punctuate (text ", ")
218 [ doubleQuotes $ ppr $ Color.nodeId node
219 , ppr $ sizeUniqSet (Color.nodeConflicts node)
223 $ Color.graphMap graph
225 in ( text "-- vreg-conflict-lifetime"
226 $$ text "-- (vreg, vreg_conflicts, vreg_lifetime)"
231 -- | Count spill/reload/reg-reg moves.
232 -- Lets us see how well the register allocator has done.
234 countSRMs :: LiveCmmTop -> (Int, Int, Int)
236 = execState (mapBlockTopM countSRM_block cmm) (0, 0, 0)
238 countSRM_block (BasicBlock i instrs)
239 = do instrs' <- mapM countSRM_instr instrs
240 return $ BasicBlock i instrs'
242 countSRM_instr li@(Instr instr live)
243 | SPILL reg slot <- instr
244 = do modify $ \(s, r, m) -> (s + 1, r, m)
247 | RELOAD slot reg <- instr
248 = do modify $ \(s, r, m) -> (s, r + 1, m)
251 | Just _ <- isRegRegMove instr
252 = do modify $ \(s, r, m) -> (s, r, m + 1)
259 addSRM (s1, r1, m1) (s2, r2, m2)
260 = (s1+s2, r1+r2, m1+m2)
263 -- Register colors for drawing conflict graphs
264 -- Keep this out of MachRegs.hs because it's specific to the graph coloring allocator.
267 -- reg colors for x86
269 regDotColor :: Reg -> SDoc
271 = let Just str = lookupUFM regColors reg
286 , (fake5, "#5500ff") ]
290 -- reg colors for x86_64
291 #if x86_64_TARGET_ARCH
292 regDotColor :: Reg -> SDoc
294 = let Just str = lookupUFM regColors reg
299 $ [ (rax, "#00ff00"), (eax, "#00ff00")
300 , (rbx, "#0000ff"), (ebx, "#0000ff")
301 , (rcx, "#00ffff"), (ecx, "#00ffff")
302 , (rdx, "#0080ff"), (edx, "#00ffff")
312 ++ zip (map RealReg [16..31]) (repeat "red")
316 -- reg colors for ppc
317 #if powerpc_TARGET_ARCH
318 regDotColor :: Reg -> SDoc
320 = case regClass reg of
321 RcInteger -> text "blue"
322 RcFloat -> text "red"
328 = let rs = padL 2 '0' (showHex r "")
329 gs = padL 2 '0' (showHex r "")
330 bs = padL 2 '0' (showHex r "")
333 = replicate (n - length s) c ++ s
334 in "#" ++ rs ++ gs ++ bs