never executed always true always false
1 {-# LANGUAGE CPP #-}
2 {-# LANGUAGE ScopedTypeVariables #-}
3 {-# LANGUAGE MultiParamTypeClasses #-}
4 {-# LANGUAGE FlexibleInstances #-}
5 {-# LANGUAGE FlexibleContexts #-}
6
7
8 -- | Graph coloring register allocator.
9 module GHC.CmmToAsm.Reg.Graph (
10 regAlloc
11 ) where
12 import GHC.Prelude
13
14 import qualified GHC.Data.Graph.Color as Color
15 import GHC.CmmToAsm.Reg.Liveness
16 import GHC.CmmToAsm.Reg.Graph.Spill
17 import GHC.CmmToAsm.Reg.Graph.SpillClean
18 import GHC.CmmToAsm.Reg.Graph.SpillCost
19 import GHC.CmmToAsm.Reg.Graph.Stats
20 import GHC.CmmToAsm.Reg.Graph.TrivColorable
21 import GHC.CmmToAsm.Instr
22 import GHC.CmmToAsm.Reg.Target
23 import GHC.CmmToAsm.Config
24 import GHC.CmmToAsm.Types
25 import GHC.Platform.Reg.Class
26 import GHC.Platform.Reg
27
28 import GHC.Data.Bag
29 import GHC.Utils.Outputable
30 import GHC.Utils.Panic
31 import GHC.Platform
32 import GHC.Types.Unique.FM
33 import GHC.Types.Unique.Set
34 import GHC.Types.Unique.Supply
35 import GHC.Utils.Misc (seqList)
36 import GHC.CmmToAsm.CFG
37
38 import Data.Maybe
39 import Control.Monad
40
41
42 -- | The maximum number of build\/spill cycles we'll allow.
43 --
44 -- It should only take 3 or 4 cycles for the allocator to converge.
45 -- If it takes any longer than this it's probably in an infinite loop,
46 -- so it's better just to bail out and report a bug.
47 maxSpinCount :: Int
48 maxSpinCount = 10
49
50
51 -- | The top level of the graph coloring register allocator.
52 regAlloc
53 :: (OutputableP Platform statics, Instruction instr)
54 => NCGConfig
55 -> UniqFM RegClass (UniqSet RealReg) -- ^ registers we can use for allocation
56 -> UniqSet Int -- ^ set of available spill slots.
57 -> Int -- ^ current number of spill slots
58 -> [LiveCmmDecl statics instr] -- ^ code annotated with liveness information.
59 -> Maybe CFG -- ^ CFG of basic blocks if available
60 -> UniqSM ( [NatCmmDecl statics instr]
61 , Maybe Int, [RegAllocStats statics instr] )
62 -- ^ code with registers allocated, additional stacks required
63 -- and stats for each stage of allocation
64
65 regAlloc config regsFree slotsFree slotsCount code cfg
66 = do
67 let platform = ncgPlatform config
68 triv = trivColorable platform
69 (targetVirtualRegSqueeze platform)
70 (targetRealRegSqueeze platform)
71
72 (code_final, debug_codeGraphs, slotsCount', _)
73 <- regAlloc_spin config 0
74 triv
75 regsFree slotsFree slotsCount [] code cfg
76
77 let needStack
78 | slotsCount == slotsCount'
79 = Nothing
80 | otherwise
81 = Just slotsCount'
82
83 return ( code_final
84 , needStack
85 , reverse debug_codeGraphs )
86
87
88 -- | Perform solver iterations for the graph coloring allocator.
89 --
90 -- We extract a register conflict graph from the provided cmm code,
91 -- and try to colour it. If that works then we use the solution rewrite
92 -- the code with real hregs. If coloring doesn't work we add spill code
93 -- and try to colour it again. After `maxSpinCount` iterations we give up.
94 --
95 regAlloc_spin
96 :: forall instr statics.
97 (Instruction instr,
98 OutputableP Platform statics)
99 => NCGConfig
100 -> Int -- ^ Number of solver iterations we've already performed.
101 -> Color.Triv VirtualReg RegClass RealReg
102 -- ^ Function for calculating whether a register is trivially
103 -- colourable.
104 -> UniqFM RegClass (UniqSet RealReg) -- ^ Free registers that we can allocate.
105 -> UniqSet Int -- ^ Free stack slots that we can use.
106 -> Int -- ^ Number of spill slots in use
107 -> [RegAllocStats statics instr] -- ^ Current regalloc stats to add to.
108 -> [LiveCmmDecl statics instr] -- ^ Liveness annotated code to allocate.
109 -> Maybe CFG
110 -> UniqSM ( [NatCmmDecl statics instr]
111 , [RegAllocStats statics instr]
112 , Int -- Slots in use
113 , Color.Graph VirtualReg RegClass RealReg)
114
115 regAlloc_spin config spinCount triv regsFree slotsFree slotsCount debug_codeGraphs code cfg
116 = do
117 let platform = ncgPlatform config
118
119 -- If any of these dump flags are turned on we want to hang on to
120 -- intermediate structures in the allocator - otherwise tell the
121 -- allocator to ditch them early so we don't end up creating space leaks.
122 let dump = or
123 [ ncgDumpRegAllocStages config
124 , ncgDumpAsmStats config
125 , ncgDumpAsmConflicts config
126 ]
127
128 -- Check that we're not running off down the garden path.
129 when (spinCount > maxSpinCount)
130 $ pprPanic "regAlloc_spin: max build/spill cycle count exceeded."
131 ( text "It looks like the register allocator is stuck in an infinite loop."
132 $$ text "max cycles = " <> int maxSpinCount
133 $$ text "regsFree = " <> (hcat $ punctuate space $ map ppr
134 $ nonDetEltsUniqSet $ unionManyUniqSets
135 $ nonDetEltsUFM regsFree)
136 -- This is non-deterministic but we do not
137 -- currently support deterministic code-generation.
138 -- See Note [Unique Determinism and code generation]
139 $$ text "slotsFree = " <> ppr (sizeUniqSet slotsFree))
140
141 -- Build the register conflict graph from the cmm code.
142 (graph :: Color.Graph VirtualReg RegClass RealReg)
143 <- {-# SCC "BuildGraph" #-} buildGraph code
144
145 -- VERY IMPORTANT:
146 -- We really do want the graph to be fully evaluated _before_ we
147 -- start coloring. If we don't do this now then when the call to
148 -- Color.colorGraph forces bits of it, the heap will be filled with
149 -- half evaluated pieces of graph and zillions of apply thunks.
150 seqGraph graph `seq` return ()
151
152 -- Build a map of the cost of spilling each instruction.
153 -- This is a lazy binding, so the map will only be computed if we
154 -- actually have to spill to the stack.
155 let spillCosts = foldl' plusSpillCostInfo zeroSpillCostInfo
156 $ map (slurpSpillCostInfo platform cfg) code
157
158 -- The function to choose regs to leave uncolored.
159 let spill = chooseSpill spillCosts
160
161 -- Record startup state in our log.
162 let stat1
163 = if spinCount == 0
164 then Just $ RegAllocStatsStart
165 { raLiveCmm = code
166 , raGraph = graph
167 , raSpillCosts = spillCosts
168 , raPlatform = platform
169 }
170 else Nothing
171
172 -- Try and color the graph.
173 let (graph_colored, rsSpill, rmCoalesce)
174 = {-# SCC "ColorGraph" #-}
175 Color.colorGraph
176 (ncgRegsIterative config)
177 spinCount
178 regsFree triv spill graph
179
180 -- Rewrite registers in the code that have been coalesced.
181 let patchF reg
182 | RegVirtual vr <- reg
183 = case lookupUFM rmCoalesce vr of
184 Just vr' -> patchF (RegVirtual vr')
185 Nothing -> reg
186
187 | otherwise
188 = reg
189
190 let (code_coalesced :: [LiveCmmDecl statics instr])
191 = map (patchEraseLive patchF) code
192
193 -- Check whether we've found a coloring.
194 if isEmptyUniqSet rsSpill
195
196 -- Coloring was successful because no registers needed to be spilled.
197 then do
198 -- if -fasm-lint is turned on then validate the graph.
199 -- This checks for bugs in the graph allocator itself.
200 let graph_colored_lint =
201 if ncgAsmLinting config
202 then Color.validateGraph (text "")
203 True -- Require all nodes to be colored.
204 graph_colored
205 else graph_colored
206
207 -- Rewrite the code to use real hregs, using the colored graph.
208 let code_patched
209 = map (patchRegsFromGraph platform graph_colored_lint)
210 code_coalesced
211
212 -- Clean out unneeded SPILL/RELOAD meta instructions.
213 -- The spill code generator just spills the entire live range
214 -- of a vreg, but it might not need to be on the stack for
215 -- its entire lifetime.
216 let code_spillclean
217 = map (cleanSpills platform) code_patched
218
219 -- Strip off liveness information from the allocated code.
220 -- Also rewrite SPILL/RELOAD meta instructions into real machine
221 -- instructions along the way
222 let code_final
223 = map (stripLive config) code_spillclean
224
225 -- Record what happened in this stage for debugging
226 let stat
227 = RegAllocStatsColored
228 { raCode = code
229 , raGraph = graph
230 , raGraphColored = graph_colored_lint
231 , raCoalesced = rmCoalesce
232 , raCodeCoalesced = code_coalesced
233 , raPatched = code_patched
234 , raSpillClean = code_spillclean
235 , raFinal = code_final
236 , raSRMs = foldl' addSRM (0, 0, 0)
237 $ map countSRMs code_spillclean
238 , raPlatform = platform
239 }
240
241 -- Bundle up all the register allocator statistics.
242 -- .. but make sure to drop them on the floor if they're not
243 -- needed, otherwise we'll get a space leak.
244 let statList =
245 if dump then [stat] ++ maybeToList stat1 ++ debug_codeGraphs
246 else []
247
248 -- Ensure all the statistics are evaluated, to avoid space leaks.
249 seqList statList (return ())
250
251 return ( code_final
252 , statList
253 , slotsCount
254 , graph_colored_lint)
255
256 -- Coloring was unsuccessful. We need to spill some register to the
257 -- stack, make a new graph, and try to color it again.
258 else do
259 -- if -fasm-lint is turned on then validate the graph
260 let graph_colored_lint =
261 if ncgAsmLinting config
262 then Color.validateGraph (text "")
263 False -- don't require nodes to be colored
264 graph_colored
265 else graph_colored
266
267 -- Spill uncolored regs to the stack.
268 (code_spilled, slotsFree', slotsCount', spillStats)
269 <- regSpill platform code_coalesced slotsFree slotsCount rsSpill
270
271 -- Recalculate liveness information.
272 -- NOTE: we have to reverse the SCCs here to get them back into
273 -- the reverse-dependency order required by computeLiveness.
274 -- If they're not in the correct order that function will panic.
275 code_relive <- mapM (regLiveness platform . reverseBlocksInTops)
276 code_spilled
277
278 -- Record what happened in this stage for debugging.
279 let stat =
280 RegAllocStatsSpill
281 { raCode = code
282 , raGraph = graph_colored_lint
283 , raCoalesced = rmCoalesce
284 , raSpillStats = spillStats
285 , raSpillCosts = spillCosts
286 , raSpilled = code_spilled
287 , raPlatform = platform }
288
289 -- Bundle up all the register allocator statistics.
290 -- .. but make sure to drop them on the floor if they're not
291 -- needed, otherwise we'll get a space leak.
292 let statList =
293 if dump
294 then [stat] ++ maybeToList stat1 ++ debug_codeGraphs
295 else []
296
297 -- Ensure all the statistics are evaluated, to avoid space leaks.
298 seqList statList (return ())
299
300 regAlloc_spin config (spinCount + 1) triv regsFree slotsFree'
301 slotsCount' statList code_relive cfg
302
303
304 -- | Build a graph from the liveness and coalesce information in this code.
305 buildGraph
306 :: Instruction instr
307 => [LiveCmmDecl statics instr]
308 -> UniqSM (Color.Graph VirtualReg RegClass RealReg)
309
310 buildGraph code
311 = do
312 -- Slurp out the conflicts and reg->reg moves from this code.
313 let (conflictList, moveList) =
314 unzip $ map slurpConflicts code
315
316 -- Slurp out the spill/reload coalesces.
317 let moveList2 = map slurpReloadCoalesce code
318
319 -- Add the reg-reg conflicts to the graph.
320 let conflictBag = unionManyBags conflictList
321 let graph_conflict
322 = foldr graphAddConflictSet Color.initGraph conflictBag
323
324 -- Add the coalescences edges to the graph.
325 let moveBag
326 = unionBags (unionManyBags moveList2)
327 (unionManyBags moveList)
328
329 let graph_coalesce
330 = foldr graphAddCoalesce graph_conflict moveBag
331
332 return graph_coalesce
333
334
335 -- | Add some conflict edges to the graph.
336 -- Conflicts between virtual and real regs are recorded as exclusions.
337 graphAddConflictSet
338 :: UniqSet Reg
339 -> Color.Graph VirtualReg RegClass RealReg
340 -> Color.Graph VirtualReg RegClass RealReg
341
342 graphAddConflictSet set graph
343 = let virtuals = mkUniqSet
344 [ vr | RegVirtual vr <- nonDetEltsUniqSet set ]
345
346 graph1 = Color.addConflicts virtuals classOfVirtualReg graph
347
348 graph2 = foldr (\(r1, r2) -> Color.addExclusion r1 classOfVirtualReg r2)
349 graph1
350 [ (vr, rr)
351 | RegVirtual vr <- nonDetEltsUniqSet set
352 , RegReal rr <- nonDetEltsUniqSet set]
353 -- See Note [Unique Determinism and code generation]
354
355 in graph2
356
357
358 -- | Add some coalesence edges to the graph
359 -- Coalesences between virtual and real regs are recorded as preferences.
360 graphAddCoalesce
361 :: (Reg, Reg)
362 -> Color.Graph VirtualReg RegClass RealReg
363 -> Color.Graph VirtualReg RegClass RealReg
364
365 graphAddCoalesce (r1, r2) graph
366 | RegReal rr <- r1
367 , RegVirtual vr <- r2
368 = Color.addPreference (vr, classOfVirtualReg vr) rr graph
369
370 | RegReal rr <- r2
371 , RegVirtual vr <- r1
372 = Color.addPreference (vr, classOfVirtualReg vr) rr graph
373
374 | RegVirtual vr1 <- r1
375 , RegVirtual vr2 <- r2
376 = Color.addCoalesce
377 (vr1, classOfVirtualReg vr1)
378 (vr2, classOfVirtualReg vr2)
379 graph
380
381 -- We can't coalesce two real regs, but there could well be existing
382 -- hreg,hreg moves in the input code. We'll just ignore these
383 -- for coalescing purposes.
384 | RegReal _ <- r1
385 , RegReal _ <- r2
386 = graph
387
388 #if __GLASGOW_HASKELL__ <= 810
389 | otherwise
390 = panic "graphAddCoalesce"
391 #endif
392
393
394 -- | Patch registers in code using the reg -> reg mapping in this graph.
395 patchRegsFromGraph
396 :: (OutputableP Platform statics, Instruction instr)
397 => Platform -> Color.Graph VirtualReg RegClass RealReg
398 -> LiveCmmDecl statics instr -> LiveCmmDecl statics instr
399
400 patchRegsFromGraph platform graph code
401 = patchEraseLive patchF code
402 where
403 -- Function to lookup the hardreg for a virtual reg from the graph.
404 patchF reg
405 -- leave real regs alone.
406 | RegReal{} <- reg
407 = reg
408
409 -- this virtual has a regular node in the graph.
410 | RegVirtual vr <- reg
411 , Just node <- Color.lookupNode graph vr
412 = case Color.nodeColor node of
413 Just color -> RegReal color
414 Nothing -> RegVirtual vr
415
416 -- no node in the graph for this virtual, bad news.
417 | otherwise
418 = pprPanic "patchRegsFromGraph: register mapping failed."
419 ( text "There is no node in the graph for register "
420 <> ppr reg
421 $$ pprLiveCmmDecl platform code
422 $$ Color.dotGraph
423 (\_ -> text "white")
424 (trivColorable platform
425 (targetVirtualRegSqueeze platform)
426 (targetRealRegSqueeze platform))
427 graph)
428
429
430 -----
431 -- for when laziness just isn't what you wanted...
432 -- We need to deepSeq the whole graph before trying to colour it to avoid
433 -- space leaks.
434 seqGraph :: Color.Graph VirtualReg RegClass RealReg -> ()
435 seqGraph graph = seqNodes (nonDetEltsUFM (Color.graphMap graph))
436 -- See Note [Unique Determinism and code generation]
437
438 seqNodes :: [Color.Node VirtualReg RegClass RealReg] -> ()
439 seqNodes ns
440 = case ns of
441 [] -> ()
442 (n : ns) -> seqNode n `seq` seqNodes ns
443
444 seqNode :: Color.Node VirtualReg RegClass RealReg -> ()
445 seqNode node
446 = seqVirtualReg (Color.nodeId node)
447 `seq` seqRegClass (Color.nodeClass node)
448 `seq` seqMaybeRealReg (Color.nodeColor node)
449 `seq` (seqVirtualRegList (nonDetEltsUniqSet (Color.nodeConflicts node)))
450 `seq` (seqRealRegList (nonDetEltsUniqSet (Color.nodeExclusions node)))
451 `seq` (seqRealRegList (Color.nodePreference node))
452 `seq` (seqVirtualRegList (nonDetEltsUniqSet (Color.nodeCoalesce node)))
453 -- It's OK to use nonDetEltsUniqSet for seq
454
455 seqVirtualReg :: VirtualReg -> ()
456 seqVirtualReg reg = reg `seq` ()
457
458 seqRealReg :: RealReg -> ()
459 seqRealReg reg = reg `seq` ()
460
461 seqRegClass :: RegClass -> ()
462 seqRegClass c = c `seq` ()
463
464 seqMaybeRealReg :: Maybe RealReg -> ()
465 seqMaybeRealReg mr
466 = case mr of
467 Nothing -> ()
468 Just r -> seqRealReg r
469
470 seqVirtualRegList :: [VirtualReg] -> ()
471 seqVirtualRegList rs
472 = case rs of
473 [] -> ()
474 (r : rs) -> seqVirtualReg r `seq` seqVirtualRegList rs
475
476 seqRealRegList :: [RealReg] -> ()
477 seqRealRegList rs
478 = case rs of
479 [] -> ()
480 (r : rs) -> seqRealReg r `seq` seqRealRegList rs