1 {-# OPTIONS -fno-warn-missing-signatures #-}
2 -- | Clean out unneeded spill\/reload instrs
4 -- * Handling of join points
8 -- RELOAD SLOT(0), %r1 RELOAD SLOT(0), %r1
13 -- RELOAD SLOT(0), %r1
17 -- So long as %r1 hasn't been written to in A, B or C then we don't need the
20 -- What we really care about here is that on the entry to B3, %r1 will always
21 -- have the same value that is in SLOT(0) (ie, %r1 is _valid_)
23 -- This also works if the reloads in B1\/B2 were spills instead, because
24 -- spilling %r1 to a slot makes that slot have the same value as %r1.
26 module RegAlloc.Graph.SpillClean (
31 import RegAlloc.Liveness
47 import qualified Data.Map as Map
48 import qualified Data.Set as Set
54 -- | Clean out unneeded spill\/reloads from this top level thing.
57 => LiveCmmTop instr -> LiveCmmTop instr
60 = evalState (cleanSpin 0 cmm) initCleanS
62 -- | do one pass of cleaning
67 -> CleanM (LiveCmmTop instr)
70 cleanSpin spinCount code
71 = do jumpValid <- gets sJumpValid
78 $ cleanSpin' spinCount code
81 cleanSpin spinCount code
83 -- init count of cleaned spills\/reloads
85 { sCleanedSpillsAcc = 0
86 , sCleanedReloadsAcc = 0
87 , sReloadedBy = emptyUFM }
89 code_forward <- mapBlockTopM cleanBlockForward code
90 code_backward <- cleanTopBackward code_forward
92 -- During the cleaning of each block we collected information about what regs
93 -- were valid across each jump. Based on this, work out whether it will be
94 -- safe to erase reloads after join points for the next pass.
97 -- remember how many spills\/reloads we cleaned in this pass
98 spills <- gets sCleanedSpillsAcc
99 reloads <- gets sCleanedReloadsAcc
101 { sCleanedCount = (spills, reloads) : sCleanedCount s }
103 -- if nothing was cleaned in this pass or the last one
104 -- then we're done and it's time to bail out
105 cleanedCount <- gets sCleanedCount
106 if take 2 cleanedCount == [(0, 0), (0, 0)]
109 -- otherwise go around again
110 else cleanSpin (spinCount + 1) code_backward
113 -- | Clean one basic block
116 => LiveBasicBlock instr
117 -> CleanM (LiveBasicBlock instr)
119 cleanBlockForward (BasicBlock blockId instrs)
121 -- see if we have a valid association for the entry to this block
122 jumpValid <- gets sJumpValid
123 let assoc = case lookupUFM jumpValid blockId of
125 Nothing -> emptyAssoc
127 instrs_reload <- cleanForward blockId assoc [] instrs
128 return $ BasicBlock blockId instrs_reload
132 -- | Clean out unneeded reload instructions.
133 -- Walking forwards across the code
134 -- On a reload, if we know a reg already has the same value as a slot
135 -- then we don't need to do the reload.
139 => BlockId -- ^ the block that we're currently in
140 -> Assoc Store -- ^ two store locations are associated if they have the same value
141 -> [LiveInstr instr] -- ^ acc
142 -> [LiveInstr instr] -- ^ instrs to clean (in backwards order)
143 -> CleanM [LiveInstr instr] -- ^ cleaned instrs (in forward order)
145 cleanForward _ _ acc []
148 -- write out live range joins via spill slots to just a spill and a reg-reg move
149 -- hopefully the spill will be also be cleaned in the next pass
151 cleanForward blockId assoc acc (li1 : li2 : instrs)
153 | LiveInstr (SPILL reg1 slot1) _ <- li1
154 , LiveInstr (RELOAD slot2 reg2) _ <- li2
157 modify $ \s -> s { sCleanedReloadsAcc = sCleanedReloadsAcc s + 1 }
158 cleanForward blockId assoc acc
159 (li1 : LiveInstr (mkRegRegMoveInstr reg1 reg2) Nothing : instrs)
162 cleanForward blockId assoc acc (li@(LiveInstr i1 _) : instrs)
163 | Just (r1, r2) <- takeRegRegMoveInstr i1
165 -- erase any left over nop reg reg moves while we're here
166 -- this will also catch any nop moves that the "write out live range joins" case above
168 then cleanForward blockId assoc acc instrs
170 -- if r1 has the same value as some slots and we copy r1 to r2,
171 -- then r2 is now associated with those slots instead
172 else do let assoc' = addAssoc (SReg r1) (SReg r2)
176 cleanForward blockId assoc' (li : acc) instrs
179 cleanForward blockId assoc acc (li : instrs)
181 -- update association due to the spill
182 | LiveInstr (SPILL reg slot) _ <- li
183 = let assoc' = addAssoc (SReg reg) (SSlot slot)
184 $ delAssoc (SSlot slot)
186 in cleanForward blockId assoc' (li : acc) instrs
188 -- clean a reload instr
189 | LiveInstr (RELOAD{}) _ <- li
190 = do (assoc', mli) <- cleanReload blockId assoc li
192 Nothing -> cleanForward blockId assoc' acc instrs
193 Just li' -> cleanForward blockId assoc' (li' : acc) instrs
195 -- remember the association over a jump
196 | LiveInstr instr _ <- li
197 , targets <- jumpDestsOfInstr instr
199 = do mapM_ (accJumpValid assoc) targets
200 cleanForward blockId assoc (li : acc) instrs
202 -- writing to a reg changes its value.
203 | LiveInstr instr _ <- li
204 , RU _ written <- regUsageOfInstr instr
205 = let assoc' = foldr delAssoc assoc (map SReg $ nub written)
206 in cleanForward blockId assoc' (li : acc) instrs
210 -- | Try and rewrite a reload instruction to something more pleasing
217 -> CleanM (Assoc Store, Maybe (LiveInstr instr))
219 cleanReload blockId assoc li@(LiveInstr (RELOAD slot reg) _)
221 -- if the reg we're reloading already has the same value as the slot
222 -- then we can erase the instruction outright
223 | elemAssoc (SSlot slot) (SReg reg) assoc
224 = do modify $ \s -> s { sCleanedReloadsAcc = sCleanedReloadsAcc s + 1 }
225 return (assoc, Nothing)
227 -- if we can find another reg with the same value as this slot then
228 -- do a move instead of a reload.
229 | Just reg2 <- findRegOfSlot assoc slot
230 = do modify $ \s -> s { sCleanedReloadsAcc = sCleanedReloadsAcc s + 1 }
232 let assoc' = addAssoc (SReg reg) (SReg reg2)
233 $ delAssoc (SReg reg)
236 return (assoc', Just $ LiveInstr (mkRegRegMoveInstr reg2 reg) Nothing)
238 -- gotta keep this instr
240 = do -- update the association
241 let assoc' = addAssoc (SReg reg) (SSlot slot) -- doing the reload makes reg and slot the same value
242 $ delAssoc (SReg reg) -- reg value changes on reload
245 -- remember that this block reloads from this slot
246 accBlockReloadsSlot blockId slot
248 return (assoc', Just li)
251 = panic "RegSpillClean.cleanReload: unhandled instr"
254 -- | Clean out unneeded spill instructions.
256 -- If there were no reloads from a slot between a spill and the last one
257 -- then the slot was never read and we don't need the spill.
261 -- SPILL r3 -> s1 <--- don't need this spill
266 -- "slots which were spilled to but not reloaded from yet"
268 -- Walking backwards across the code:
269 -- a) On a reload from a slot, remove it from the set.
271 -- a) On a spill from a slot
272 -- If the slot is in set then we can erase the spill,
273 -- because it won't be reloaded from until after the next spill.
276 -- keep the spill and add the slot to the set
278 -- TODO: This is mostly inter-block
279 -- we should really be updating the noReloads set as we cross jumps also.
281 -- TODO: generate noReloads from liveSlotsOnEntry
286 -> CleanM (LiveCmmTop instr)
293 CmmProc info label sccs
294 | LiveInfo _ _ _ liveSlotsOnEntry <- info
295 -> do sccs' <- mapM (mapSCCM (cleanBlockBackward liveSlotsOnEntry)) sccs
296 return $ CmmProc info label sccs'
301 => Map BlockId (Set Int)
302 -> LiveBasicBlock instr
303 -> CleanM (LiveBasicBlock instr)
305 cleanBlockBackward liveSlotsOnEntry (BasicBlock blockId instrs)
306 = do instrs_spill <- cleanBackward liveSlotsOnEntry emptyUniqSet [] instrs
307 return $ BasicBlock blockId instrs_spill
313 => Map BlockId (Set Int) -- ^ Slots live on entry to each block
314 -> UniqSet Int -- ^ slots that have been spilled, but not reloaded from
315 -> [LiveInstr instr] -- ^ acc
316 -> [LiveInstr instr] -- ^ instrs to clean (in forwards order)
317 -> CleanM [LiveInstr instr] -- ^ cleaned instrs (in backwards order)
320 cleanBackward liveSlotsOnEntry noReloads acc lis
321 = do reloadedBy <- gets sReloadedBy
322 cleanBackward' liveSlotsOnEntry reloadedBy noReloads acc lis
324 cleanBackward' _ _ _ acc []
327 cleanBackward' liveSlotsOnEntry reloadedBy noReloads acc (li : instrs)
329 -- if nothing ever reloads from this slot then we don't need the spill
330 | LiveInstr (SPILL _ slot) _ <- li
331 , Nothing <- lookupUFM reloadedBy (SSlot slot)
332 = do modify $ \s -> s { sCleanedSpillsAcc = sCleanedSpillsAcc s + 1 }
333 cleanBackward liveSlotsOnEntry noReloads acc instrs
335 | LiveInstr (SPILL _ slot) _ <- li
336 = if elementOfUniqSet slot noReloads
338 -- we can erase this spill because the slot won't be read until after the next one
340 modify $ \s -> s { sCleanedSpillsAcc = sCleanedSpillsAcc s + 1 }
341 cleanBackward liveSlotsOnEntry noReloads acc instrs
344 -- this slot is being spilled to, but we haven't seen any reloads yet.
345 let noReloads' = addOneToUniqSet noReloads slot
346 cleanBackward liveSlotsOnEntry noReloads' (li : acc) instrs
348 -- if we reload from a slot then it's no longer unused
349 | LiveInstr (RELOAD slot _) _ <- li
350 , noReloads' <- delOneFromUniqSet noReloads slot
351 = cleanBackward liveSlotsOnEntry noReloads' (li : acc) instrs
353 -- If a slot is live in a jump target then assume it's reloaded there.
354 -- TODO: A real dataflow analysis would do a better job here.
355 -- If the target block _ever_ used the slot then we assume it always does,
356 -- but if those reloads are cleaned the slot liveness map doesn't get updated.
357 | LiveInstr instr _ <- li
358 , targets <- jumpDestsOfInstr instr
360 let slotsReloadedByTargets
363 $ map (flip Map.lookup liveSlotsOnEntry)
366 let noReloads' = foldl' delOneFromUniqSet noReloads
367 $ Set.toList slotsReloadedByTargets
369 cleanBackward liveSlotsOnEntry noReloads' (li : acc) instrs
371 -- some other instruction
373 = cleanBackward liveSlotsOnEntry noReloads (li : acc) instrs
376 -- collateJoinPoints:
378 -- | combine the associations from all the inward control flow edges.
380 collateJoinPoints :: CleanM ()
383 { sJumpValid = mapUFM intersects (sJumpValidAcc s)
384 , sJumpValidAcc = emptyUFM }
386 intersects :: [Assoc Store] -> Assoc Store
387 intersects [] = emptyAssoc
388 intersects assocs = foldl1' intersectAssoc assocs
391 -- | See if we have a reg with the same value as this slot in the association table.
392 findRegOfSlot :: Assoc Store -> Int -> Maybe Reg
393 findRegOfSlot assoc slot
394 | close <- closeAssoc (SSlot slot) assoc
395 , Just (SReg reg) <- find isStoreReg $ uniqSetToList close
403 type CleanM = State CleanS
406 { -- regs which are valid at the start of each block.
407 sJumpValid :: UniqFM (Assoc Store)
409 -- collecting up what regs were valid across each jump.
410 -- in the next pass we can collate these and write the results
412 , sJumpValidAcc :: UniqFM [Assoc Store]
414 -- map of (slot -> blocks which reload from this slot)
415 -- used to decide if whether slot spilled to will ever be
416 -- reloaded from on this path.
417 , sReloadedBy :: UniqFM [BlockId]
419 -- spills\/reloads cleaned each pass (latest at front)
420 , sCleanedCount :: [(Int, Int)]
422 -- spills\/reloads that have been cleaned in this pass so far.
423 , sCleanedSpillsAcc :: Int
424 , sCleanedReloadsAcc :: Int }
429 { sJumpValid = emptyUFM
430 , sJumpValidAcc = emptyUFM
432 , sReloadedBy = emptyUFM
436 , sCleanedSpillsAcc = 0
437 , sCleanedReloadsAcc = 0 }
440 -- | Remember the associations before a jump
441 accJumpValid :: Assoc Store -> BlockId -> CleanM ()
442 accJumpValid assocs target
444 sJumpValidAcc = addToUFM_C (++)
450 accBlockReloadsSlot :: BlockId -> Slot -> CleanM ()
451 accBlockReloadsSlot blockId slot
453 sReloadedBy = addToUFM_C (++)
460 -- A store location can be a stack slot or a register
466 -- | Check if this is a reg store
467 isStoreReg :: Store -> Bool
473 -- spill cleaning is only done once all virtuals have been allocated to realRegs
475 instance Uniquable Store where
477 | RegReal (RealRegSingle i) <- r
478 = mkRegSingleUnique i
480 | RegReal (RealRegPair r1 r2) <- r
481 = mkRegPairUnique (r1 * 65535 + r2)
484 = error "RegSpillClean.getUnique: found virtual reg during spill clean, only real regs expected."
486 getUnique (SSlot i) = mkRegSubUnique i -- [SLPJ] I hope "SubUnique" is ok
488 instance Outputable Store where
489 ppr (SSlot i) = text "slot" <> int i
494 -- Association graphs.
495 -- In the spill cleaner, two store locations are associated if they are known
496 -- to hold the same value.
498 type Assoc a = UniqFM (UniqSet a)
500 -- | an empty association
501 emptyAssoc :: Assoc a
502 emptyAssoc = emptyUFM
505 -- | add an association between these two things
506 addAssoc :: Uniquable a
507 => a -> a -> Assoc a -> Assoc a
510 = let m1 = addToUFM_C unionUniqSets m a (unitUniqSet b)
511 m2 = addToUFM_C unionUniqSets m1 b (unitUniqSet a)
515 -- | delete all associations to a node
516 delAssoc :: (Outputable a, Uniquable a)
517 => a -> Assoc a -> Assoc a
520 | Just aSet <- lookupUFM m a
521 , m1 <- delFromUFM m a
522 = foldUniqSet (\x m -> delAssoc1 x a m) m1 aSet
527 -- | delete a single association edge (a -> b)
528 delAssoc1 :: Uniquable a
529 => a -> a -> Assoc a -> Assoc a
532 | Just aSet <- lookupUFM m a
533 = addToUFM m a (delOneFromUniqSet aSet b)
538 -- | check if these two things are associated
539 elemAssoc :: (Outputable a, Uniquable a)
540 => a -> a -> Assoc a -> Bool
543 = elementOfUniqSet b (closeAssoc a m)
545 -- | find the refl. trans. closure of the association from this point
546 closeAssoc :: (Outputable a, Uniquable a)
547 => a -> Assoc a -> UniqSet a
550 = closeAssoc' assoc emptyUniqSet (unitUniqSet a)
552 closeAssoc' assoc visited toVisit
553 = case uniqSetToList toVisit of
555 -- nothing else to visit, we're done
560 -- we've already seen this node
561 | elementOfUniqSet x visited
562 -> closeAssoc' assoc visited (delOneFromUniqSet toVisit x)
564 -- haven't seen this node before,
565 -- remember to visit all its neighbors
568 = case lookupUFM assoc x of
569 Nothing -> emptyUniqSet
573 (addOneToUniqSet visited x)
574 (unionUniqSets toVisit neighbors)
579 => Assoc a -> Assoc a -> Assoc a
582 = intersectUFM_C (intersectUniqSets) a b