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.
27 module RegAlloc.Graph.SpillClean (
32 import RegAlloc.Liveness
46 import Data.List ( find, nub )
52 -- | Clean out unneeded spill\/reloads from this top level thing.
55 => LiveCmmTop instr -> LiveCmmTop instr
58 = evalState (cleanSpin 0 cmm) initCleanS
60 -- | do one pass of cleaning
65 -> CleanM (LiveCmmTop instr)
68 cleanSpin spinCount code
69 = do jumpValid <- gets sJumpValid
76 $ cleanSpin' spinCount code
79 cleanSpin spinCount code
81 -- init count of cleaned spills\/reloads
83 { sCleanedSpillsAcc = 0
84 , sCleanedReloadsAcc = 0
85 , sReloadedBy = emptyUFM }
87 code_forward <- mapBlockTopM cleanBlockForward code
88 code_backward <- mapBlockTopM cleanBlockBackward code_forward
90 -- During the cleaning of each block we collected information about what regs
91 -- were valid across each jump. Based on this, work out whether it will be
92 -- safe to erase reloads after join points for the next pass.
95 -- remember how many spills\/reloads we cleaned in this pass
96 spills <- gets sCleanedSpillsAcc
97 reloads <- gets sCleanedReloadsAcc
99 { sCleanedCount = (spills, reloads) : sCleanedCount s }
101 -- if nothing was cleaned in this pass or the last one
102 -- then we're done and it's time to bail out
103 cleanedCount <- gets sCleanedCount
104 if take 2 cleanedCount == [(0, 0), (0, 0)]
107 -- otherwise go around again
108 else cleanSpin (spinCount + 1) code_backward
111 -- | Clean one basic block
114 => LiveBasicBlock instr
115 -> CleanM (LiveBasicBlock instr)
117 cleanBlockForward (BasicBlock blockId instrs)
119 -- see if we have a valid association for the entry to this block
120 jumpValid <- gets sJumpValid
121 let assoc = case lookupUFM jumpValid blockId of
123 Nothing -> emptyAssoc
125 instrs_reload <- cleanForward blockId assoc [] instrs
126 return $ BasicBlock blockId instrs_reload
131 => LiveBasicBlock instr
132 -> CleanM (LiveBasicBlock instr)
134 cleanBlockBackward (BasicBlock blockId instrs)
135 = do instrs_spill <- cleanBackward emptyUniqSet [] instrs
136 return $ BasicBlock blockId instrs_spill
141 -- | Clean out unneeded reload instructions.
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.
148 => BlockId -- ^ the block that we're currently in
149 -> Assoc Store -- ^ two store locations are associated if they have the same value
150 -> [LiveInstr instr] -- ^ acc
151 -> [LiveInstr instr] -- ^ instrs to clean (in backwards order)
152 -> CleanM [LiveInstr instr] -- ^ cleaned instrs (in forward order)
154 cleanForward _ _ acc []
157 -- write out live range joins via spill slots to just a spill and a reg-reg move
158 -- hopefully the spill will be also be cleaned in the next pass
160 cleanForward blockId assoc acc (li1 : li2 : instrs)
162 | SPILL reg1 slot1 <- li1
163 , RELOAD slot2 reg2 <- li2
166 modify $ \s -> s { sCleanedReloadsAcc = sCleanedReloadsAcc s + 1 }
167 cleanForward blockId assoc acc
168 (li1 : Instr (mkRegRegMoveInstr reg1 reg2) Nothing : instrs)
171 cleanForward blockId assoc acc (li@(Instr i1 _) : instrs)
172 | Just (r1, r2) <- takeRegRegMoveInstr i1
174 -- erase any left over nop reg reg moves while we're here
175 -- this will also catch any nop moves that the "write out live range joins" case above
177 then cleanForward blockId assoc acc instrs
179 -- if r1 has the same value as some slots and we copy r1 to r2,
180 -- then r2 is now associated with those slots instead
181 else do let assoc' = addAssoc (SReg r1) (SReg r2)
185 cleanForward blockId assoc' (li : acc) instrs
188 cleanForward blockId assoc acc (li : instrs)
190 -- update association due to the spill
191 | SPILL reg slot <- li
192 = let assoc' = addAssoc (SReg reg) (SSlot slot)
193 $ delAssoc (SSlot slot)
195 in cleanForward blockId assoc' (li : acc) instrs
197 -- clean a reload instr
199 = do (assoc', mli) <- cleanReload blockId assoc li
201 Nothing -> cleanForward blockId assoc' acc instrs
202 Just li' -> cleanForward blockId assoc' (li' : acc) instrs
204 -- remember the association over a jump
205 | Instr instr _ <- li
206 , targets <- jumpDestsOfInstr instr
208 = do mapM_ (accJumpValid assoc) targets
209 cleanForward blockId assoc (li : acc) instrs
211 -- writing to a reg changes its value.
212 | Instr instr _ <- li
213 , RU _ written <- regUsageOfInstr instr
214 = let assoc' = foldr delAssoc assoc (map SReg $ nub written)
215 in cleanForward blockId assoc' (li : acc) instrs
217 -- bogus, to stop pattern match warning
219 = panic "RegAlloc.Graph.SpillClean.cleanForward: no match"
222 -- | Try and rewrite a reload instruction to something more pleasing
229 -> CleanM (Assoc Store, Maybe (LiveInstr instr))
231 cleanReload blockId assoc li@(RELOAD slot reg)
233 -- if the reg we're reloading already has the same value as the slot
234 -- then we can erase the instruction outright
235 | elemAssoc (SSlot slot) (SReg reg) assoc
236 = do modify $ \s -> s { sCleanedReloadsAcc = sCleanedReloadsAcc s + 1 }
237 return (assoc, Nothing)
239 -- if we can find another reg with the same value as this slot then
240 -- do a move instead of a reload.
241 | Just reg2 <- findRegOfSlot assoc slot
242 = do modify $ \s -> s { sCleanedReloadsAcc = sCleanedReloadsAcc s + 1 }
244 let assoc' = addAssoc (SReg reg) (SReg reg2)
245 $ delAssoc (SReg reg)
248 return (assoc', Just $ Instr (mkRegRegMoveInstr reg2 reg) Nothing)
250 -- gotta keep this instr
252 = do -- update the association
253 let assoc' = addAssoc (SReg reg) (SSlot slot) -- doing the reload makes reg and slot the same value
254 $ delAssoc (SReg reg) -- reg value changes on reload
257 -- remember that this block reloads from this slot
258 accBlockReloadsSlot blockId slot
260 return (assoc', Just li)
263 = panic "RegSpillClean.cleanReload: unhandled instr"
266 -- | Clean out unneeded spill instructions.
268 -- If there were no reloads from a slot between a spill and the last one
269 -- then the slot was never read and we don't need the spill.
273 -- SPILL r3 -> s1 <--- don't need this spill
278 -- "slots which were spilled to but not reloaded from yet"
280 -- Walking backwards across the code:
281 -- a) On a reload from a slot, remove it from the set.
283 -- a) On a spill from a slot
284 -- If the slot is in set then we can erase the spill,
285 -- because it won't be reloaded from until after the next spill.
288 -- keep the spill and add the slot to the set
290 -- TODO: This is mostly inter-block
291 -- we should really be updating the noReloads set as we cross jumps also.
294 :: UniqSet Int -- ^ slots that have been spilled, but not reloaded from
295 -> [LiveInstr instr] -- ^ acc
296 -> [LiveInstr instr] -- ^ instrs to clean (in forwards order)
297 -> CleanM [LiveInstr instr] -- ^ cleaned instrs (in backwards order)
300 cleanBackward noReloads acc lis
301 = do reloadedBy <- gets sReloadedBy
302 cleanBackward' reloadedBy noReloads acc lis
304 cleanBackward' _ _ acc []
307 cleanBackward' reloadedBy noReloads acc (li : instrs)
309 -- if nothing ever reloads from this slot then we don't need the spill
311 , Nothing <- lookupUFM reloadedBy (SSlot slot)
312 = do modify $ \s -> s { sCleanedSpillsAcc = sCleanedSpillsAcc s + 1 }
313 cleanBackward noReloads acc instrs
316 = if elementOfUniqSet slot noReloads
318 -- we can erase this spill because the slot won't be read until after the next one
320 modify $ \s -> s { sCleanedSpillsAcc = sCleanedSpillsAcc s + 1 }
321 cleanBackward noReloads acc instrs
324 -- this slot is being spilled to, but we haven't seen any reloads yet.
325 let noReloads' = addOneToUniqSet noReloads slot
326 cleanBackward noReloads' (li : acc) instrs
328 -- if we reload from a slot then it's no longer unused
329 | RELOAD slot _ <- li
330 , noReloads' <- delOneFromUniqSet noReloads slot
331 = cleanBackward noReloads' (li : acc) instrs
333 -- some other instruction
335 = cleanBackward noReloads (li : acc) instrs
338 -- collateJoinPoints:
340 -- | combine the associations from all the inward control flow edges.
342 collateJoinPoints :: CleanM ()
345 { sJumpValid = mapUFM intersects (sJumpValidAcc s)
346 , sJumpValidAcc = emptyUFM }
348 intersects :: [Assoc Store] -> Assoc Store
349 intersects [] = emptyAssoc
350 intersects assocs = foldl1' intersectAssoc assocs
353 -- | See if we have a reg with the same value as this slot in the association table.
354 findRegOfSlot :: Assoc Store -> Int -> Maybe Reg
355 findRegOfSlot assoc slot
356 | close <- closeAssoc (SSlot slot) assoc
357 , Just (SReg reg) <- find isStoreReg $ uniqSetToList close
365 type CleanM = State CleanS
368 { -- regs which are valid at the start of each block.
369 sJumpValid :: UniqFM (Assoc Store)
371 -- collecting up what regs were valid across each jump.
372 -- in the next pass we can collate these and write the results
374 , sJumpValidAcc :: UniqFM [Assoc Store]
376 -- map of (slot -> blocks which reload from this slot)
377 -- used to decide if whether slot spilled to will ever be
378 -- reloaded from on this path.
379 , sReloadedBy :: UniqFM [BlockId]
381 -- spills\/reloads cleaned each pass (latest at front)
382 , sCleanedCount :: [(Int, Int)]
384 -- spills\/reloads that have been cleaned in this pass so far.
385 , sCleanedSpillsAcc :: Int
386 , sCleanedReloadsAcc :: Int }
391 { sJumpValid = emptyUFM
392 , sJumpValidAcc = emptyUFM
394 , sReloadedBy = emptyUFM
398 , sCleanedSpillsAcc = 0
399 , sCleanedReloadsAcc = 0 }
402 -- | Remember the associations before a jump
403 accJumpValid :: Assoc Store -> BlockId -> CleanM ()
404 accJumpValid assocs target
406 sJumpValidAcc = addToUFM_C (++)
412 accBlockReloadsSlot :: BlockId -> Slot -> CleanM ()
413 accBlockReloadsSlot blockId slot
415 sReloadedBy = addToUFM_C (++)
422 -- A store location can be a stack slot or a register
428 -- | Check if this is a reg store
429 isStoreReg :: Store -> Bool
435 -- spill cleaning is only done once all virtuals have been allocated to realRegs
437 instance Uniquable Store where
443 = error "RegSpillClean.getUnique: found virtual reg during spill clean, only real regs expected."
445 getUnique (SSlot i) = mkUnique 'S' i
447 instance Outputable Store where
448 ppr (SSlot i) = text "slot" <> int i
453 -- Association graphs.
454 -- In the spill cleaner, two store locations are associated if they are known
455 -- to hold the same value.
457 type Assoc a = UniqFM (UniqSet a)
459 -- | an empty association
460 emptyAssoc :: Assoc a
461 emptyAssoc = emptyUFM
464 -- | add an association between these two things
465 addAssoc :: Uniquable a
466 => a -> a -> Assoc a -> Assoc a
469 = let m1 = addToUFM_C unionUniqSets m a (unitUniqSet b)
470 m2 = addToUFM_C unionUniqSets m1 b (unitUniqSet a)
474 -- | delete all associations to a node
475 delAssoc :: (Outputable a, Uniquable a)
476 => a -> Assoc a -> Assoc a
479 | Just aSet <- lookupUFM m a
480 , m1 <- delFromUFM m a
481 = foldUniqSet (\x m -> delAssoc1 x a m) m1 aSet
486 -- | delete a single association edge (a -> b)
487 delAssoc1 :: Uniquable a
488 => a -> a -> Assoc a -> Assoc a
491 | Just aSet <- lookupUFM m a
492 = addToUFM m a (delOneFromUniqSet aSet b)
497 -- | check if these two things are associated
498 elemAssoc :: (Outputable a, Uniquable a)
499 => a -> a -> Assoc a -> Bool
502 = elementOfUniqSet b (closeAssoc a m)
504 -- | find the refl. trans. closure of the association from this point
505 closeAssoc :: (Outputable a, Uniquable a)
506 => a -> Assoc a -> UniqSet a
509 = closeAssoc' assoc emptyUniqSet (unitUniqSet a)
511 closeAssoc' assoc visited toVisit
512 = case uniqSetToList toVisit of
514 -- nothing else to visit, we're done
519 -- we've already seen this node
520 | elementOfUniqSet x visited
521 -> closeAssoc' assoc visited (delOneFromUniqSet toVisit x)
523 -- haven't seen this node before,
524 -- remember to visit all its neighbors
527 = case lookupUFM assoc x of
528 Nothing -> emptyUniqSet
532 (addOneToUniqSet visited x)
533 (unionUniqSets toVisit neighbors)
538 => Assoc a -> Assoc a -> Assoc a
541 = intersectUFM_C (intersectUniqSets) a b