1 -- | Clean out unneeded spill/reload instrs
3 -- * Handling of join points
7 -- RELOAD SLOT(0), %r1 RELOAD SLOT(0), %r1
12 -- RELOAD SLOT(0), %r1
16 -- So long as %r1 hasn't been written to in A, B or C then we don't need the
19 -- What we really care about here is that on the entry to B3, %r1 will always
20 -- have the same value that is in SLOT(0) (ie, %r1 is _valid_)
22 -- This also works if the reloads in B1/B2 were spills instead, because
23 -- spilling %r1 to a slot makes that slot have the same value as %r1.
26 module RegSpillClean (
45 import Data.List ( nub )
47 -- | Clean out unneeded spill/reloads from this top level thing.
48 cleanSpills :: LiveCmmTop -> LiveCmmTop
50 = evalState (cleanSpin 0 cmm) initCleanS
52 -- | do one pass of cleaning
53 cleanSpin :: Int -> LiveCmmTop -> CleanM LiveCmmTop
56 cleanSpin spinCount code
57 = do jumpValid <- gets sJumpValid
64 $ cleanSpin' spinCount code
67 cleanSpin spinCount code
69 -- init count of cleaned spills/reloads
71 { sCleanedSpillsAcc = 0
72 , sCleanedReloadsAcc = 0 }
74 code' <- mapBlockTopM cleanBlock code
76 -- During the cleaning of each block we collected information about what regs
77 -- were valid across each jump. Based on this, work out whether it will be
78 -- safe to erase reloads after join points for the next pass.
81 -- remember how many spills/reloads we cleaned in this pass
82 spills <- gets sCleanedSpillsAcc
83 reloads <- gets sCleanedReloadsAcc
85 { sCleanedCount = (spills, reloads) : sCleanedCount s }
87 -- if nothing was cleaned in this pass or the last one
88 -- then we're done and it's time to bail out
89 cleanedCount <- gets sCleanedCount
90 if take 2 cleanedCount == [(0, 0), (0, 0)]
93 -- otherwise go around again
94 else cleanSpin (spinCount + 1) code'
97 -- | Clean one basic block
98 cleanBlock :: LiveBasicBlock -> CleanM LiveBasicBlock
99 cleanBlock (BasicBlock id instrs)
100 = do jumpValid <- gets sJumpValid
101 let assoc = case lookupUFM jumpValid id of
103 Nothing -> emptyAssoc
105 instrs_reload <- cleanFwd assoc [] instrs
106 instrs_spill <- cleanSpill emptyUniqSet [] instrs_reload
107 return $ BasicBlock id instrs_spill
110 -- | Clean out unneeded reload instructions.
111 -- Walking forwards across the code
112 -- On a reload, if we know a reg already has the same value as a slot
113 -- then we don't need to do the reload.
116 :: Assoc Store -- ^ two store locations are associated if they have the same value
117 -> [LiveInstr] -- ^ acc
118 -> [LiveInstr] -- ^ instrs to clean (in backwards order)
119 -> CleanM [LiveInstr] -- ^ cleaned instrs (in forward order)
124 -- write out live range joins via spill slots to just a spill and a reg-reg move
125 -- hopefully the spill will be also be cleaned in the next pass
127 cleanFwd assoc acc (Instr i1 live1 : Instr i2 _ : instrs)
129 | SPILL reg1 slot1 <- i1
130 , RELOAD slot2 reg2 <- i2
133 modify $ \s -> s { sCleanedReloadsAcc = sCleanedReloadsAcc s + 1 }
135 (Instr i1 live1 : Instr (mkRegRegMoveInstr reg1 reg2) Nothing : instrs)
138 cleanFwd assoc acc (li@(Instr i1 _) : instrs)
139 | Just (r1, r2) <- isRegRegMove i1
141 -- erase any left over nop reg reg moves while we're here
142 -- this will also catch any nop moves that the "write out live range joins" case above
144 then cleanFwd assoc acc instrs
146 -- if r1 has the same value as some slots and we copy r1 to r2,
147 -- then r2 is now associated with those slots instead
148 else do let assoc' = addAssoc (SReg r1) (SReg r2)
152 cleanFwd assoc' (li : acc) instrs
155 cleanFwd assoc acc (li@(Instr instr _) : instrs)
157 | SPILL reg slot <- instr
158 = let assoc' = addAssoc (SReg reg) (SSlot slot) -- doing the spill makes reg and slot the same value
159 $ delAssoc (SSlot slot) -- slot value changes on spill
161 in cleanFwd assoc' (li : acc) instrs
163 -- clean a reload instr
165 = do (assoc', mli) <- cleanReload assoc li
167 Nothing -> cleanFwd assoc' acc instrs
168 Just li' -> cleanFwd assoc' (li' : acc) instrs
170 -- remember the association over a jump
171 | targets <- jumpDests instr []
173 = do mapM_ (accJumpValid assoc) targets
174 cleanFwd assoc (li : acc) instrs
176 -- writing to a reg changes its value.
177 | RU _ written <- regUsage instr
178 = let assoc' = foldr delAssoc assoc (map SReg $ nub written)
179 in cleanFwd assoc' (li : acc) instrs
182 -- | Try and rewrite a reload instruction to something more pleasing
184 cleanReload :: Assoc Store -> LiveInstr -> CleanM (Assoc Store, Maybe LiveInstr)
185 cleanReload assoc li@(Instr (RELOAD slot reg) _)
187 -- if the reg we're reloading already has the same value as the slot
188 -- then we can erase the instruction outright
189 | elemAssoc (SSlot slot) (SReg reg) assoc
190 = do modify $ \s -> s { sCleanedReloadsAcc = sCleanedReloadsAcc s + 1 }
191 return (assoc, Nothing)
193 -- if we can find another reg with the same value as this slot then
194 -- do a move instead of a reload.
195 | Just reg2 <- findRegOfSlot assoc slot
196 = do modify $ \s -> s { sCleanedReloadsAcc = sCleanedReloadsAcc s + 1 }
198 let assoc' = addAssoc (SReg reg) (SReg reg2)
199 $ delAssoc (SReg reg)
202 return (assoc', Just $ Instr (mkRegRegMoveInstr reg2 reg) Nothing)
204 -- gotta keep this instr
205 -- update the association
207 = do let assoc' = addAssoc (SReg reg) (SSlot slot) -- doing the reload makes reg and slot the same value
208 $ delAssoc (SReg reg) -- reg value changes on reload
211 return (assoc', Just li)
214 = panic "RegSpillClean.cleanReload: unhandled instr"
217 -- | Clean out unneeded spill instructions.
218 -- Walking backwards across the code.
219 -- If there were no reloads from a slot between a spill and the last one
220 -- then the slot was never read and we don't need the spill.
223 :: UniqSet Int -- ^ slots that have been spilled, but not reloaded from
224 -> [LiveInstr] -- ^ acc
225 -> [LiveInstr] -- ^ instrs to clean (in forwards order)
226 -> CleanM [LiveInstr] -- ^ cleaned instrs (in backwards order)
231 cleanSpill unused acc (li@(Instr instr _) : instrs)
232 | SPILL _ slot <- instr
233 = if elementOfUniqSet slot unused
235 -- we can erase this spill because the slot won't be read until after the next one
237 modify $ \s -> s { sCleanedSpillsAcc = sCleanedSpillsAcc s + 1 }
238 cleanSpill unused acc instrs
241 -- slots start off unused
242 let unused' = addOneToUniqSet unused slot
243 cleanSpill unused' (li : acc) instrs
245 -- if we reload from a slot then it's no longer unused
246 | RELOAD slot _ <- instr
247 , unused' <- delOneFromUniqSet unused slot
248 = cleanSpill unused' (li : acc) instrs
250 -- some other instruction
252 = cleanSpill unused (li : acc) instrs
255 -- collateJoinPoints:
257 -- | combine the associations from all the inward control flow edges.
259 collateJoinPoints :: CleanM ()
262 { sJumpValid = mapUFM intersects (sJumpValidAcc s)
263 , sJumpValidAcc = emptyUFM }
265 intersects :: [Assoc Store] -> Assoc Store
266 intersects [] = emptyAssoc
267 intersects assocs = foldl1' intersectAssoc assocs
270 -- | See if we have a reg with the same value as this slot in the association table.
271 findRegOfSlot :: Assoc Store -> Int -> Maybe Reg
272 findRegOfSlot assoc slot
273 | close <- closeAssoc (SSlot slot) assoc
274 , Just (SReg reg) <- find isStoreReg $ uniqSetToList close
282 type CleanM = State CleanS
285 { -- regs which are valid at the start of each block.
286 sJumpValid :: UniqFM (Assoc Store)
288 -- collecting up what regs were valid across each jump.
289 -- in the next pass we can collate these and write the results
291 , sJumpValidAcc :: UniqFM [Assoc Store]
293 -- spills/reloads cleaned each pass (latest at front)
294 , sCleanedCount :: [(Int, Int)]
296 -- spills/reloads that have been cleaned in this pass so far.
297 , sCleanedSpillsAcc :: Int
298 , sCleanedReloadsAcc :: Int }
303 { sJumpValid = emptyUFM
304 , sJumpValidAcc = emptyUFM
308 , sCleanedSpillsAcc = 0
309 , sCleanedReloadsAcc = 0 }
312 -- | Remember the associations before a jump
313 accJumpValid :: Assoc Store -> BlockId -> CleanM ()
314 accJumpValid assocs target
316 sJumpValidAcc = addToUFM_C (++)
322 -- A store location can be a stack slot or a register
328 -- | Check if this is a reg store
329 isStoreReg :: Store -> Bool
335 -- spill cleaning is only done once all virtuals have been allocated to realRegs
337 instance Uniquable Store where
343 = error "RegSpillClean.getUnique: found virtual reg during spill clean, only real regs expected."
345 getUnique (SSlot i) = mkUnique 'S' i
347 instance Outputable Store where
348 ppr (SSlot i) = text "slot" <> int i
353 -- Association graphs.
354 -- In the spill cleaner, two store locations are associated if they are known
355 -- to hold the same value.
357 type Assoc a = UniqFM (UniqSet a)
359 -- | an empty association
360 emptyAssoc :: Assoc a
361 emptyAssoc = emptyUFM
364 -- | add an association between these two things
365 addAssoc :: Uniquable a
366 => a -> a -> Assoc a -> Assoc a
369 = let m1 = addToUFM_C unionUniqSets m a (unitUniqSet b)
370 m2 = addToUFM_C unionUniqSets m1 b (unitUniqSet a)
374 -- | delete all associations to a node
375 delAssoc :: (Outputable a, Uniquable a)
376 => a -> Assoc a -> Assoc a
379 | Just aSet <- lookupUFM m a
380 , m1 <- delFromUFM m a
381 = foldUniqSet (\x m -> delAssoc1 x a m) m1 aSet
386 -- | delete a single association edge (a -> b)
387 delAssoc1 :: Uniquable a
388 => a -> a -> Assoc a -> Assoc a
391 | Just aSet <- lookupUFM m a
392 = addToUFM m a (delOneFromUniqSet aSet b)
397 -- | check if these two things are associated
398 elemAssoc :: (Outputable a, Uniquable a)
399 => a -> a -> Assoc a -> Bool
402 = elementOfUniqSet b (closeAssoc a m)
404 -- | find the refl. trans. closure of the association from this point
405 closeAssoc :: (Outputable a, Uniquable a)
406 => a -> Assoc a -> UniqSet a
409 = closeAssoc' assoc emptyUniqSet (unitUniqSet a)
411 closeAssoc' assoc visited toVisit
412 = case uniqSetToList toVisit of
414 -- nothing else to visit, we're done
419 -- we've already seen this node
420 | elementOfUniqSet x visited
421 -> closeAssoc' assoc visited (delOneFromUniqSet toVisit x)
423 -- haven't seen this node before,
424 -- remember to visit all its neighbors
427 = case lookupUFM assoc x of
428 Nothing -> emptyUniqSet
432 (addOneToUniqSet visited x)
433 (unionUniqSets toVisit neighbors)
438 => Assoc a -> Assoc a -> Assoc a
441 = intersectUFM_C (intersectUniqSets) a b