1 -- Carries interesting info for debugging / profiling of the
2 -- graph coloring register allocator.
4 {-# OPTIONS -fno-warn-missing-signatures #-}
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 colored graph
58 , raCoalesced :: UniqFM Reg -- ^ the regs that were coaleced
59 , raPatched :: [LiveCmmTop] -- ^ code with vregs replaced by hregs
60 , raSpillClean :: [LiveCmmTop] -- ^ code with unneeded spill/reloads cleaned out
61 , raFinal :: [NatCmmTop] -- ^ final code
62 , raSRMs :: (Int, Int, Int) } -- ^ spill/reload/reg-reg moves present in this code
64 instance Outputable RegAllocStats 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."
104 $$ Color.dotGraph regDotColor trivColorable (raGraph s)
107 $$ (if (not $ isNullUFM $ raCoalesced s)
108 then text "# Registers coalesced."
109 $$ (vcat $ map ppr $ ufmToList $ raCoalesced s)
113 $$ text "# Native code after register allocation."
117 $$ text "# Clean out unneeded spill/reloads."
118 $$ ppr (raSpillClean s)
121 $$ text "# Final code, after rewriting spill/rewrite pseudo instrs."
125 $$ (text "# spills inserted: " <> int spills)
126 $$ (text "# reloads inserted: " <> int reloads)
127 $$ (text "# reg-reg moves remaining: " <> int moves)
130 -- | Do all the different analysis on this list of RegAllocStats
131 pprStats :: [RegAllocStats] -> Color.Graph Reg RegClass Reg -> SDoc
133 = let outSpills = pprStatsSpills stats
134 outLife = pprStatsLifetimes stats
135 outConflict = pprStatsConflict stats
136 outScatter = pprStatsLifeConflict stats graph
138 in vcat [outSpills, outLife, outConflict, outScatter]
141 -- | Dump a table of how many spill loads / stores were inserted for each vreg.
143 :: [RegAllocStats] -> SDoc
147 finals = [ s | s@RegAllocStatsColored{} <- stats]
149 -- sum up how many stores/loads/reg-reg-moves were left in the code
150 total = foldl' addSRM (0, 0, 0)
153 in ( text "-- spills-added-total"
154 $$ text "-- (stores, loads, reg_reg_moves_remaining)"
159 -- | Dump a table of how long vregs tend to live for in the initial code.
161 :: [RegAllocStats] -> SDoc
163 pprStatsLifetimes stats
164 = let info = foldl' plusSpillCostInfo zeroSpillCostInfo
166 | s@RegAllocStatsStart{} <- stats ]
168 lifeBins = binLifetimeCount $ lifeMapFromSpillCostInfo info
170 in ( text "-- vreg-population-lifetimes"
171 $$ text "-- (instruction_count, number_of_vregs_that_lived_that_long)"
172 $$ (vcat $ map ppr $ eltsUFM lifeBins)
175 binLifetimeCount :: UniqFM (Reg, Int) -> UniqFM (Int, Int)
177 = let lifes = map (\l -> (l, (l, 1)))
182 (\(l1, c1) (_, c2) -> (l1, c1 + c2))
187 -- | Dump a table of how many conflicts vregs tend to have in the initial code.
189 :: [RegAllocStats] -> SDoc
191 pprStatsConflict stats
192 = let confMap = foldl' (plusUFM_C (\(c1, n1) (_, n2) -> (c1, n1 + n2)))
194 $ map Color.slurpNodeConflictCount
195 [ raGraph s | s@RegAllocStatsStart{} <- stats ]
197 in ( text "-- vreg-conflicts"
198 $$ text "-- (conflict_count, number_of_vregs_that_had_that_many_conflicts)"
199 $$ (vcat $ map ppr $ eltsUFM confMap)
203 -- | For every vreg, dump it's how many conflicts it has and its lifetime
204 -- good for making a scatter plot.
207 -> Color.Graph Reg RegClass Reg -- ^ global register conflict graph
210 pprStatsLifeConflict stats graph
211 = let lifeMap = lifeMapFromSpillCostInfo
212 $ foldl' plusSpillCostInfo zeroSpillCostInfo
213 $ [ raSpillCosts s | s@RegAllocStatsStart{} <- stats ]
215 scatter = map (\r -> let lifetime = case lookupUFM lifeMap r of
218 Just node = Color.lookupNode graph r
219 in parens $ hcat $ punctuate (text ", ")
220 [ doubleQuotes $ ppr $ Color.nodeId node
221 , ppr $ sizeUniqSet (Color.nodeConflicts node)
225 $ Color.graphMap graph
227 in ( text "-- vreg-conflict-lifetime"
228 $$ text "-- (vreg, vreg_conflicts, vreg_lifetime)"
233 -- | Count spill/reload/reg-reg moves.
234 -- Lets us see how well the register allocator has done.
236 countSRMs :: LiveCmmTop -> (Int, Int, Int)
238 = execState (mapBlockTopM countSRM_block cmm) (0, 0, 0)
240 countSRM_block (BasicBlock i instrs)
241 = do instrs' <- mapM countSRM_instr instrs
242 return $ BasicBlock i instrs'
244 countSRM_instr li@(Instr instr _)
246 = do modify $ \(s, r, m) -> (s + 1, r, m)
249 | RELOAD _ _ <- instr
250 = do modify $ \(s, r, m) -> (s, r + 1, m)
253 | Just _ <- isRegRegMove instr
254 = do modify $ \(s, r, m) -> (s, r, m + 1)
261 addSRM (s1, r1, m1) (s2, r2, m2)
262 = (s1+s2, r1+r2, m1+m2)
265 -- Register colors for drawing conflict graphs
266 -- Keep this out of MachRegs.hs because it's specific to the graph coloring allocator.
269 -- reg colors for x86
271 regDotColor :: Reg -> SDoc
273 = let Just str = lookupUFM regColors reg
288 , (fake5, "#5500ff") ]
292 -- reg colors for x86_64
293 #if x86_64_TARGET_ARCH
294 regDotColor :: Reg -> SDoc
296 = let Just str = lookupUFM regColors reg
301 $ [ (rax, "#00ff00"), (eax, "#00ff00")
302 , (rbx, "#0000ff"), (ebx, "#0000ff")
303 , (rcx, "#00ffff"), (ecx, "#00ffff")
304 , (rdx, "#0080ff"), (edx, "#00ffff")
314 ++ zip (map RealReg [16..31]) (repeat "red")
318 -- reg colors for ppc
319 #if powerpc_TARGET_ARCH
320 regDotColor :: Reg -> SDoc
322 = case regClass reg of
323 RcInteger -> text "blue"
324 RcFloat -> text "red"
330 = let rs = padL 2 '0' (showHex r "")
331 gs = padL 2 '0' (showHex r "")
332 bs = padL 2 '0' (showHex r "")
335 = replicate (n - length s) c ++ s
336 in "#" ++ rs ++ gs ++ bs