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.
27 -- The above warning supression flag is a temporary kludge.
28 -- While working on this module you are encouraged to remove it and fix
29 -- any warnings in the module. See
30 -- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
33 module RegSpillClean (
54 -- | Clean out unneeded spill/reloads from this top level thing.
55 cleanSpills :: LiveCmmTop -> LiveCmmTop
57 = evalState (cleanSpin 0 cmm) initCleanS
59 -- | do one pass of cleaning
60 cleanSpin :: Int -> LiveCmmTop -> CleanM LiveCmmTop
63 cleanSpin spinCount code
64 = do jumpValid <- gets sJumpValid
71 $ cleanSpin' spinCount code
74 cleanSpin spinCount code
76 -- init count of cleaned spills/reloads
78 { sCleanedSpillsAcc = 0
79 , sCleanedReloadsAcc = 0 }
81 code' <- mapBlockTopM cleanBlock code
83 -- During the cleaning of each block we collected information about what regs
84 -- were valid across each jump. Based on this, work out whether it will be
85 -- safe to erase reloads after join points for the next pass.
88 -- remember how many spills/reloads we cleaned in this pass
89 spills <- gets sCleanedSpillsAcc
90 reloads <- gets sCleanedReloadsAcc
92 { sCleanedCount = (spills, reloads) : sCleanedCount s }
94 -- if nothing was cleaned in this pass or the last one
95 -- then we're done and it's time to bail out
96 cleanedCount <- gets sCleanedCount
97 if take 2 cleanedCount == [(0, 0), (0, 0)]
100 -- otherwise go around again
101 else cleanSpin (spinCount + 1) code'
104 -- | Clean one basic block
105 cleanBlock :: LiveBasicBlock -> CleanM LiveBasicBlock
106 cleanBlock (BasicBlock id instrs)
107 = do jumpValid <- gets sJumpValid
108 let assoc = case lookupUFM jumpValid id of
110 Nothing -> emptyAssoc
112 instrs_reload <- cleanReload assoc [] instrs
113 instrs_spill <- cleanSpill emptyUniqSet [] instrs_reload
114 return $ BasicBlock id instrs_spill
117 -- | Clean out unneeded reload instructions.
118 -- Walking forwards across the code
119 -- On a reload, if we know a reg already has the same value as a slot
120 -- then we don't need to do the reload.
123 :: Assoc Reg Slot -- ^ a reg and slot are associated when they have the same value.
124 -> [LiveInstr] -- ^ acc
125 -> [LiveInstr] -- ^ instrs to clean (in backwards order)
126 -> CleanM [LiveInstr] -- ^ cleaned instrs (in forward order)
128 cleanReload assoc acc []
131 cleanReload assoc acc (li@(Instr instr live) : instrs)
133 | SPILL reg slot <- instr
134 = let assoc' = addAssoc reg slot -- doing the spill makes reg and slot the same value
135 $ deleteBAssoc slot -- slot value changes on spill
137 in cleanReload assoc' (li : acc) instrs
139 | RELOAD slot reg <- instr
140 = if elemAssoc reg slot assoc
142 -- reg and slot had the same value before reload
143 -- we don't need the reload.
145 modify $ \s -> s { sCleanedReloadsAcc = sCleanedReloadsAcc s + 1 }
146 cleanReload assoc acc instrs
148 -- reg and slot had different values before reload
150 let assoc' = addAssoc reg slot -- doing the reload makes reg and slot the same value
151 $ deleteAAssoc reg -- reg value changes on reload
153 in cleanReload assoc' (li : acc) instrs
155 -- on a jump, remember the reg/slot association.
156 | targets <- jumpDests instr []
158 = do mapM_ (accJumpValid assoc) targets
159 cleanReload assoc (li : acc) instrs
161 -- writing to a reg changes its value.
162 | RU read written <- regUsage instr
163 = let assoc' = foldr deleteAAssoc assoc written
164 in cleanReload assoc' (li : acc) instrs
167 -- | Clean out unneeded spill instructions.
168 -- Walking backwards across the code.
169 -- If there were no reloads from a slot between a spill and the last one
170 -- then the slot was never read and we don't need the spill.
173 :: UniqSet Int -- ^ slots that have been spilled, but not reload from
174 -> [LiveInstr] -- ^ acc
175 -> [LiveInstr] -- ^ instrs to clean (in forwards order)
176 -> CleanM [LiveInstr] -- ^ cleaned instrs (in backwards order)
178 cleanSpill unused acc []
181 cleanSpill unused acc (li@(Instr instr live) : instrs)
182 | SPILL reg slot <- instr
183 = if elementOfUniqSet slot unused
185 -- we can erase this spill because the slot won't be read until after the next one
187 modify $ \s -> s { sCleanedSpillsAcc = sCleanedSpillsAcc s + 1 }
188 cleanSpill unused acc instrs
191 -- slots start off unused
192 let unused' = addOneToUniqSet unused slot
193 cleanSpill unused' (li : acc) instrs
195 -- if we reload from a slot then it's no longer unused
196 | RELOAD slot reg <- instr
197 , unused' <- delOneFromUniqSet unused slot
198 = cleanSpill unused' (li : acc) instrs
200 -- some other instruction
202 = cleanSpill unused (li : acc) instrs
205 -- collateJoinPoints:
207 -- | Look at information about what regs were valid across jumps and work out
208 -- whether it's safe to avoid reloads after join points.
210 collateJoinPoints :: CleanM ()
213 { sJumpValid = mapUFM intersects (sJumpValidAcc s)
214 , sJumpValidAcc = emptyUFM }
216 intersects :: [Assoc Reg Slot] -> Assoc Reg Slot
217 intersects [] = emptyAssoc
218 intersects assocs = foldl1' intersectAssoc assocs
223 type CleanM = State CleanS
226 { -- regs which are valid at the start of each block.
227 sJumpValid :: UniqFM (Assoc Reg Slot)
229 -- collecting up what regs were valid across each jump.
230 -- in the next pass we can collate these and write the results
232 , sJumpValidAcc :: UniqFM [Assoc Reg Slot]
234 -- spills/reloads cleaned each pass (latest at front)
235 , sCleanedCount :: [(Int, Int)]
237 -- spills/reloads that have been cleaned in this pass so far.
238 , sCleanedSpillsAcc :: Int
239 , sCleanedReloadsAcc :: Int }
243 { sJumpValid = emptyUFM
244 , sJumpValidAcc = emptyUFM
248 , sCleanedSpillsAcc = 0
249 , sCleanedReloadsAcc = 0 }
252 -- | Remember that these regs were valid before a jump to this block
253 accJumpValid :: Assoc Reg Slot -> BlockId -> CleanM ()
254 accJumpValid regs target
256 sJumpValidAcc = addToUFM_C (++)
263 -- An association table / many to many mapping.
264 -- TODO: implement this better than a simple association list.
265 -- two maps of sets, one for each direction would be better
269 { aList :: [(a, b)] }
271 -- | an empty association
272 emptyAssoc :: Assoc a b
273 emptyAssoc = Assoc { aList = [] }
276 -- | add an association to the table.
279 => a -> b -> Assoc a b -> Assoc a b
281 addAssoc a b m = m { aList = (a, b) : aList m }
284 -- | check if these two things are associated
287 => a -> b -> Assoc a b -> Bool
288 elemAssoc a b m = elem (a, b) $ aList m
291 -- | delete all associations with this A element
294 => a -> Assoc a b -> Assoc a b
297 = m { aList = [ (a, b) | (a, b) <- aList m
301 -- | delete all associations with this B element
304 => b -> Assoc a b -> Assoc a b
307 = m { aList = [ (a, b) | (a, b) <- aList m
311 -- | intersect two associations
314 => Assoc a b -> Assoc a b -> Assoc a b
318 { aList = intersect (aList a1) (aList a2) }