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
48 import qualified Data.Map as Map
49 import qualified Data.Set as Set
56 -- | Clean out unneeded spill\/reloads from this top level thing.
59 => LiveCmmTop instr -> LiveCmmTop instr
62 = evalState (cleanSpin 0 cmm) initCleanS
64 -- | do one pass of cleaning
69 -> CleanM (LiveCmmTop instr)
72 cleanSpin spinCount code
73 = do jumpValid <- gets sJumpValid
80 $ cleanSpin' spinCount code
83 cleanSpin spinCount code
85 -- init count of cleaned spills\/reloads
87 { sCleanedSpillsAcc = 0
88 , sCleanedReloadsAcc = 0
89 , sReloadedBy = emptyUFM }
91 code_forward <- mapBlockTopM cleanBlockForward code
92 code_backward <- cleanTopBackward code_forward
94 -- During the cleaning of each block we collected information about what regs
95 -- were valid across each jump. Based on this, work out whether it will be
96 -- safe to erase reloads after join points for the next pass.
99 -- remember how many spills\/reloads we cleaned in this pass
100 spills <- gets sCleanedSpillsAcc
101 reloads <- gets sCleanedReloadsAcc
103 { sCleanedCount = (spills, reloads) : sCleanedCount s }
105 -- if nothing was cleaned in this pass or the last one
106 -- then we're done and it's time to bail out
107 cleanedCount <- gets sCleanedCount
108 if take 2 cleanedCount == [(0, 0), (0, 0)]
111 -- otherwise go around again
112 else cleanSpin (spinCount + 1) code_backward
115 -- | Clean one basic block
118 => LiveBasicBlock instr
119 -> CleanM (LiveBasicBlock instr)
121 cleanBlockForward (BasicBlock blockId instrs)
123 -- see if we have a valid association for the entry to this block
124 jumpValid <- gets sJumpValid
125 let assoc = case lookupUFM jumpValid blockId of
127 Nothing -> emptyAssoc
129 instrs_reload <- cleanForward blockId assoc [] instrs
130 return $ BasicBlock blockId instrs_reload
134 -- | Clean out unneeded reload instructions.
135 -- Walking forwards across the code
136 -- On a reload, if we know a reg already has the same value as a slot
137 -- then we don't need to do the reload.
141 => BlockId -- ^ the block that we're currently in
142 -> Assoc Store -- ^ two store locations are associated if they have the same value
143 -> [LiveInstr instr] -- ^ acc
144 -> [LiveInstr instr] -- ^ instrs to clean (in backwards order)
145 -> CleanM [LiveInstr instr] -- ^ cleaned instrs (in forward order)
147 cleanForward _ _ acc []
150 -- write out live range joins via spill slots to just a spill and a reg-reg move
151 -- hopefully the spill will be also be cleaned in the next pass
153 cleanForward blockId assoc acc (li1 : li2 : instrs)
155 | LiveInstr (SPILL reg1 slot1) _ <- li1
156 , LiveInstr (RELOAD slot2 reg2) _ <- li2
159 modify $ \s -> s { sCleanedReloadsAcc = sCleanedReloadsAcc s + 1 }
160 cleanForward blockId assoc acc
161 (li1 : LiveInstr (mkRegRegMoveInstr reg1 reg2) Nothing : instrs)
164 cleanForward blockId assoc acc (li@(LiveInstr i1 _) : instrs)
165 | Just (r1, r2) <- takeRegRegMoveInstr i1
167 -- erase any left over nop reg reg moves while we're here
168 -- this will also catch any nop moves that the "write out live range joins" case above
170 then cleanForward blockId assoc acc instrs
172 -- if r1 has the same value as some slots and we copy r1 to r2,
173 -- then r2 is now associated with those slots instead
174 else do let assoc' = addAssoc (SReg r1) (SReg r2)
178 cleanForward blockId assoc' (li : acc) instrs
181 cleanForward blockId assoc acc (li : instrs)
183 -- update association due to the spill
184 | LiveInstr (SPILL reg slot) _ <- li
185 = let assoc' = addAssoc (SReg reg) (SSlot slot)
186 $ delAssoc (SSlot slot)
188 in cleanForward blockId assoc' (li : acc) instrs
190 -- clean a reload instr
191 | LiveInstr (RELOAD{}) _ <- li
192 = do (assoc', mli) <- cleanReload blockId assoc li
194 Nothing -> cleanForward blockId assoc' acc instrs
195 Just li' -> cleanForward blockId assoc' (li' : acc) instrs
197 -- remember the association over a jump
198 | LiveInstr instr _ <- li
199 , targets <- jumpDestsOfInstr instr
201 = do mapM_ (accJumpValid assoc) targets
202 cleanForward blockId assoc (li : acc) instrs
204 -- writing to a reg changes its value.
205 | LiveInstr instr _ <- li
206 , RU _ written <- regUsageOfInstr instr
207 = let assoc' = foldr delAssoc assoc (map SReg $ nub written)
208 in cleanForward blockId assoc' (li : acc) instrs
212 -- | Try and rewrite a reload instruction to something more pleasing
219 -> CleanM (Assoc Store, Maybe (LiveInstr instr))
221 cleanReload blockId assoc li@(LiveInstr (RELOAD slot reg) _)
223 -- if the reg we're reloading already has the same value as the slot
224 -- then we can erase the instruction outright
225 | elemAssoc (SSlot slot) (SReg reg) assoc
226 = do modify $ \s -> s { sCleanedReloadsAcc = sCleanedReloadsAcc s + 1 }
227 return (assoc, Nothing)
229 -- if we can find another reg with the same value as this slot then
230 -- do a move instead of a reload.
231 | Just reg2 <- findRegOfSlot assoc slot
232 = do modify $ \s -> s { sCleanedReloadsAcc = sCleanedReloadsAcc s + 1 }
234 let assoc' = addAssoc (SReg reg) (SReg reg2)
235 $ delAssoc (SReg reg)
238 return (assoc', Just $ LiveInstr (mkRegRegMoveInstr reg2 reg) Nothing)
240 -- gotta keep this instr
242 = do -- update the association
243 let assoc' = addAssoc (SReg reg) (SSlot slot) -- doing the reload makes reg and slot the same value
244 $ delAssoc (SReg reg) -- reg value changes on reload
247 -- remember that this block reloads from this slot
248 accBlockReloadsSlot blockId slot
250 return (assoc', Just li)
253 = panic "RegSpillClean.cleanReload: unhandled instr"
256 -- | Clean out unneeded spill instructions.
258 -- If there were no reloads from a slot between a spill and the last one
259 -- then the slot was never read and we don't need the spill.
263 -- SPILL r3 -> s1 <--- don't need this spill
268 -- "slots which were spilled to but not reloaded from yet"
270 -- Walking backwards across the code:
271 -- a) On a reload from a slot, remove it from the set.
273 -- a) On a spill from a slot
274 -- If the slot is in set then we can erase the spill,
275 -- because it won't be reloaded from until after the next spill.
278 -- keep the spill and add the slot to the set
280 -- TODO: This is mostly inter-block
281 -- we should really be updating the noReloads set as we cross jumps also.
283 -- TODO: generate noReloads from liveSlotsOnEntry
288 -> CleanM (LiveCmmTop instr)
295 CmmProc info label params sccs
296 | LiveInfo _ _ _ liveSlotsOnEntry <- info
297 -> do sccs' <- mapM (mapSCCM (cleanBlockBackward liveSlotsOnEntry)) sccs
298 return $ CmmProc info label params sccs'
303 => Map BlockId (Set Int)
304 -> LiveBasicBlock instr
305 -> CleanM (LiveBasicBlock instr)
307 cleanBlockBackward liveSlotsOnEntry (BasicBlock blockId instrs)
308 = do instrs_spill <- cleanBackward liveSlotsOnEntry emptyUniqSet [] instrs
309 return $ BasicBlock blockId instrs_spill
315 => Map BlockId (Set Int) -- ^ Slots live on entry to each block
316 -> UniqSet Int -- ^ slots that have been spilled, but not reloaded from
317 -> [LiveInstr instr] -- ^ acc
318 -> [LiveInstr instr] -- ^ instrs to clean (in forwards order)
319 -> CleanM [LiveInstr instr] -- ^ cleaned instrs (in backwards order)
322 cleanBackward liveSlotsOnEntry noReloads acc lis
323 = do reloadedBy <- gets sReloadedBy
324 cleanBackward' liveSlotsOnEntry reloadedBy noReloads acc lis
326 cleanBackward' _ _ _ acc []
329 cleanBackward' liveSlotsOnEntry reloadedBy noReloads acc (li : instrs)
331 -- if nothing ever reloads from this slot then we don't need the spill
332 | LiveInstr (SPILL _ slot) _ <- li
333 , Nothing <- lookupUFM reloadedBy (SSlot slot)
334 = do modify $ \s -> s { sCleanedSpillsAcc = sCleanedSpillsAcc s + 1 }
335 cleanBackward liveSlotsOnEntry noReloads acc instrs
337 | LiveInstr (SPILL _ slot) _ <- li
338 = if elementOfUniqSet slot noReloads
340 -- we can erase this spill because the slot won't be read until after the next one
342 modify $ \s -> s { sCleanedSpillsAcc = sCleanedSpillsAcc s + 1 }
343 cleanBackward liveSlotsOnEntry noReloads acc instrs
346 -- this slot is being spilled to, but we haven't seen any reloads yet.
347 let noReloads' = addOneToUniqSet noReloads slot
348 cleanBackward liveSlotsOnEntry noReloads' (li : acc) instrs
350 -- if we reload from a slot then it's no longer unused
351 | LiveInstr (RELOAD slot _) _ <- li
352 , noReloads' <- delOneFromUniqSet noReloads slot
353 = cleanBackward liveSlotsOnEntry noReloads' (li : acc) instrs
355 -- If a slot is live in a jump target then assume it's reloaded there.
356 -- TODO: A real dataflow analysis would do a better job here.
357 -- If the target block _ever_ used the slot then we assume it always does,
358 -- but if those reloads are cleaned the slot liveness map doesn't get updated.
359 | LiveInstr instr _ <- li
360 , targets <- jumpDestsOfInstr instr
362 let slotsReloadedByTargets
365 $ map (flip Map.lookup liveSlotsOnEntry)
368 let noReloads' = foldl' delOneFromUniqSet noReloads
369 $ Set.toList slotsReloadedByTargets
371 cleanBackward liveSlotsOnEntry noReloads' (li : acc) instrs
373 -- some other instruction
375 = cleanBackward liveSlotsOnEntry noReloads (li : acc) instrs
378 -- collateJoinPoints:
380 -- | combine the associations from all the inward control flow edges.
382 collateJoinPoints :: CleanM ()
385 { sJumpValid = mapUFM intersects (sJumpValidAcc s)
386 , sJumpValidAcc = emptyUFM }
388 intersects :: [Assoc Store] -> Assoc Store
389 intersects [] = emptyAssoc
390 intersects assocs = foldl1' intersectAssoc assocs
393 -- | See if we have a reg with the same value as this slot in the association table.
394 findRegOfSlot :: Assoc Store -> Int -> Maybe Reg
395 findRegOfSlot assoc slot
396 | close <- closeAssoc (SSlot slot) assoc
397 , Just (SReg reg) <- find isStoreReg $ uniqSetToList close
405 type CleanM = State CleanS
408 { -- regs which are valid at the start of each block.
409 sJumpValid :: UniqFM (Assoc Store)
411 -- collecting up what regs were valid across each jump.
412 -- in the next pass we can collate these and write the results
414 , sJumpValidAcc :: UniqFM [Assoc Store]
416 -- map of (slot -> blocks which reload from this slot)
417 -- used to decide if whether slot spilled to will ever be
418 -- reloaded from on this path.
419 , sReloadedBy :: UniqFM [BlockId]
421 -- spills\/reloads cleaned each pass (latest at front)
422 , sCleanedCount :: [(Int, Int)]
424 -- spills\/reloads that have been cleaned in this pass so far.
425 , sCleanedSpillsAcc :: Int
426 , sCleanedReloadsAcc :: Int }
431 { sJumpValid = emptyUFM
432 , sJumpValidAcc = emptyUFM
434 , sReloadedBy = emptyUFM
438 , sCleanedSpillsAcc = 0
439 , sCleanedReloadsAcc = 0 }
442 -- | Remember the associations before a jump
443 accJumpValid :: Assoc Store -> BlockId -> CleanM ()
444 accJumpValid assocs target
446 sJumpValidAcc = addToUFM_C (++)
452 accBlockReloadsSlot :: BlockId -> Slot -> CleanM ()
453 accBlockReloadsSlot blockId slot
455 sReloadedBy = addToUFM_C (++)
462 -- A store location can be a stack slot or a register
468 -- | Check if this is a reg store
469 isStoreReg :: Store -> Bool
475 -- spill cleaning is only done once all virtuals have been allocated to realRegs
477 instance Uniquable Store where
479 | RegReal (RealRegSingle i) <- r
480 = mkRegSingleUnique i
482 | RegReal (RealRegPair r1 r2) <- r
483 = mkRegPairUnique (r1 * 65535 + r2)
486 = error "RegSpillClean.getUnique: found virtual reg during spill clean, only real regs expected."
488 getUnique (SSlot i) = mkRegSubUnique i -- [SLPJ] I hope "SubUnique" is ok
490 instance Outputable Store where
491 ppr (SSlot i) = text "slot" <> int i
496 -- Association graphs.
497 -- In the spill cleaner, two store locations are associated if they are known
498 -- to hold the same value.
500 type Assoc a = UniqFM (UniqSet a)
502 -- | an empty association
503 emptyAssoc :: Assoc a
504 emptyAssoc = emptyUFM
507 -- | add an association between these two things
508 addAssoc :: Uniquable a
509 => a -> a -> Assoc a -> Assoc a
512 = let m1 = addToUFM_C unionUniqSets m a (unitUniqSet b)
513 m2 = addToUFM_C unionUniqSets m1 b (unitUniqSet a)
517 -- | delete all associations to a node
518 delAssoc :: (Outputable a, Uniquable a)
519 => a -> Assoc a -> Assoc a
522 | Just aSet <- lookupUFM m a
523 , m1 <- delFromUFM m a
524 = foldUniqSet (\x m -> delAssoc1 x a m) m1 aSet
529 -- | delete a single association edge (a -> b)
530 delAssoc1 :: Uniquable a
531 => a -> a -> Assoc a -> Assoc a
534 | Just aSet <- lookupUFM m a
535 = addToUFM m a (delOneFromUniqSet aSet b)
540 -- | check if these two things are associated
541 elemAssoc :: (Outputable a, Uniquable a)
542 => a -> a -> Assoc a -> Bool
545 = elementOfUniqSet b (closeAssoc a m)
547 -- | find the refl. trans. closure of the association from this point
548 closeAssoc :: (Outputable a, Uniquable a)
549 => a -> Assoc a -> UniqSet a
552 = closeAssoc' assoc emptyUniqSet (unitUniqSet a)
554 closeAssoc' assoc visited toVisit
555 = case uniqSetToList toVisit of
557 -- nothing else to visit, we're done
562 -- we've already seen this node
563 | elementOfUniqSet x visited
564 -> closeAssoc' assoc visited (delOneFromUniqSet toVisit x)
566 -- haven't seen this node before,
567 -- remember to visit all its neighbors
570 = case lookupUFM assoc x of
571 Nothing -> emptyUniqSet
575 (addOneToUniqSet visited x)
576 (unionUniqSets toVisit neighbors)
581 => Assoc a -> Assoc a -> Assoc a
584 = intersectUFM_C (intersectUniqSets) a b