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 RegSpillClean (
47 import Data.List ( find, nub )
53 -- | Clean out unneeded spill/reloads from this top level thing.
54 cleanSpills :: LiveCmmTop -> LiveCmmTop
56 = evalState (cleanSpin 0 cmm) initCleanS
58 -- | do one pass of cleaning
59 cleanSpin :: Int -> LiveCmmTop -> CleanM LiveCmmTop
62 cleanSpin spinCount code
63 = do jumpValid <- gets sJumpValid
70 $ cleanSpin' spinCount code
73 cleanSpin spinCount code
75 -- init count of cleaned spills/reloads
77 { sCleanedSpillsAcc = 0
78 , sCleanedReloadsAcc = 0
79 , sReloadedBy = emptyUFM }
81 code_forward <- mapBlockTopM cleanBlockForward code
82 code_backward <- mapBlockTopM cleanBlockBackward code_forward
84 -- During the cleaning of each block we collected information about what regs
85 -- were valid across each jump. Based on this, work out whether it will be
86 -- safe to erase reloads after join points for the next pass.
89 -- remember how many spills/reloads we cleaned in this pass
90 spills <- gets sCleanedSpillsAcc
91 reloads <- gets sCleanedReloadsAcc
93 { sCleanedCount = (spills, reloads) : sCleanedCount s }
95 -- if nothing was cleaned in this pass or the last one
96 -- then we're done and it's time to bail out
97 cleanedCount <- gets sCleanedCount
98 if take 2 cleanedCount == [(0, 0), (0, 0)]
101 -- otherwise go around again
102 else cleanSpin (spinCount + 1) code_backward
105 -- | Clean one basic block
106 cleanBlockForward :: LiveBasicBlock -> CleanM LiveBasicBlock
107 cleanBlockForward (BasicBlock blockId instrs)
109 -- see if we have a valid association for the entry to this block
110 jumpValid <- gets sJumpValid
111 let assoc = case lookupUFM jumpValid blockId of
113 Nothing -> emptyAssoc
115 instrs_reload <- cleanForward blockId assoc [] instrs
116 return $ BasicBlock blockId instrs_reload
119 cleanBlockBackward :: LiveBasicBlock -> CleanM LiveBasicBlock
120 cleanBlockBackward (BasicBlock blockId instrs)
121 = do instrs_spill <- cleanBackward emptyUniqSet [] instrs
122 return $ BasicBlock blockId instrs_spill
127 -- | Clean out unneeded reload instructions.
128 -- Walking forwards across the code
129 -- On a reload, if we know a reg already has the same value as a slot
130 -- then we don't need to do the reload.
133 :: BlockId -- ^ the block that we're currently in
134 -> Assoc Store -- ^ two store locations are associated if they have the same value
135 -> [LiveInstr] -- ^ acc
136 -> [LiveInstr] -- ^ instrs to clean (in backwards order)
137 -> CleanM [LiveInstr] -- ^ cleaned instrs (in forward order)
139 cleanForward _ _ acc []
142 -- write out live range joins via spill slots to just a spill and a reg-reg move
143 -- hopefully the spill will be also be cleaned in the next pass
145 cleanForward blockId assoc acc (Instr i1 live1 : Instr i2 _ : instrs)
147 | SPILL reg1 slot1 <- i1
148 , RELOAD slot2 reg2 <- i2
151 modify $ \s -> s { sCleanedReloadsAcc = sCleanedReloadsAcc s + 1 }
152 cleanForward blockId assoc acc
153 (Instr i1 live1 : Instr (mkRegRegMoveInstr reg1 reg2) Nothing : instrs)
156 cleanForward blockId assoc acc (li@(Instr i1 _) : instrs)
157 | Just (r1, r2) <- isRegRegMove i1
159 -- erase any left over nop reg reg moves while we're here
160 -- this will also catch any nop moves that the "write out live range joins" case above
162 then cleanForward blockId assoc acc instrs
164 -- if r1 has the same value as some slots and we copy r1 to r2,
165 -- then r2 is now associated with those slots instead
166 else do let assoc' = addAssoc (SReg r1) (SReg r2)
170 cleanForward blockId assoc' (li : acc) instrs
173 cleanForward blockId assoc acc (li@(Instr instr _) : instrs)
175 -- update association due to the spill
176 | SPILL reg slot <- instr
177 = let assoc' = addAssoc (SReg reg) (SSlot slot)
178 $ delAssoc (SSlot slot)
180 in cleanForward blockId assoc' (li : acc) instrs
182 -- clean a reload instr
184 = do (assoc', mli) <- cleanReload blockId assoc li
186 Nothing -> cleanForward blockId assoc' acc instrs
187 Just li' -> cleanForward blockId assoc' (li' : acc) instrs
189 -- remember the association over a jump
190 | targets <- jumpDests instr []
192 = do mapM_ (accJumpValid assoc) targets
193 cleanForward blockId assoc (li : acc) instrs
195 -- writing to a reg changes its value.
196 | RU _ written <- regUsage instr
197 = let assoc' = foldr delAssoc assoc (map SReg $ nub written)
198 in cleanForward blockId assoc' (li : acc) instrs
201 -- | Try and rewrite a reload instruction to something more pleasing
203 cleanReload :: BlockId -> Assoc Store -> LiveInstr -> CleanM (Assoc Store, Maybe LiveInstr)
204 cleanReload blockId assoc li@(Instr (RELOAD slot reg) _)
206 -- if the reg we're reloading already has the same value as the slot
207 -- then we can erase the instruction outright
208 | elemAssoc (SSlot slot) (SReg reg) assoc
209 = do modify $ \s -> s { sCleanedReloadsAcc = sCleanedReloadsAcc s + 1 }
210 return (assoc, Nothing)
212 -- if we can find another reg with the same value as this slot then
213 -- do a move instead of a reload.
214 | Just reg2 <- findRegOfSlot assoc slot
215 = do modify $ \s -> s { sCleanedReloadsAcc = sCleanedReloadsAcc s + 1 }
217 let assoc' = addAssoc (SReg reg) (SReg reg2)
218 $ delAssoc (SReg reg)
221 return (assoc', Just $ Instr (mkRegRegMoveInstr reg2 reg) Nothing)
223 -- gotta keep this instr
225 = do -- update the association
226 let assoc' = addAssoc (SReg reg) (SSlot slot) -- doing the reload makes reg and slot the same value
227 $ delAssoc (SReg reg) -- reg value changes on reload
230 -- remember that this block reloads from this slot
231 accBlockReloadsSlot blockId slot
233 return (assoc', Just li)
236 = panic "RegSpillClean.cleanReload: unhandled instr"
239 -- | Clean out unneeded spill instructions.
241 -- If there were no reloads from a slot between a spill and the last one
242 -- then the slot was never read and we don't need the spill.
246 -- SPILL r3 -> s1 <--- don't need this spill
251 -- "slots which were spilled to but not reloaded from yet"
253 -- Walking backwards across the code:
254 -- a) On a reload from a slot, remove it from the set.
256 -- a) On a spill from a slot
257 -- If the slot is in set then we can erase the spill,
258 -- because it won't be reloaded from until after the next spill.
261 -- keep the spill and add the slot to the set
263 -- TODO: This is mostly inter-block
264 -- we should really be updating the noReloads set as we cross jumps also.
267 :: UniqSet Int -- ^ slots that have been spilled, but not reloaded from
268 -> [LiveInstr] -- ^ acc
269 -> [LiveInstr] -- ^ instrs to clean (in forwards order)
270 -> CleanM [LiveInstr] -- ^ cleaned instrs (in backwards order)
273 cleanBackward noReloads acc lis
274 = do reloadedBy <- gets sReloadedBy
275 cleanBackward' reloadedBy noReloads acc lis
277 cleanBackward' _ _ acc []
280 cleanBackward' reloadedBy noReloads acc (li@(Instr instr _) : instrs)
282 -- if nothing ever reloads from this slot then we don't need the spill
283 | SPILL _ slot <- instr
284 , Nothing <- lookupUFM reloadedBy (SSlot slot)
285 = do modify $ \s -> s { sCleanedSpillsAcc = sCleanedSpillsAcc s + 1 }
286 cleanBackward noReloads acc instrs
288 | SPILL _ slot <- instr
289 = if elementOfUniqSet slot noReloads
291 -- we can erase this spill because the slot won't be read until after the next one
293 modify $ \s -> s { sCleanedSpillsAcc = sCleanedSpillsAcc s + 1 }
294 cleanBackward noReloads acc instrs
297 -- this slot is being spilled to, but we haven't seen any reloads yet.
298 let noReloads' = addOneToUniqSet noReloads slot
299 cleanBackward noReloads' (li : acc) instrs
301 -- if we reload from a slot then it's no longer unused
302 | RELOAD slot _ <- instr
303 , noReloads' <- delOneFromUniqSet noReloads slot
304 = cleanBackward noReloads' (li : acc) instrs
306 -- some other instruction
308 = cleanBackward noReloads (li : acc) instrs
311 -- collateJoinPoints:
313 -- | combine the associations from all the inward control flow edges.
315 collateJoinPoints :: CleanM ()
318 { sJumpValid = mapUFM intersects (sJumpValidAcc s)
319 , sJumpValidAcc = emptyUFM }
321 intersects :: [Assoc Store] -> Assoc Store
322 intersects [] = emptyAssoc
323 intersects assocs = foldl1' intersectAssoc assocs
326 -- | See if we have a reg with the same value as this slot in the association table.
327 findRegOfSlot :: Assoc Store -> Int -> Maybe Reg
328 findRegOfSlot assoc slot
329 | close <- closeAssoc (SSlot slot) assoc
330 , Just (SReg reg) <- find isStoreReg $ uniqSetToList close
338 type CleanM = State CleanS
341 { -- regs which are valid at the start of each block.
342 sJumpValid :: UniqFM (Assoc Store)
344 -- collecting up what regs were valid across each jump.
345 -- in the next pass we can collate these and write the results
347 , sJumpValidAcc :: UniqFM [Assoc Store]
349 -- map of (slot -> blocks which reload from this slot)
350 -- used to decide if whether slot spilled to will ever be
351 -- reloaded from on this path.
352 , sReloadedBy :: UniqFM [BlockId]
354 -- spills/reloads cleaned each pass (latest at front)
355 , sCleanedCount :: [(Int, Int)]
357 -- spills/reloads that have been cleaned in this pass so far.
358 , sCleanedSpillsAcc :: Int
359 , sCleanedReloadsAcc :: Int }
364 { sJumpValid = emptyUFM
365 , sJumpValidAcc = emptyUFM
367 , sReloadedBy = emptyUFM
371 , sCleanedSpillsAcc = 0
372 , sCleanedReloadsAcc = 0 }
375 -- | Remember the associations before a jump
376 accJumpValid :: Assoc Store -> BlockId -> CleanM ()
377 accJumpValid assocs target
379 sJumpValidAcc = addToUFM_C (++)
385 accBlockReloadsSlot :: BlockId -> Slot -> CleanM ()
386 accBlockReloadsSlot blockId slot
388 sReloadedBy = addToUFM_C (++)
395 -- A store location can be a stack slot or a register
401 -- | Check if this is a reg store
402 isStoreReg :: Store -> Bool
408 -- spill cleaning is only done once all virtuals have been allocated to realRegs
410 instance Uniquable Store where
416 = error "RegSpillClean.getUnique: found virtual reg during spill clean, only real regs expected."
418 getUnique (SSlot i) = mkUnique 'S' i
420 instance Outputable Store where
421 ppr (SSlot i) = text "slot" <> int i
426 -- Association graphs.
427 -- In the spill cleaner, two store locations are associated if they are known
428 -- to hold the same value.
430 type Assoc a = UniqFM (UniqSet a)
432 -- | an empty association
433 emptyAssoc :: Assoc a
434 emptyAssoc = emptyUFM
437 -- | add an association between these two things
438 addAssoc :: Uniquable a
439 => a -> a -> Assoc a -> Assoc a
442 = let m1 = addToUFM_C unionUniqSets m a (unitUniqSet b)
443 m2 = addToUFM_C unionUniqSets m1 b (unitUniqSet a)
447 -- | delete all associations to a node
448 delAssoc :: (Outputable a, Uniquable a)
449 => a -> Assoc a -> Assoc a
452 | Just aSet <- lookupUFM m a
453 , m1 <- delFromUFM m a
454 = foldUniqSet (\x m -> delAssoc1 x a m) m1 aSet
459 -- | delete a single association edge (a -> b)
460 delAssoc1 :: Uniquable a
461 => a -> a -> Assoc a -> Assoc a
464 | Just aSet <- lookupUFM m a
465 = addToUFM m a (delOneFromUniqSet aSet b)
470 -- | check if these two things are associated
471 elemAssoc :: (Outputable a, Uniquable a)
472 => a -> a -> Assoc a -> Bool
475 = elementOfUniqSet b (closeAssoc a m)
477 -- | find the refl. trans. closure of the association from this point
478 closeAssoc :: (Outputable a, Uniquable a)
479 => a -> Assoc a -> UniqSet a
482 = closeAssoc' assoc emptyUniqSet (unitUniqSet a)
484 closeAssoc' assoc visited toVisit
485 = case uniqSetToList toVisit of
487 -- nothing else to visit, we're done
492 -- we've already seen this node
493 | elementOfUniqSet x visited
494 -> closeAssoc' assoc visited (delOneFromUniqSet toVisit x)
496 -- haven't seen this node before,
497 -- remember to visit all its neighbors
500 = case lookupUFM assoc x of
501 Nothing -> emptyUniqSet
505 (addOneToUniqSet visited x)
506 (unionUniqSets toVisit neighbors)
511 => Assoc a -> Assoc a -> Assoc a
514 = intersectUFM_C (intersectUniqSets) a b