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 (
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 <- cleanReload 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 Reg Slot -- ^ a reg and slot are associated when they have the same value.
117 -> [LiveInstr] -- ^ acc
118 -> [LiveInstr] -- ^ instrs to clean (in backwards order)
119 -> CleanM [LiveInstr] -- ^ cleaned instrs (in forward order)
121 cleanReload assoc acc []
124 cleanReload assoc acc (li@(Instr instr live) : instrs)
126 | SPILL reg slot <- instr
127 = let assoc' = addAssoc reg slot -- doing the spill makes reg and slot the same value
128 $ deleteBAssoc slot -- slot value changes on spill
130 in cleanReload assoc' (li : acc) instrs
132 | RELOAD slot reg <- instr
133 = if elemAssoc reg slot assoc
135 -- reg and slot had the same value before reload
136 -- we don't need the reload.
138 modify $ \s -> s { sCleanedReloadsAcc = sCleanedReloadsAcc s + 1 }
139 cleanReload assoc acc instrs
141 -- reg and slot had different values before reload
143 let assoc' = addAssoc reg slot -- doing the reload makes reg and slot the same value
144 $ deleteAAssoc reg -- reg value changes on reload
146 in cleanReload assoc' (li : acc) instrs
148 -- on a jump, remember the reg/slot association.
149 | targets <- jumpDests instr []
151 = do mapM_ (accJumpValid assoc) targets
152 cleanReload assoc (li : acc) instrs
154 -- writing to a reg changes its value.
155 | RU read written <- regUsage instr
156 = let assoc' = foldr deleteAAssoc assoc written
157 in cleanReload assoc' (li : acc) instrs
160 -- | Clean out unneeded spill instructions.
161 -- Walking backwards across the code.
162 -- If there were no reloads from a slot between a spill and the last one
163 -- then the slot was never read and we don't need the spill.
166 :: UniqSet Int -- ^ slots that have been spilled, but not reload from
167 -> [LiveInstr] -- ^ acc
168 -> [LiveInstr] -- ^ instrs to clean (in forwards order)
169 -> CleanM [LiveInstr] -- ^ cleaned instrs (in backwards order)
171 cleanSpill unused acc []
174 cleanSpill unused acc (li@(Instr instr live) : instrs)
175 | SPILL reg slot <- instr
176 = if elementOfUniqSet slot unused
178 -- we can erase this spill because the slot won't be read until after the next one
180 modify $ \s -> s { sCleanedSpillsAcc = sCleanedSpillsAcc s + 1 }
181 cleanSpill unused acc instrs
184 -- slots start off unused
185 let unused' = addOneToUniqSet unused slot
186 cleanSpill unused' (li : acc) instrs
188 -- if we reload from a slot then it's no longer unused
189 | RELOAD slot reg <- instr
190 , unused' <- delOneFromUniqSet unused slot
191 = cleanSpill unused' (li : acc) instrs
193 -- some other instruction
195 = cleanSpill unused (li : acc) instrs
198 -- collateJoinPoints:
200 -- | Look at information about what regs were valid across jumps and work out
201 -- whether it's safe to avoid reloads after join points.
203 collateJoinPoints :: CleanM ()
206 { sJumpValid = mapUFM intersects (sJumpValidAcc s)
207 , sJumpValidAcc = emptyUFM }
209 intersects :: [Assoc Reg Slot] -> Assoc Reg Slot
210 intersects [] = emptyAssoc
211 intersects assocs = foldl1' intersectAssoc assocs
216 type CleanM = State CleanS
219 { -- regs which are valid at the start of each block.
220 sJumpValid :: UniqFM (Assoc Reg Slot)
222 -- collecting up what regs were valid across each jump.
223 -- in the next pass we can collate these and write the results
225 , sJumpValidAcc :: UniqFM [Assoc Reg Slot]
227 -- spills/reloads cleaned each pass (latest at front)
228 , sCleanedCount :: [(Int, Int)]
230 -- spills/reloads that have been cleaned in this pass so far.
231 , sCleanedSpillsAcc :: Int
232 , 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) }