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
42 { raLiveCmm :: [LiveCmmTop] -- ^ initial code, with liveness
43 , raGraph :: Color.Graph Reg RegClass Reg -- ^ the initial, uncolored graph
44 , raLifetimes :: UniqFM (Reg, Int) } -- ^ number of instrs each reg lives for
48 { raGraph :: Color.Graph Reg RegClass Reg -- ^ the partially colored graph
49 , raCoalesced :: UniqFM Reg -- ^ the regs that were coaleced
50 , raSpillStats :: SpillStats -- ^ spiller stats
51 , raLifetimes :: UniqFM (Reg, Int) -- ^ number of instrs each reg lives for
52 , raSpilled :: [LiveCmmTop] } -- ^ code with spill instructions added
54 -- a successful coloring
55 | RegAllocStatsColored
56 { raGraph :: Color.Graph Reg RegClass Reg -- ^ the colored graph
57 , raCoalesced :: UniqFM Reg -- ^ the regs that were coaleced
58 , raPatched :: [LiveCmmTop] -- ^ code with vregs replaced by hregs
59 , raSpillClean :: [LiveCmmTop] -- ^ code with unneeded spill/reloads cleaned out
60 , raFinal :: [NatCmmTop] -- ^ final code
61 , raSRMs :: (Int, Int, Int) } -- ^ spill/reload/reg-reg moves present in this code
63 instance Outputable RegAllocStats where
65 ppr (s@RegAllocStatsStart{})
67 $$ text "# Native code with liveness information."
70 $$ text "# Initial register conflict graph."
71 $$ Color.dotGraph regDotColor trivColorable (raGraph s)
74 ppr (s@RegAllocStatsSpill{})
77 $$ text "# Register conflict graph."
78 $$ Color.dotGraph regDotColor trivColorable (raGraph s)
81 $$ (if (not $ isNullUFM $ raCoalesced s)
82 then text "# Registers coalesced."
83 $$ (vcat $ map ppr $ ufmToList $ raCoalesced s)
87 $$ text "# Spills inserted."
88 $$ ppr (raSpillStats s)
91 $$ text "# Code with spills inserted."
92 $$ (ppr (raSpilled s))
95 ppr (s@RegAllocStatsColored { raSRMs = (spills, reloads, moves) })
98 $$ text "# Register conflict graph."
99 $$ Color.dotGraph regDotColor trivColorable (raGraph s)
102 $$ (if (not $ isNullUFM $ raCoalesced s)
103 then text "# Registers coalesced."
104 $$ (vcat $ map ppr $ ufmToList $ raCoalesced s)
108 $$ text "# Native code after register allocation."
112 $$ text "# Clean out unneeded spill/reloads."
113 $$ ppr (raSpillClean s)
116 $$ text "# Final code, after rewriting spill/rewrite pseudo instrs."
120 $$ (text "# spills inserted: " <> int spills)
121 $$ (text "# reloads inserted: " <> int reloads)
122 $$ (text "# reg-reg moves remaining: " <> int moves)
125 -- | Do all the different analysis on this list of RegAllocStats
126 pprStats :: [RegAllocStats] -> Color.Graph Reg RegClass Reg -> SDoc
128 = let outSpills = pprStatsSpills stats
129 outLife = pprStatsLifetimes stats
130 outConflict = pprStatsConflict stats
131 outScatter = pprStatsLifeConflict stats graph
133 in vcat [outSpills, outLife, outConflict, outScatter]
136 -- | Dump a table of how many spill loads / stores were inserted for each vreg.
138 :: [RegAllocStats] -> SDoc
142 finals = [ s | s@RegAllocStatsColored{} <- stats]
144 -- sum up how many stores/loads/reg-reg-moves were left in the code
145 total = foldl' addSRM (0, 0, 0)
148 in ( text "-- spills-added-total"
149 $$ text "-- (stores, loads, reg_reg_moves_remaining)"
154 -- | Dump a table of how long vregs tend to live for in the initial code.
156 :: [RegAllocStats] -> SDoc
158 pprStatsLifetimes stats
159 = let lifeMap = foldl' plusUFM emptyUFM
160 [ raLifetimes s | s@RegAllocStatsStart{} <- stats ]
161 lifeBins = binLifetimeCount lifeMap
163 in ( text "-- vreg-population-lifetimes"
164 $$ text "-- (instruction_count, number_of_vregs_that_lived_that_long)"
165 $$ (vcat $ map ppr $ eltsUFM lifeBins)
168 binLifetimeCount :: UniqFM (Reg, Int) -> UniqFM (Int, Int)
170 = let lifes = map (\l -> (l, (l, 1)))
175 (\(l1, c1) (_, c2) -> (l1, c1 + c2))
180 -- | Dump a table of how many conflicts vregs tend to have in the initial code.
182 :: [RegAllocStats] -> SDoc
184 pprStatsConflict stats
185 = let confMap = foldl' (plusUFM_C (\(c1, n1) (_, n2) -> (c1, n1 + n2)))
187 $ map Color.slurpNodeConflictCount
188 [ raGraph s | s@RegAllocStatsStart{} <- stats ]
190 in ( text "-- vreg-conflicts"
191 $$ text "-- (conflict_count, number_of_vregs_that_had_that_many_conflicts)"
192 $$ (vcat $ map ppr $ eltsUFM confMap)
196 -- | For every vreg, dump it's how many conflicts it has and its lifetime
197 -- good for making a scatter plot.
200 -> Color.Graph Reg RegClass Reg -- ^ global register conflict graph
203 pprStatsLifeConflict stats graph
204 = let lifeMap = foldl' plusUFM emptyUFM
205 [ raLifetimes s | s@RegAllocStatsStart{} <- stats ]
207 scatter = map (\r -> let lifetime = case lookupUFM lifeMap r of
210 Just node = Color.lookupNode graph r
211 in parens $ hcat $ punctuate (text ", ")
212 [ doubleQuotes $ ppr $ Color.nodeId node
213 , ppr $ sizeUniqSet (Color.nodeConflicts node)
217 $ Color.graphMap graph
219 in ( text "-- vreg-conflict-lifetime"
220 $$ text "-- (vreg, vreg_conflicts, vreg_lifetime)"
225 -- | Count spill/reload/reg-reg moves.
226 -- Lets us see how well the register allocator has done.
228 countSRMs :: LiveCmmTop -> (Int, Int, Int)
230 = execState (mapBlockTopM countSRM_block cmm) (0, 0, 0)
232 countSRM_block (BasicBlock i instrs)
233 = do instrs' <- mapM countSRM_instr instrs
234 return $ BasicBlock i instrs'
236 countSRM_instr li@(Instr instr _)
238 = do modify $ \(s, r, m) -> (s + 1, r, m)
241 | RELOAD _ _ <- instr
242 = do modify $ \(s, r, m) -> (s, r + 1, m)
245 | Just _ <- isRegRegMove instr
246 = do modify $ \(s, r, m) -> (s, r, m + 1)
253 addSRM (s1, r1, m1) (s2, r2, m2)
254 = (s1+s2, r1+r2, m1+m2)
257 -- Register colors for drawing conflict graphs
258 -- Keep this out of MachRegs.hs because it's specific to the graph coloring allocator.
261 -- reg colors for x86
263 regDotColor :: Reg -> SDoc
265 = let Just str = lookupUFM regColors reg
280 , (fake5, "#5500ff") ]
284 -- reg colors for x86_64
285 #if x86_64_TARGET_ARCH
286 regDotColor :: Reg -> SDoc
288 = let Just str = lookupUFM regColors reg
293 $ [ (rax, "#00ff00"), (eax, "#00ff00")
294 , (rbx, "#0000ff"), (ebx, "#0000ff")
295 , (rcx, "#00ffff"), (ecx, "#00ffff")
296 , (rdx, "#0080ff"), (edx, "#00ffff")
306 ++ zip (map RealReg [16..31]) (repeat "red")
310 -- reg colors for ppc
311 #if powerpc_TARGET_ARCH
312 regDotColor :: Reg -> SDoc
314 = case regClass reg of
315 RcInteger -> text "blue"
316 RcFloat -> text "red"
322 = let rs = padL 2 '0' (showHex r "")
323 gs = padL 2 '0' (showHex r "")
324 bs = padL 2 '0' (showHex r "")
327 = replicate (n - length s) c ++ s
328 in "#" ++ rs ++ gs ++ bs