1 {-# OPTIONS -fno-warn-missing-signatures #-}
2 -- Carries interesting info for debugging / profiling of the
3 -- graph coloring register allocator.
21 #include "nativeGen/NCG.h"
23 import qualified GraphColor as Color
43 { raLiveCmm :: [LiveCmmTop] -- ^ initial code, with liveness
44 , raGraph :: Color.Graph Reg RegClass Reg -- ^ the initial, uncolored graph
45 , raSpillCosts :: SpillCostInfo } -- ^ information to help choose which regs to spill
49 { raGraph :: Color.Graph Reg RegClass Reg -- ^ the partially colored graph
50 , raCoalesced :: UniqFM Reg -- ^ the regs that were coaleced
51 , raSpillStats :: SpillStats -- ^ spiller stats
52 , raSpillCosts :: SpillCostInfo -- ^ number of instrs each reg lives for
53 , raSpilled :: [LiveCmmTop] } -- ^ code with spill instructions added
55 -- a successful coloring
56 | RegAllocStatsColored
57 { raGraph :: Color.Graph Reg RegClass Reg -- ^ the uncolored graph
58 , raGraphColored :: Color.Graph Reg RegClass Reg -- ^ the coalesced and colored graph
59 , raCoalesced :: UniqFM Reg -- ^ the regs that were coaleced
60 , raPatched :: [LiveCmmTop] -- ^ code with vregs replaced by hregs
61 , raSpillClean :: [LiveCmmTop] -- ^ code with unneeded spill/reloads cleaned out
62 , raFinal :: [NatCmmTop] -- ^ final code
63 , raSRMs :: (Int, Int, Int) } -- ^ spill/reload/reg-reg moves present in this code
65 instance Outputable RegAllocStats where
67 ppr (s@RegAllocStatsStart{})
69 $$ text "# Native code with liveness information."
72 $$ text "# Initial register conflict graph."
73 $$ Color.dotGraph regDotColor trivColorable (raGraph s)
76 ppr (s@RegAllocStatsSpill{})
79 $$ text "# Register conflict graph."
80 $$ Color.dotGraph regDotColor trivColorable (raGraph s)
83 $$ (if (not $ isNullUFM $ raCoalesced s)
84 then text "# Registers coalesced."
85 $$ (vcat $ map ppr $ ufmToList $ raCoalesced s)
89 $$ text "# Spill costs. reg uses defs lifetime degree cost"
90 $$ vcat (map (pprSpillCostRecord (raGraph s)) $ eltsUFM $ raSpillCosts 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 (initial)."
105 $$ Color.dotGraph regDotColor trivColorable (raGraph s)
108 $$ text "# Register conflict graph (colored)."
109 $$ Color.dotGraph regDotColor trivColorable (raGraphColored s)
112 $$ (if (not $ isNullUFM $ raCoalesced s)
113 then text "# Registers coalesced."
114 $$ (vcat $ map ppr $ ufmToList $ raCoalesced s)
118 $$ text "# Native code after register allocation."
122 $$ text "# Clean out unneeded spill/reloads."
123 $$ ppr (raSpillClean s)
126 $$ text "# Final code, after rewriting spill/rewrite pseudo instrs."
130 $$ (text "# spills inserted: " <> int spills)
131 $$ (text "# reloads inserted: " <> int reloads)
132 $$ (text "# reg-reg moves remaining: " <> int moves)
135 -- | Do all the different analysis on this list of RegAllocStats
136 pprStats :: [RegAllocStats] -> Color.Graph Reg RegClass Reg -> SDoc
138 = let outSpills = pprStatsSpills stats
139 outLife = pprStatsLifetimes stats
140 outConflict = pprStatsConflict stats
141 outScatter = pprStatsLifeConflict stats graph
143 in vcat [outSpills, outLife, outConflict, outScatter]
146 -- | Dump a table of how many spill loads / stores were inserted for each vreg.
148 :: [RegAllocStats] -> SDoc
152 finals = [ s | s@RegAllocStatsColored{} <- stats]
154 -- sum up how many stores/loads/reg-reg-moves were left in the code
155 total = foldl' addSRM (0, 0, 0)
158 in ( text "-- spills-added-total"
159 $$ text "-- (stores, loads, reg_reg_moves_remaining)"
164 -- | Dump a table of how long vregs tend to live for in the initial code.
166 :: [RegAllocStats] -> SDoc
168 pprStatsLifetimes stats
169 = let info = foldl' plusSpillCostInfo zeroSpillCostInfo
171 | s@RegAllocStatsStart{} <- stats ]
173 lifeBins = binLifetimeCount $ lifeMapFromSpillCostInfo info
175 in ( text "-- vreg-population-lifetimes"
176 $$ text "-- (instruction_count, number_of_vregs_that_lived_that_long)"
177 $$ (vcat $ map ppr $ eltsUFM lifeBins)
180 binLifetimeCount :: UniqFM (Reg, Int) -> UniqFM (Int, Int)
182 = let lifes = map (\l -> (l, (l, 1)))
187 (\(l1, c1) (_, c2) -> (l1, c1 + c2))
192 -- | Dump a table of how many conflicts vregs tend to have in the initial code.
194 :: [RegAllocStats] -> SDoc
196 pprStatsConflict stats
197 = let confMap = foldl' (plusUFM_C (\(c1, n1) (_, n2) -> (c1, n1 + n2)))
199 $ map Color.slurpNodeConflictCount
200 [ raGraph s | s@RegAllocStatsStart{} <- stats ]
202 in ( text "-- vreg-conflicts"
203 $$ text "-- (conflict_count, number_of_vregs_that_had_that_many_conflicts)"
204 $$ (vcat $ map ppr $ eltsUFM confMap)
208 -- | For every vreg, dump it's how many conflicts it has and its lifetime
209 -- good for making a scatter plot.
212 -> Color.Graph Reg RegClass Reg -- ^ global register conflict graph
215 pprStatsLifeConflict stats graph
216 = let lifeMap = lifeMapFromSpillCostInfo
217 $ foldl' plusSpillCostInfo zeroSpillCostInfo
218 $ [ raSpillCosts s | s@RegAllocStatsStart{} <- stats ]
220 scatter = map (\r -> let lifetime = case lookupUFM lifeMap r of
223 Just node = Color.lookupNode graph r
224 in parens $ hcat $ punctuate (text ", ")
225 [ doubleQuotes $ ppr $ Color.nodeId node
226 , ppr $ sizeUniqSet (Color.nodeConflicts node)
230 $ Color.graphMap graph
232 in ( text "-- vreg-conflict-lifetime"
233 $$ text "-- (vreg, vreg_conflicts, vreg_lifetime)"
238 -- | Count spill/reload/reg-reg moves.
239 -- Lets us see how well the register allocator has done.
241 countSRMs :: LiveCmmTop -> (Int, Int, Int)
243 = execState (mapBlockTopM countSRM_block cmm) (0, 0, 0)
245 countSRM_block (BasicBlock i instrs)
246 = do instrs' <- mapM countSRM_instr instrs
247 return $ BasicBlock i instrs'
249 countSRM_instr li@(Instr instr _)
251 = do modify $ \(s, r, m) -> (s + 1, r, m)
254 | RELOAD _ _ <- instr
255 = do modify $ \(s, r, m) -> (s, r + 1, m)
258 | Just _ <- isRegRegMove instr
259 = do modify $ \(s, r, m) -> (s, r, m + 1)
266 addSRM (s1, r1, m1) (s2, r2, m2)
267 = (s1+s2, r1+r2, m1+m2)
270 -- Register colors for drawing conflict graphs
271 -- Keep this out of MachRegs.hs because it's specific to the graph coloring allocator.
274 -- reg colors for x86
276 regDotColor :: Reg -> SDoc
278 = let Just str = lookupUFM regColors reg
293 , (fake5, "#5500ff") ]
296 -- reg colors for x86_64
297 #elif x86_64_TARGET_ARCH
298 regDotColor :: Reg -> SDoc
300 = let Just str = lookupUFM regColors reg
305 $ [ (rax, "#00ff00"), (eax, "#00ff00")
306 , (rbx, "#0000ff"), (ebx, "#0000ff")
307 , (rcx, "#00ffff"), (ecx, "#00ffff")
308 , (rdx, "#0080ff"), (edx, "#00ffff")
318 ++ zip (map RealReg [16..31]) (repeat "red")
321 -- reg colors for ppc
322 #elif powerpc_TARGET_ARCH
323 regDotColor :: Reg -> SDoc
325 = case regClass reg of
326 RcInteger -> text "blue"
327 RcFloat -> text "red"
328 RcDouble -> text "green"
331 #error ToDo: regDotColor
337 = let rs = padL 2 '0' (showHex r "")
338 gs = padL 2 '0' (showHex r "")
339 bs = padL 2 '0' (showHex r "")
342 = replicate (n - length s) c ++ s
343 in "#" ++ rs ++ gs ++ bs