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 (
46 -- | Clean out unneeded spill/reloads from this top level thing.
47 cleanSpills :: LiveCmmTop -> LiveCmmTop
49 = evalState (cleanSpin 0 cmm) initCleanS
51 -- | do one pass of cleaning
52 cleanSpin :: Int -> LiveCmmTop -> CleanM LiveCmmTop
55 cleanSpin spinCount code
56 = do jumpValid <- gets sJumpValid
63 $ cleanSpin' spinCount code
66 cleanSpin spinCount code
68 -- init count of cleaned spills/reloads
70 { sCleanedSpillsAcc = 0
71 , sCleanedReloadsAcc = 0 }
73 code' <- mapBlockTopM cleanBlock code
75 -- During the cleaning of each block we collected information about what regs
76 -- were valid across each jump. Based on this, work out whether it will be
77 -- safe to erase reloads after join points for the next pass.
80 -- remember how many spills/reloads we cleaned in this pass
81 spills <- gets sCleanedSpillsAcc
82 reloads <- gets sCleanedReloadsAcc
84 { sCleanedCount = (spills, reloads) : sCleanedCount s }
86 -- if nothing was cleaned in this pass or the last one
87 -- then we're done and it's time to bail out
88 cleanedCount <- gets sCleanedCount
89 if take 2 cleanedCount == [(0, 0), (0, 0)]
92 -- otherwise go around again
93 else cleanSpin (spinCount + 1) code'
96 -- | Clean one basic block
97 cleanBlock :: LiveBasicBlock -> CleanM LiveBasicBlock
98 cleanBlock (BasicBlock id instrs)
99 = do jumpValid <- gets sJumpValid
100 let assoc = case lookupUFM jumpValid id of
102 Nothing -> emptyAssoc
104 instrs_reload <- cleanReload assoc [] instrs
105 instrs_spill <- cleanSpill emptyUniqSet [] instrs_reload
106 return $ BasicBlock id instrs_spill
109 -- | Clean out unneeded reload instructions.
110 -- Walking forwards across the code
111 -- On a reload, if we know a reg already has the same value as a slot
112 -- then we don't need to do the reload.
115 :: Assoc Reg Slot -- ^ a reg and slot are associated when they have the same value.
116 -> [LiveInstr] -- ^ acc
117 -> [LiveInstr] -- ^ instrs to clean (in backwards order)
118 -> CleanM [LiveInstr] -- ^ cleaned instrs (in forward order)
123 cleanReload assoc acc (li@(Instr instr _) : instrs)
125 | SPILL reg slot <- instr
126 = let assoc' = addAssoc reg slot -- doing the spill makes reg and slot the same value
127 $ deleteBAssoc slot -- slot value changes on spill
129 in cleanReload assoc' (li : acc) instrs
131 | RELOAD slot reg <- instr
132 = if elemAssoc reg slot assoc
134 -- reg and slot had the same value before reload
135 -- we don't need the reload.
137 modify $ \s -> s { sCleanedReloadsAcc = sCleanedReloadsAcc s + 1 }
138 cleanReload assoc acc instrs
140 -- reg and slot had different values before reload
142 let assoc' = addAssoc reg slot -- doing the reload makes reg and slot the same value
143 $ deleteAAssoc reg -- reg value changes on reload
145 in cleanReload assoc' (li : acc) instrs
147 -- on a jump, remember the reg/slot association.
148 | targets <- jumpDests instr []
150 = do mapM_ (accJumpValid assoc) targets
151 cleanReload assoc (li : acc) instrs
153 -- writing to a reg changes its value.
154 | RU _ written <- regUsage instr
155 = let assoc' = foldr deleteAAssoc assoc written
156 in cleanReload assoc' (li : acc) instrs
159 -- | Clean out unneeded spill instructions.
160 -- Walking backwards across the code.
161 -- If there were no reloads from a slot between a spill and the last one
162 -- then the slot was never read and we don't need the spill.
165 :: UniqSet Int -- ^ slots that have been spilled, but not reload from
166 -> [LiveInstr] -- ^ acc
167 -> [LiveInstr] -- ^ instrs to clean (in forwards order)
168 -> CleanM [LiveInstr] -- ^ cleaned instrs (in backwards order)
173 cleanSpill unused acc (li@(Instr instr _) : instrs)
174 | SPILL _ slot <- instr
175 = if elementOfUniqSet slot unused
177 -- we can erase this spill because the slot won't be read until after the next one
179 modify $ \s -> s { sCleanedSpillsAcc = sCleanedSpillsAcc s + 1 }
180 cleanSpill unused acc instrs
183 -- slots start off unused
184 let unused' = addOneToUniqSet unused slot
185 cleanSpill unused' (li : acc) instrs
187 -- if we reload from a slot then it's no longer unused
188 | RELOAD slot _ <- instr
189 , unused' <- delOneFromUniqSet unused slot
190 = cleanSpill unused' (li : acc) instrs
192 -- some other instruction
194 = cleanSpill unused (li : acc) instrs
197 -- collateJoinPoints:
199 -- | Look at information about what regs were valid across jumps and work out
200 -- whether it's safe to avoid reloads after join points.
202 collateJoinPoints :: CleanM ()
205 { sJumpValid = mapUFM intersects (sJumpValidAcc s)
206 , sJumpValidAcc = emptyUFM }
208 intersects :: [Assoc Reg Slot] -> Assoc Reg Slot
209 intersects [] = emptyAssoc
210 intersects assocs = foldl1' intersectAssoc assocs
215 type CleanM = State CleanS
218 { -- regs which are valid at the start of each block.
219 sJumpValid :: UniqFM (Assoc Reg Slot)
221 -- collecting up what regs were valid across each jump.
222 -- in the next pass we can collate these and write the results
224 , sJumpValidAcc :: UniqFM [Assoc Reg Slot]
226 -- spills/reloads cleaned each pass (latest at front)
227 , sCleanedCount :: [(Int, Int)]
229 -- spills/reloads that have been cleaned in this pass so far.
230 , sCleanedSpillsAcc :: Int
231 , sCleanedReloadsAcc :: Int }
236 { sJumpValid = emptyUFM
237 , sJumpValidAcc = emptyUFM
241 , sCleanedSpillsAcc = 0
242 , sCleanedReloadsAcc = 0 }
245 -- | Remember that these regs were valid before a jump to this block
246 accJumpValid :: Assoc Reg Slot -> BlockId -> CleanM ()
247 accJumpValid regs target
249 sJumpValidAcc = addToUFM_C (++)
256 -- An association table / many to many mapping.
257 -- TODO: implement this better than a simple association list.
258 -- two maps of sets, one for each direction would be better
262 { aList :: [(a, b)] }
264 -- | an empty association
265 emptyAssoc :: Assoc a b
266 emptyAssoc = Assoc { aList = [] }
269 -- | add an association to the table.
272 => a -> b -> Assoc a b -> Assoc a b
274 addAssoc a b m = m { aList = (a, b) : aList m }
277 -- | check if these two things are associated
280 => a -> b -> Assoc a b -> Bool
281 elemAssoc a b m = elem (a, b) $ aList m
284 -- | delete all associations with this A element
287 => a -> Assoc a b -> Assoc a b
290 = m { aList = [ (a, b) | (a, b) <- aList m
294 -- | delete all associations with this B element
297 => b -> Assoc a b -> Assoc a b
300 = m { aList = [ (a, b) | (a, b) <- aList m
304 -- | intersect two associations
307 => Assoc a b -> Assoc a b -> Assoc a b
311 { aList = intersect (aList a1) (aList a2) }