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
45 import Data.List ( find, nub )
51 -- | Clean out unneeded spill\/reloads from this top level thing.
54 => LiveCmmTop instr -> LiveCmmTop instr
57 = evalState (cleanSpin 0 cmm) initCleanS
59 -- | do one pass of cleaning
64 -> CleanM (LiveCmmTop instr)
67 cleanSpin spinCount code
68 = do jumpValid <- gets sJumpValid
75 $ cleanSpin' spinCount code
78 cleanSpin spinCount code
80 -- init count of cleaned spills\/reloads
82 { sCleanedSpillsAcc = 0
83 , sCleanedReloadsAcc = 0
84 , sReloadedBy = emptyUFM }
86 code_forward <- mapBlockTopM cleanBlockForward code
87 code_backward <- mapBlockTopM cleanBlockBackward code_forward
89 -- During the cleaning of each block we collected information about what regs
90 -- were valid across each jump. Based on this, work out whether it will be
91 -- safe to erase reloads after join points for the next pass.
94 -- remember how many spills\/reloads we cleaned in this pass
95 spills <- gets sCleanedSpillsAcc
96 reloads <- gets sCleanedReloadsAcc
98 { sCleanedCount = (spills, reloads) : sCleanedCount s }
100 -- if nothing was cleaned in this pass or the last one
101 -- then we're done and it's time to bail out
102 cleanedCount <- gets sCleanedCount
103 if take 2 cleanedCount == [(0, 0), (0, 0)]
106 -- otherwise go around again
107 else cleanSpin (spinCount + 1) code_backward
110 -- | Clean one basic block
113 => LiveBasicBlock instr
114 -> CleanM (LiveBasicBlock instr)
116 cleanBlockForward (BasicBlock blockId instrs)
118 -- see if we have a valid association for the entry to this block
119 jumpValid <- gets sJumpValid
120 let assoc = case lookupUFM jumpValid blockId of
122 Nothing -> emptyAssoc
124 instrs_reload <- cleanForward blockId assoc [] instrs
125 return $ BasicBlock blockId instrs_reload
130 => LiveBasicBlock instr
131 -> CleanM (LiveBasicBlock instr)
133 cleanBlockBackward (BasicBlock blockId instrs)
134 = do instrs_spill <- cleanBackward emptyUniqSet [] instrs
135 return $ BasicBlock blockId instrs_spill
140 -- | Clean out unneeded reload instructions.
141 -- Walking forwards across the code
142 -- On a reload, if we know a reg already has the same value as a slot
143 -- then we don't need to do the reload.
147 => BlockId -- ^ the block that we're currently in
148 -> Assoc Store -- ^ two store locations are associated if they have the same value
149 -> [LiveInstr instr] -- ^ acc
150 -> [LiveInstr instr] -- ^ instrs to clean (in backwards order)
151 -> CleanM [LiveInstr instr] -- ^ cleaned instrs (in forward order)
153 cleanForward _ _ acc []
156 -- write out live range joins via spill slots to just a spill and a reg-reg move
157 -- hopefully the spill will be also be cleaned in the next pass
159 cleanForward blockId assoc acc (li1 : li2 : instrs)
161 | LiveInstr (SPILL reg1 slot1) _ <- li1
162 , LiveInstr (RELOAD slot2 reg2) _ <- li2
165 modify $ \s -> s { sCleanedReloadsAcc = sCleanedReloadsAcc s + 1 }
166 cleanForward blockId assoc acc
167 (li1 : LiveInstr (mkRegRegMoveInstr reg1 reg2) Nothing : instrs)
170 cleanForward blockId assoc acc (li@(LiveInstr i1 _) : instrs)
171 | Just (r1, r2) <- takeRegRegMoveInstr i1
173 -- erase any left over nop reg reg moves while we're here
174 -- this will also catch any nop moves that the "write out live range joins" case above
176 then cleanForward blockId assoc acc instrs
178 -- if r1 has the same value as some slots and we copy r1 to r2,
179 -- then r2 is now associated with those slots instead
180 else do let assoc' = addAssoc (SReg r1) (SReg r2)
184 cleanForward blockId assoc' (li : acc) instrs
187 cleanForward blockId assoc acc (li : instrs)
189 -- update association due to the spill
190 | LiveInstr (SPILL reg slot) _ <- li
191 = let assoc' = addAssoc (SReg reg) (SSlot slot)
192 $ delAssoc (SSlot slot)
194 in cleanForward blockId assoc' (li : acc) instrs
196 -- clean a reload instr
197 | LiveInstr (RELOAD{}) _ <- li
198 = do (assoc', mli) <- cleanReload blockId assoc li
200 Nothing -> cleanForward blockId assoc' acc instrs
201 Just li' -> cleanForward blockId assoc' (li' : acc) instrs
203 -- remember the association over a jump
204 | LiveInstr instr _ <- li
205 , targets <- jumpDestsOfInstr instr
207 = do mapM_ (accJumpValid assoc) targets
208 cleanForward blockId assoc (li : acc) instrs
210 -- writing to a reg changes its value.
211 | LiveInstr instr _ <- li
212 , RU _ written <- regUsageOfInstr instr
213 = let assoc' = foldr delAssoc assoc (map SReg $ nub written)
214 in cleanForward blockId assoc' (li : acc) instrs
218 -- | Try and rewrite a reload instruction to something more pleasing
225 -> CleanM (Assoc Store, Maybe (LiveInstr instr))
227 cleanReload blockId assoc li@(LiveInstr (RELOAD slot reg) _)
229 -- if the reg we're reloading already has the same value as the slot
230 -- then we can erase the instruction outright
231 | elemAssoc (SSlot slot) (SReg reg) assoc
232 = do modify $ \s -> s { sCleanedReloadsAcc = sCleanedReloadsAcc s + 1 }
233 return (assoc, Nothing)
235 -- if we can find another reg with the same value as this slot then
236 -- do a move instead of a reload.
237 | Just reg2 <- findRegOfSlot assoc slot
238 = do modify $ \s -> s { sCleanedReloadsAcc = sCleanedReloadsAcc s + 1 }
240 let assoc' = addAssoc (SReg reg) (SReg reg2)
241 $ delAssoc (SReg reg)
244 return (assoc', Just $ LiveInstr (mkRegRegMoveInstr reg2 reg) Nothing)
246 -- gotta keep this instr
248 = do -- update the association
249 let assoc' = addAssoc (SReg reg) (SSlot slot) -- doing the reload makes reg and slot the same value
250 $ delAssoc (SReg reg) -- reg value changes on reload
253 -- remember that this block reloads from this slot
254 accBlockReloadsSlot blockId slot
256 return (assoc', Just li)
259 = panic "RegSpillClean.cleanReload: unhandled instr"
262 -- | Clean out unneeded spill instructions.
264 -- If there were no reloads from a slot between a spill and the last one
265 -- then the slot was never read and we don't need the spill.
269 -- SPILL r3 -> s1 <--- don't need this spill
274 -- "slots which were spilled to but not reloaded from yet"
276 -- Walking backwards across the code:
277 -- a) On a reload from a slot, remove it from the set.
279 -- a) On a spill from a slot
280 -- If the slot is in set then we can erase the spill,
281 -- because it won't be reloaded from until after the next spill.
284 -- keep the spill and add the slot to the set
286 -- TODO: This is mostly inter-block
287 -- we should really be updating the noReloads set as we cross jumps also.
290 :: UniqSet Int -- ^ slots that have been spilled, but not reloaded from
291 -> [LiveInstr instr] -- ^ acc
292 -> [LiveInstr instr] -- ^ instrs to clean (in forwards order)
293 -> CleanM [LiveInstr instr] -- ^ cleaned instrs (in backwards order)
296 cleanBackward noReloads acc lis
297 = do reloadedBy <- gets sReloadedBy
298 cleanBackward' reloadedBy noReloads acc lis
300 cleanBackward' _ _ acc []
303 cleanBackward' reloadedBy noReloads acc (li : instrs)
305 -- if nothing ever reloads from this slot then we don't need the spill
306 | LiveInstr (SPILL _ slot) _ <- li
307 , Nothing <- lookupUFM reloadedBy (SSlot slot)
308 = do modify $ \s -> s { sCleanedSpillsAcc = sCleanedSpillsAcc s + 1 }
309 cleanBackward noReloads acc instrs
311 | LiveInstr (SPILL _ slot) _ <- li
312 = if elementOfUniqSet slot noReloads
314 -- we can erase this spill because the slot won't be read until after the next one
316 modify $ \s -> s { sCleanedSpillsAcc = sCleanedSpillsAcc s + 1 }
317 cleanBackward noReloads acc instrs
320 -- this slot is being spilled to, but we haven't seen any reloads yet.
321 let noReloads' = addOneToUniqSet noReloads slot
322 cleanBackward noReloads' (li : acc) instrs
324 -- if we reload from a slot then it's no longer unused
325 | LiveInstr (RELOAD slot _) _ <- li
326 , noReloads' <- delOneFromUniqSet noReloads slot
327 = cleanBackward noReloads' (li : acc) instrs
329 -- some other instruction
331 = cleanBackward noReloads (li : acc) instrs
334 -- collateJoinPoints:
336 -- | combine the associations from all the inward control flow edges.
338 collateJoinPoints :: CleanM ()
341 { sJumpValid = mapUFM intersects (sJumpValidAcc s)
342 , sJumpValidAcc = emptyUFM }
344 intersects :: [Assoc Store] -> Assoc Store
345 intersects [] = emptyAssoc
346 intersects assocs = foldl1' intersectAssoc assocs
349 -- | See if we have a reg with the same value as this slot in the association table.
350 findRegOfSlot :: Assoc Store -> Int -> Maybe Reg
351 findRegOfSlot assoc slot
352 | close <- closeAssoc (SSlot slot) assoc
353 , Just (SReg reg) <- find isStoreReg $ uniqSetToList close
361 type CleanM = State CleanS
364 { -- regs which are valid at the start of each block.
365 sJumpValid :: UniqFM (Assoc Store)
367 -- collecting up what regs were valid across each jump.
368 -- in the next pass we can collate these and write the results
370 , sJumpValidAcc :: UniqFM [Assoc Store]
372 -- map of (slot -> blocks which reload from this slot)
373 -- used to decide if whether slot spilled to will ever be
374 -- reloaded from on this path.
375 , sReloadedBy :: UniqFM [BlockId]
377 -- spills\/reloads cleaned each pass (latest at front)
378 , sCleanedCount :: [(Int, Int)]
380 -- spills\/reloads that have been cleaned in this pass so far.
381 , sCleanedSpillsAcc :: Int
382 , sCleanedReloadsAcc :: Int }
387 { sJumpValid = emptyUFM
388 , sJumpValidAcc = emptyUFM
390 , sReloadedBy = emptyUFM
394 , sCleanedSpillsAcc = 0
395 , sCleanedReloadsAcc = 0 }
398 -- | Remember the associations before a jump
399 accJumpValid :: Assoc Store -> BlockId -> CleanM ()
400 accJumpValid assocs target
402 sJumpValidAcc = addToUFM_C (++)
408 accBlockReloadsSlot :: BlockId -> Slot -> CleanM ()
409 accBlockReloadsSlot blockId slot
411 sReloadedBy = addToUFM_C (++)
418 -- A store location can be a stack slot or a register
424 -- | Check if this is a reg store
425 isStoreReg :: Store -> Bool
431 -- spill cleaning is only done once all virtuals have been allocated to realRegs
433 instance Uniquable Store where
435 | RegReal (RealRegSingle i) <- r
436 = mkRegSingleUnique i
438 | RegReal (RealRegPair r1 r2) <- r
439 = mkRegPairUnique (r1 * 65535 + r2)
442 = error "RegSpillClean.getUnique: found virtual reg during spill clean, only real regs expected."
444 getUnique (SSlot i) = mkRegSubUnique i -- [SLPJ] I hope "SubUnique" is ok
446 instance Outputable Store where
447 ppr (SSlot i) = text "slot" <> int i
452 -- Association graphs.
453 -- In the spill cleaner, two store locations are associated if they are known
454 -- to hold the same value.
456 type Assoc a = UniqFM (UniqSet a)
458 -- | an empty association
459 emptyAssoc :: Assoc a
460 emptyAssoc = emptyUFM
463 -- | add an association between these two things
464 addAssoc :: Uniquable a
465 => a -> a -> Assoc a -> Assoc a
468 = let m1 = addToUFM_C unionUniqSets m a (unitUniqSet b)
469 m2 = addToUFM_C unionUniqSets m1 b (unitUniqSet a)
473 -- | delete all associations to a node
474 delAssoc :: (Outputable a, Uniquable a)
475 => a -> Assoc a -> Assoc a
478 | Just aSet <- lookupUFM m a
479 , m1 <- delFromUFM m a
480 = foldUniqSet (\x m -> delAssoc1 x a m) m1 aSet
485 -- | delete a single association edge (a -> b)
486 delAssoc1 :: Uniquable a
487 => a -> a -> Assoc a -> Assoc a
490 | Just aSet <- lookupUFM m a
491 = addToUFM m a (delOneFromUniqSet aSet b)
496 -- | check if these two things are associated
497 elemAssoc :: (Outputable a, Uniquable a)
498 => a -> a -> Assoc a -> Bool
501 = elementOfUniqSet b (closeAssoc a m)
503 -- | find the refl. trans. closure of the association from this point
504 closeAssoc :: (Outputable a, Uniquable a)
505 => a -> Assoc a -> UniqSet a
508 = closeAssoc' assoc emptyUniqSet (unitUniqSet a)
510 closeAssoc' assoc visited toVisit
511 = case uniqSetToList toVisit of
513 -- nothing else to visit, we're done
518 -- we've already seen this node
519 | elementOfUniqSet x visited
520 -> closeAssoc' assoc visited (delOneFromUniqSet toVisit x)
522 -- haven't seen this node before,
523 -- remember to visit all its neighbors
526 = case lookupUFM assoc x of
527 Nothing -> emptyUniqSet
531 (addOneToUniqSet visited x)
532 (unionUniqSets toVisit neighbors)
537 => Assoc a -> Assoc a -> Assoc a
540 = intersectUFM_C (intersectUniqSets) a b