1 -- | Graph coloring register allocator.
4 -- Live range splitting:
5 -- At the moment regs that are spilled are spilled for all time, even though
6 -- we might be able to allocate them a hardreg in different parts of the code.
8 -- As we're aggressively coalescing before register allocation proper we're not currently
9 -- using the coalescence information present in the graph.
11 -- The function that choosing the potential spills could be a bit cleverer.
13 -- Colors in graphviz graphs could be nicer.
16 module RegAllocColor (
23 #include "nativeGen/NCG.h"
25 import qualified GraphColor as Color
43 -- | The maximum number of build/spill cycles we'll allow.
44 -- We should only need 3 or 4 cycles tops.
45 -- If we run for any longer than this we're probably in an infinite loop,
46 -- It's probably better just to bail out and report a bug at this stage.
51 -- | The top level of the graph coloring register allocator.
54 :: UniqFM (UniqSet Reg) -- ^ the registers we can use for allocation
55 -> UniqSet Int -- ^ the set of available spill slots.
56 -> [LiveCmmTop] -- ^ code annotated with liveness information.
58 ( [NatCmmTop] -- ^ code with registers allocated.
60 , Color.Graph Reg RegClass Reg) ]) -- ^ code and graph for each pass
62 regAlloc regsFree slotsFree code
64 (code_final, debug_codeGraphs, graph_final)
65 <- regAlloc_spin 0 trivColorable regsFree slotsFree [] code
70 regAlloc_spin (spinCount :: Int) triv regsFree slotsFree debug_codeGraphs code
72 -- check that we're not running off down the garden path.
73 when (spinCount > maxSpinCount)
74 $ pprPanic "regAlloc_spin: max build/spill cycle count exceeded."
75 ( text "It looks like the register allocator is stuck in an infinite loop."
76 $$ text "max cycles = " <> int maxSpinCount
77 $$ text "regsFree = " <> (hcat $ punctuate space $ map (docToSDoc . pprUserReg)
78 $ uniqSetToList $ unionManyUniqSets $ eltsUFM regsFree)
79 $$ text "slotsFree = " <> ppr (sizeUniqSet slotsFree))
81 -- build a conflict graph from the code.
82 graph <- buildGraph code
84 -- build a map of how many instructions each reg lives for
85 -- this lazy, it won't be computed unless we need to spill
86 let fmLife = plusUFMs_C (\(r1, l1) (r2, l2) -> (r1, l1 + l2))
87 $ map lifetimeCount code
89 -- the function to choose regs to leave uncolored
90 let spill = chooseSpill_maxLife fmLife
92 -- try and color the graph
93 let (graph_colored, rsSpill)
94 = Color.colorGraph regsFree triv spill graph
96 -- see if we've found a coloring
97 if isEmptyUniqSet rsSpill
99 -- patch the registers using the info in the graph
100 let code_patched = map (patchRegsFromGraph graph_colored) code
101 let code_nat = map stripLive code_patched
104 , debug_codeGraphs ++ [(code, graph_colored), (code_patched, graph_colored)]
108 -- spill the uncolored regs
109 (code_spilled, slotsFree')
110 <- regSpill code slotsFree rsSpill
112 -- recalculate liveness
113 let code_nat = map stripLive code_spilled
114 code_relive <- mapM regLiveness code_nat
117 regAlloc_spin (spinCount + 1) triv regsFree slotsFree'
118 (debug_codeGraphs ++ [(code, graph_colored)])
123 -- Simple maxconflicts isn't always good, because we
124 -- can naievely end up spilling vregs that only live for one or two instrs.
127 chooseSpill_maxConflicts
128 :: Color.Graph Reg RegClass Reg
131 chooseSpill_maxConflicts graph
132 = let node = maximumBy
134 (sizeUniqSet $ Color.nodeConflicts n1)
135 (sizeUniqSet $ Color.nodeConflicts n2))
136 $ eltsUFM $ Color.graphMap graph
144 -> Color.Graph Reg RegClass Reg
147 chooseSpill_maxLife life graph
148 = let node = maximumBy (\n1 n2 -> compare (getLife n1) (getLife n2))
149 $ eltsUFM $ Color.graphMap graph
151 -- Orphan vregs die in the same instruction they are born in.
152 -- They will be in the graph, but not in the liveness map.
153 -- Their liveness is 0.
155 = case lookupUFM life (Color.nodeId n) of
162 -- | Build a graph from the liveness and coalesce information in this code.
166 -> UniqSM (Color.Graph Reg RegClass Reg)
170 -- Add the reg-reg conflicts to the graph
171 let conflictSets = unionManyBags (map slurpConflicts code)
172 let graph_conflict = foldrBag graphAddConflictSet Color.initGraph conflictSets
175 -- Add the coalescences edges to the graph.
176 let coalesce = unionManyBags (map slurpJoinMovs code)
177 let graph_coalesce = foldrBag graphAddCoalesce graph_conflict coalesce
179 return $ graph_coalesce
182 -- | Add some conflict edges to the graph.
183 -- Conflicts between virtual and real regs are recorded as exlusions.
187 -> Color.Graph Reg RegClass Reg
188 -> Color.Graph Reg RegClass Reg
190 graphAddConflictSet set graph
191 = let reals = filterUFM isRealReg set
192 virtuals = filterUFM (not . isRealReg) set
194 graph1 = Color.addConflicts virtuals regClass graph
195 graph2 = foldr (\(r1, r2) -> Color.addExclusion r1 regClass r2)
198 | a <- uniqSetToList virtuals
199 , b <- uniqSetToList reals]
204 -- | Add some coalesences edges to the graph
205 -- Coalesences between virtual and real regs are recorded as preferences.
209 -> Color.Graph Reg RegClass Reg
210 -> Color.Graph Reg RegClass Reg
212 graphAddCoalesce (r1, r2) graph
213 | RealReg regno <- r1
214 = Color.addPreference (regWithClass r2) r1 graph
216 | RealReg regno <- r2
217 = Color.addPreference (regWithClass r1) r2 graph
220 = Color.addCoalesce (regWithClass r1) (regWithClass r2) graph
222 where regWithClass r = (r, regClass r)
225 -- | Patch registers in code using the reg -> reg mapping in this graph.
227 :: Color.Graph Reg RegClass Reg
228 -> LiveCmmTop -> LiveCmmTop
230 patchRegsFromGraph graph code
232 -- a function to lookup the hardreg for a virtual reg from the graph.
234 -- leave real regs alone.
238 -- this virtual has a regular node in the graph.
239 | Just node <- Color.lookupNode graph reg
240 = case Color.nodeColor node of
244 -- no node in the graph for this virtual, bad news.
246 = pprPanic "patchRegsFromGraph: register mapping failed."
247 ( text "There is no node in the graph for register " <> ppr reg
249 $$ Color.dotGraph (\x -> text "white") trivColorable graph)
251 in patchEraseLive patchF code
255 -- Register colors for drawing conflict graphs
256 -- Keep this out of MachRegs.hs because it's specific to the graph coloring allocator.
259 -- reg colors for x86
261 regDotColor :: Reg -> SDoc
263 = let Just str = lookupUFM regColors reg
278 , (fake5, "#5500ff") ]
282 -- reg colors for x86_64
283 #if x86_64_TARGET_ARCH
284 regDotColor :: Reg -> SDoc
286 = let Just str = lookupUFM regColors reg
291 $ [ (rax, "#00ff00"), (eax, "#00ff00")
292 , (rbx, "#0000ff"), (ebx, "#0000ff")
293 , (rcx, "#00ffff"), (ecx, "#00ffff")
294 , (rdx, "#0080ff"), (edx, "#00ffff")
304 ++ zip (map RealReg [16..31]) (repeat "red")
308 -- reg colors for ppc
309 #if powerpc_TARGET_ARCH
310 regDotColor :: Reg -> SDoc
312 = case regClass reg of
313 RcInteger -> text "blue"
314 RcFloat -> text "red"
320 = let rs = padL 2 '0' (showHex r "")
321 gs = padL 2 '0' (showHex r "")
322 bs = padL 2 '0' (showHex r "")
325 = replicate (n - length s) c ++ s
326 in "#" ++ rs ++ gs ++ bs
329 plusUFMs_C :: (elt -> elt -> elt) -> [UniqFM elt] -> UniqFM elt
331 = foldl (plusUFM_C f) emptyUFM maps