never executed always true always false
1 {-# LANGUAGE CPP #-}
2 {-# LANGUAGE ScopedTypeVariables #-}
3
4 -- | Clean out unneeded spill\/reload instructions.
5 --
6 -- Handling of join points
7 -- ~~~~~~~~~~~~~~~~~~~~~~~
8 --
9 -- @
10 -- B1: B2:
11 -- ... ...
12 -- RELOAD SLOT(0), %r1 RELOAD SLOT(0), %r1
13 -- ... A ... ... B ...
14 -- jump B3 jump B3
15 --
16 -- B3: ... C ...
17 -- RELOAD SLOT(0), %r1
18 -- ...
19 -- @
20 --
21 -- The Plan
22 -- ~~~~~~~~
23 --
24 -- As long as %r1 hasn't been written to in A, B or C then we don't need
25 -- the reload in B3.
26 --
27 -- What we really care about here is that on the entry to B3, %r1 will
28 -- always have the same value that is in SLOT(0) (ie, %r1 is _valid_)
29 --
30 -- This also works if the reloads in B1\/B2 were spills instead, because
31 -- spilling %r1 to a slot makes that slot have the same value as %r1.
32 --
33 module GHC.CmmToAsm.Reg.Graph.SpillClean (
34 cleanSpills
35 ) where
36 import GHC.Prelude
37
38 import GHC.CmmToAsm.Reg.Liveness
39 import GHC.CmmToAsm.Instr
40 import GHC.Platform.Reg
41
42 import GHC.Cmm.BlockId
43 import GHC.Cmm
44 import GHC.Types.Unique.Set
45 import GHC.Types.Unique.FM
46 import GHC.Types.Unique
47 import GHC.Builtin.Uniques
48 import GHC.Utils.Monad.State.Strict
49 import GHC.Utils.Outputable
50 import GHC.Utils.Panic
51 import GHC.Platform
52 import GHC.Cmm.Dataflow.Collections
53
54 import Data.List (nub, foldl1', find)
55 import Data.Maybe
56 import Data.IntSet (IntSet)
57 import qualified Data.IntSet as IntSet
58
59
60 -- | The identification number of a spill slot.
61 -- A value is stored in a spill slot when we don't have a free
62 -- register to hold it.
63 type Slot = Int
64
65
66 -- | Clean out unneeded spill\/reloads from this top level thing.
67 cleanSpills
68 :: Instruction instr
69 => Platform
70 -> LiveCmmDecl statics instr
71 -> LiveCmmDecl statics instr
72
73 cleanSpills platform cmm
74 = evalState (cleanSpin platform 0 cmm) initCleanS
75
76
77 -- | Do one pass of cleaning.
78 cleanSpin
79 :: Instruction instr
80 => Platform
81 -> Int -- ^ Iteration number for the cleaner.
82 -> LiveCmmDecl statics instr -- ^ Liveness annotated code to clean.
83 -> CleanM (LiveCmmDecl statics instr)
84
85 cleanSpin platform spinCount code
86 = do
87 -- Initialise count of cleaned spill and reload instructions.
88 modify $ \s -> s
89 { sCleanedSpillsAcc = 0
90 , sCleanedReloadsAcc = 0
91 , sReloadedBy = emptyUFM }
92
93 code_forward <- mapBlockTopM (cleanBlockForward platform) code
94 code_backward <- cleanTopBackward code_forward
95
96 -- During the cleaning of each block we collected information about
97 -- what regs were valid across each jump. Based on this, work out
98 -- whether it will be safe to erase reloads after join points for
99 -- the next pass.
100 collateJoinPoints
101
102 -- Remember how many spill and reload instructions we cleaned in this pass.
103 spills <- gets sCleanedSpillsAcc
104 reloads <- gets sCleanedReloadsAcc
105 modify $ \s -> s
106 { sCleanedCount = (spills, reloads) : sCleanedCount s }
107
108 -- If nothing was cleaned in this pass or the last one
109 -- then we're done and it's time to bail out.
110 cleanedCount <- gets sCleanedCount
111 if take 2 cleanedCount == [(0, 0), (0, 0)]
112 then return code
113
114 -- otherwise go around again
115 else cleanSpin platform (spinCount + 1) code_backward
116
117
118 -------------------------------------------------------------------------------
119 -- | Clean out unneeded reload instructions,
120 -- while walking forward over the code.
121 cleanBlockForward
122 :: Instruction instr
123 => Platform
124 -> LiveBasicBlock instr
125 -> CleanM (LiveBasicBlock instr)
126
127 cleanBlockForward platform (BasicBlock blockId instrs)
128 = do
129 -- See if we have a valid association for the entry to this block.
130 jumpValid <- gets sJumpValid
131 let assoc = case lookupUFM jumpValid blockId of
132 Just assoc -> assoc
133 Nothing -> emptyAssoc
134
135 instrs_reload <- cleanForward platform blockId assoc [] instrs
136 return $ BasicBlock blockId instrs_reload
137
138
139
140 -- | Clean out unneeded reload instructions.
141 --
142 -- Walking forwards across the code
143 -- On a reload, if we know a reg already has the same value as a slot
144 -- then we don't need to do the reload.
145 --
146 cleanForward
147 :: Instruction instr
148 => Platform
149 -> BlockId -- ^ the block that we're currently in
150 -> Assoc Store -- ^ two store locations are associated if
151 -- they have the same value
152 -> [LiveInstr instr] -- ^ acc
153 -> [LiveInstr instr] -- ^ instrs to clean (in backwards order)
154 -> CleanM [LiveInstr instr] -- ^ cleaned instrs (in forward order)
155
156 cleanForward _ _ _ acc []
157 = return acc
158
159 -- Rewrite live range joins via spill slots to just a spill and a reg-reg move
160 -- hopefully the spill will be also be cleaned in the next pass
161 cleanForward platform blockId assoc acc (li1 : li2 : instrs)
162
163 | LiveInstr (SPILL reg1 slot1) _ <- li1
164 , LiveInstr (RELOAD slot2 reg2) _ <- li2
165 , slot1 == slot2
166 = do
167 modify $ \s -> s { sCleanedReloadsAcc = sCleanedReloadsAcc s + 1 }
168 cleanForward platform blockId assoc acc
169 $ li1 : LiveInstr (mkRegRegMoveInstr platform reg1 reg2) Nothing
170 : instrs
171
172 cleanForward platform blockId assoc acc (li@(LiveInstr i1 _) : instrs)
173 | Just (r1, r2) <- takeRegRegMoveInstr i1
174 = if r1 == r2
175 -- Erase any left over nop reg reg moves while we're here
176 -- this will also catch any nop moves that the previous case
177 -- happens to add.
178 then cleanForward platform blockId assoc acc instrs
179
180 -- If r1 has the same value as some slots and we copy r1 to r2,
181 -- then r2 is now associated with those slots instead
182 else do let assoc' = addAssoc (SReg r1) (SReg r2)
183 $ delAssoc (SReg r2)
184 $ assoc
185
186 cleanForward platform blockId assoc' (li : acc) instrs
187
188
189 cleanForward platform blockId assoc acc (li : instrs)
190
191 -- Update association due to the spill.
192 | LiveInstr (SPILL reg slot) _ <- li
193 = let assoc' = addAssoc (SReg reg) (SSlot slot)
194 $ delAssoc (SSlot slot)
195 $ assoc
196 in cleanForward platform blockId assoc' (li : acc) instrs
197
198 -- Clean a reload instr.
199 | LiveInstr (RELOAD{}) _ <- li
200 = do (assoc', mli) <- cleanReload platform blockId assoc li
201 case mli of
202 Nothing -> cleanForward platform blockId assoc' acc
203 instrs
204
205 Just li' -> cleanForward platform blockId assoc' (li' : acc)
206 instrs
207
208 -- Remember the association over a jump.
209 | LiveInstr instr _ <- li
210 , targets <- jumpDestsOfInstr instr
211 , not $ null targets
212 = do mapM_ (accJumpValid assoc) targets
213 cleanForward platform blockId assoc (li : acc) instrs
214
215 -- Writing to a reg changes its value.
216 | LiveInstr instr _ <- li
217 , RU _ written <- regUsageOfInstr platform instr
218 = let assoc' = foldr delAssoc assoc (map SReg $ nub written)
219 in cleanForward platform blockId assoc' (li : acc) instrs
220
221
222
223 -- | Try and rewrite a reload instruction to something more pleasing
224 cleanReload
225 :: Instruction instr
226 => Platform
227 -> BlockId
228 -> Assoc Store
229 -> LiveInstr instr
230 -> CleanM (Assoc Store, Maybe (LiveInstr instr))
231
232 cleanReload platform blockId assoc li@(LiveInstr (RELOAD slot reg) _)
233
234 -- If the reg we're reloading already has the same value as the slot
235 -- then we can erase the instruction outright.
236 | elemAssoc (SSlot slot) (SReg reg) assoc
237 = do modify $ \s -> s { sCleanedReloadsAcc = sCleanedReloadsAcc s + 1 }
238 return (assoc, Nothing)
239
240 -- If we can find another reg with the same value as this slot then
241 -- do a move instead of a reload.
242 | Just reg2 <- findRegOfSlot assoc slot
243 = do modify $ \s -> s { sCleanedReloadsAcc = sCleanedReloadsAcc s + 1 }
244
245 let assoc' = addAssoc (SReg reg) (SReg reg2)
246 $ delAssoc (SReg reg)
247 $ assoc
248
249 return ( assoc'
250 , Just $ LiveInstr (mkRegRegMoveInstr platform reg2 reg) Nothing)
251
252 -- Gotta keep this instr.
253 | otherwise
254 = do -- Update the association.
255 let assoc'
256 = addAssoc (SReg reg) (SSlot slot)
257 -- doing the reload makes reg and slot the same value
258 $ delAssoc (SReg reg)
259 -- reg value changes on reload
260 $ assoc
261
262 -- Remember that this block reloads from this slot.
263 accBlockReloadsSlot blockId slot
264
265 return (assoc', Just li)
266
267 cleanReload _ _ _ _
268 = panic "RegSpillClean.cleanReload: unhandled instr"
269
270
271 -------------------------------------------------------------------------------
272 -- | Clean out unneeded spill instructions,
273 -- while walking backwards over the code.
274 --
275 -- If there were no reloads from a slot between a spill and the last one
276 -- then the slot was never read and we don't need the spill.
277 --
278 -- SPILL r0 -> s1
279 -- RELOAD s1 -> r2
280 -- SPILL r3 -> s1 <--- don't need this spill
281 -- SPILL r4 -> s1
282 -- RELOAD s1 -> r5
283 --
284 -- Maintain a set of
285 -- "slots which were spilled to but not reloaded from yet"
286 --
287 -- Walking backwards across the code:
288 -- a) On a reload from a slot, remove it from the set.
289 --
290 -- a) On a spill from a slot
291 -- If the slot is in set then we can erase the spill,
292 -- because it won't be reloaded from until after the next spill.
293 --
294 -- otherwise
295 -- keep the spill and add the slot to the set
296 --
297 -- TODO: This is mostly inter-block
298 -- we should really be updating the noReloads set as we cross jumps also.
299 --
300 -- TODO: generate noReloads from liveSlotsOnEntry
301 --
302 cleanTopBackward
303 :: Instruction instr
304 => LiveCmmDecl statics instr
305 -> CleanM (LiveCmmDecl statics instr)
306
307 cleanTopBackward cmm
308 = case cmm of
309 CmmData{}
310 -> return cmm
311
312 CmmProc info label live sccs
313 | LiveInfo _ _ _ liveSlotsOnEntry <- info
314 -> do sccs' <- mapM (mapSCCM (cleanBlockBackward liveSlotsOnEntry)) sccs
315 return $ CmmProc info label live sccs'
316
317
318 cleanBlockBackward
319 :: Instruction instr
320 => BlockMap IntSet
321 -> LiveBasicBlock instr
322 -> CleanM (LiveBasicBlock instr)
323
324 cleanBlockBackward liveSlotsOnEntry (BasicBlock blockId instrs)
325 = do instrs_spill <- cleanBackward liveSlotsOnEntry emptyUniqSet [] instrs
326 return $ BasicBlock blockId instrs_spill
327
328
329
330 cleanBackward
331 :: Instruction instr
332 => BlockMap IntSet -- ^ Slots live on entry to each block
333 -> UniqSet Int -- ^ Slots that have been spilled, but not reloaded from
334 -> [LiveInstr instr] -- ^ acc
335 -> [LiveInstr instr] -- ^ Instrs to clean (in forwards order)
336 -> CleanM [LiveInstr instr] -- ^ Cleaned instrs (in backwards order)
337
338 cleanBackward liveSlotsOnEntry noReloads acc lis
339 = do reloadedBy <- gets sReloadedBy
340 cleanBackward' liveSlotsOnEntry reloadedBy noReloads acc lis
341
342
343 cleanBackward'
344 :: Instruction instr
345 => BlockMap IntSet
346 -> UniqFM Store [BlockId]
347 -> UniqSet Int
348 -> [LiveInstr instr]
349 -> [LiveInstr instr]
350 -> State CleanS [LiveInstr instr]
351
352 cleanBackward' _ _ _ acc []
353 = return acc
354
355 cleanBackward' liveSlotsOnEntry reloadedBy noReloads acc (li : instrs)
356
357 -- If nothing ever reloads from this slot then we don't need the spill.
358 | LiveInstr (SPILL _ slot) _ <- li
359 , Nothing <- lookupUFM reloadedBy (SSlot slot)
360 = do modify $ \s -> s { sCleanedSpillsAcc = sCleanedSpillsAcc s + 1 }
361 cleanBackward liveSlotsOnEntry noReloads acc instrs
362
363 | LiveInstr (SPILL _ slot) _ <- li
364 = if elementOfUniqSet slot noReloads
365
366 -- We can erase this spill because the slot won't be read until
367 -- after the next one
368 then do
369 modify $ \s -> s { sCleanedSpillsAcc = sCleanedSpillsAcc s + 1 }
370 cleanBackward liveSlotsOnEntry noReloads acc instrs
371
372 else do
373 -- This slot is being spilled to, but we haven't seen any reloads yet.
374 let noReloads' = addOneToUniqSet noReloads slot
375 cleanBackward liveSlotsOnEntry noReloads' (li : acc) instrs
376
377 -- if we reload from a slot then it's no longer unused
378 | LiveInstr (RELOAD slot _) _ <- li
379 , noReloads' <- delOneFromUniqSet noReloads slot
380 = cleanBackward liveSlotsOnEntry noReloads' (li : acc) instrs
381
382 -- If a slot is live in a jump target then assume it's reloaded there.
383 --
384 -- TODO: A real dataflow analysis would do a better job here.
385 -- If the target block _ever_ used the slot then we assume
386 -- it always does, but if those reloads are cleaned the slot
387 -- liveness map doesn't get updated.
388 | LiveInstr instr _ <- li
389 , targets <- jumpDestsOfInstr instr
390 = do
391 let slotsReloadedByTargets
392 = IntSet.unions
393 $ catMaybes
394 $ map (flip mapLookup liveSlotsOnEntry)
395 $ targets
396
397 let noReloads'
398 = foldl' delOneFromUniqSet noReloads
399 $ IntSet.toList slotsReloadedByTargets
400
401 cleanBackward liveSlotsOnEntry noReloads' (li : acc) instrs
402
403 #if __GLASGOW_HASKELL__ <= 810
404 -- some other instruction
405 | otherwise
406 = cleanBackward liveSlotsOnEntry noReloads (li : acc) instrs
407 #endif
408
409
410 -- | Combine the associations from all the inward control flow edges.
411 --
412 collateJoinPoints :: CleanM ()
413 collateJoinPoints
414 = modify $ \s -> s
415 { sJumpValid = mapUFM intersects (sJumpValidAcc s)
416 , sJumpValidAcc = emptyUFM }
417
418 intersects :: [Assoc Store] -> Assoc Store
419 intersects [] = emptyAssoc
420 intersects assocs = foldl1' intersectAssoc assocs
421
422
423 -- | See if we have a reg with the same value as this slot in the association table.
424 findRegOfSlot :: Assoc Store -> Int -> Maybe Reg
425 findRegOfSlot assoc slot
426 | close <- closeAssoc (SSlot slot) assoc
427 , Just (SReg reg) <- find isStoreReg $ nonDetEltsUniqSet close
428 -- See Note [Unique Determinism and code generation]
429 = Just reg
430
431 | otherwise
432 = Nothing
433
434
435 -------------------------------------------------------------------------------
436 -- | Cleaner monad.
437 type CleanM
438 = State CleanS
439
440 -- | Cleaner state.
441 data CleanS
442 = CleanS
443 { -- | Regs which are valid at the start of each block.
444 sJumpValid :: UniqFM BlockId (Assoc Store)
445
446 -- | Collecting up what regs were valid across each jump.
447 -- in the next pass we can collate these and write the results
448 -- to sJumpValid.
449 , sJumpValidAcc :: UniqFM BlockId [Assoc Store]
450
451 -- | Map of (slot -> blocks which reload from this slot)
452 -- used to decide if whether slot spilled to will ever be
453 -- reloaded from on this path.
454 , sReloadedBy :: UniqFM Store [BlockId]
455
456 -- | Spills and reloads cleaned each pass (latest at front)
457 , sCleanedCount :: [(Int, Int)]
458
459 -- | Spills and reloads that have been cleaned in this pass so far.
460 , sCleanedSpillsAcc :: Int
461 , sCleanedReloadsAcc :: Int }
462
463
464 -- | Construct the initial cleaner state.
465 initCleanS :: CleanS
466 initCleanS
467 = CleanS
468 { sJumpValid = emptyUFM
469 , sJumpValidAcc = emptyUFM
470
471 , sReloadedBy = emptyUFM
472
473 , sCleanedCount = []
474
475 , sCleanedSpillsAcc = 0
476 , sCleanedReloadsAcc = 0 }
477
478
479 -- | Remember the associations before a jump.
480 accJumpValid :: Assoc Store -> BlockId -> CleanM ()
481 accJumpValid assocs target
482 = modify $ \s -> s {
483 sJumpValidAcc = addToUFM_C (++)
484 (sJumpValidAcc s)
485 target
486 [assocs] }
487
488
489 accBlockReloadsSlot :: BlockId -> Slot -> CleanM ()
490 accBlockReloadsSlot blockId slot
491 = modify $ \s -> s {
492 sReloadedBy = addToUFM_C (++)
493 (sReloadedBy s)
494 (SSlot slot)
495 [blockId] }
496
497
498 -------------------------------------------------------------------------------
499 -- A store location can be a stack slot or a register
500 data Store
501 = SSlot Int
502 | SReg Reg
503
504
505 -- | Check if this is a reg store.
506 isStoreReg :: Store -> Bool
507 isStoreReg ss
508 = case ss of
509 SSlot _ -> False
510 SReg _ -> True
511
512
513 -- Spill cleaning is only done once all virtuals have been allocated to realRegs
514 instance Uniquable Store where
515 getUnique (SReg r)
516 | RegReal (RealRegSingle i) <- r
517 = mkRegSingleUnique i
518
519 | RegReal (RealRegPair r1 r2) <- r
520 = mkRegPairUnique (r1 * 65535 + r2)
521
522 | otherwise
523 = error $ "RegSpillClean.getUnique: found virtual reg during spill clean,"
524 ++ "only real regs expected."
525
526 getUnique (SSlot i) = mkRegSubUnique i -- [SLPJ] I hope "SubUnique" is ok
527
528
529 instance Outputable Store where
530 ppr (SSlot i) = text "slot" <> int i
531 ppr (SReg r) = ppr r
532
533
534 -------------------------------------------------------------------------------
535 -- Association graphs.
536 -- In the spill cleaner, two store locations are associated if they are known
537 -- to hold the same value.
538 --
539 -- TODO: Monomorphize: I think we only ever use this with a ~ Store
540 type Assoc a = UniqFM a (UniqSet a)
541
542 -- | An empty association
543 emptyAssoc :: Assoc a
544 emptyAssoc = emptyUFM
545
546
547 -- | Add an association between these two things.
548 -- addAssoc :: Uniquable a
549 -- => a -> a -> Assoc a -> Assoc a
550 addAssoc :: Store -> Store -> Assoc Store -> Assoc Store
551
552 addAssoc a b m
553 = let m1 = addToUFM_C unionUniqSets m a (unitUniqSet b)
554 m2 = addToUFM_C unionUniqSets m1 b (unitUniqSet a)
555 in m2
556
557
558 -- | Delete all associations to a node.
559 delAssoc :: Store -> Assoc Store -> Assoc Store
560 delAssoc a m
561 | Just aSet <- lookupUFM m a
562 , m1 <- delFromUFM m a
563 = nonDetStrictFoldUniqSet (\x m -> delAssoc1 x a m) m1 aSet
564 -- It's OK to use a non-deterministic fold here because deletion is
565 -- commutative
566
567 | otherwise = m
568
569
570 -- | Delete a single association edge (a -> b).
571 delAssoc1 :: Store -> Store -> Assoc Store -> Assoc Store
572 delAssoc1 a b m
573 | Just aSet <- lookupUFM m a
574 = addToUFM m a (delOneFromUniqSet aSet b)
575
576 | otherwise = m
577
578
579 -- | Check if these two things are associated.
580 elemAssoc :: Store -> Store -> Assoc Store -> Bool
581
582 elemAssoc a b m
583 = elementOfUniqSet b (closeAssoc a m)
584
585
586 -- | Find the refl. trans. closure of the association from this point.
587 closeAssoc :: Store -> Assoc Store -> UniqSet Store
588 closeAssoc a assoc
589 = closeAssoc' assoc emptyUniqSet (unitUniqSet a)
590 where
591 closeAssoc' assoc visited toVisit
592 = case nonDetEltsUniqSet toVisit of
593 -- See Note [Unique Determinism and code generation]
594
595 -- nothing else to visit, we're done
596 [] -> visited
597
598 (x:_)
599 -- we've already seen this node
600 | elementOfUniqSet x visited
601 -> closeAssoc' assoc visited (delOneFromUniqSet toVisit x)
602
603 -- haven't seen this node before,
604 -- remember to visit all its neighbors
605 | otherwise
606 -> let neighbors
607 = case lookupUFM assoc x of
608 Nothing -> emptyUniqSet
609 Just set -> set
610
611 in closeAssoc' assoc
612 (addOneToUniqSet visited x)
613 (unionUniqSets toVisit neighbors)
614
615 -- | Intersect two associations.
616 intersectAssoc :: Assoc Store -> Assoc Store -> Assoc Store
617 intersectAssoc a b
618 = intersectUFM_C (intersectUniqSets) a b