Allow resizing the stack for the graph allocator.
[ghc.git] / compiler / nativeGen / RegAlloc / Graph / Spill.hs
1
2 -- | When there aren't enough registers to hold all the vregs we have to spill
3 -- some of those vregs to slots on the stack. This module is used modify the
4 -- code to use those slots.
5 module RegAlloc.Graph.Spill (
6 regSpill,
7 SpillStats(..),
8 accSpillSL
9 ) where
10 import GhcPrelude
11
12 import RegAlloc.Liveness
13 import Instruction
14 import Reg
15 import Cmm hiding (RegSet)
16 import BlockId
17 import Hoopl.Collections
18
19 import MonadUtils
20 import State
21 import Unique
22 import UniqFM
23 import UniqSet
24 import UniqSupply
25 import Outputable
26 import Platform
27
28 import Data.List
29 import Data.Maybe
30 import Data.IntSet (IntSet)
31 import qualified Data.IntSet as IntSet
32
33
34 -- | Spill all these virtual regs to stack slots.
35 --
36 -- Bumps the number of required stack slots if required.
37 --
38 --
39 -- TODO: See if we can split some of the live ranges instead of just globally
40 -- spilling the virtual reg. This might make the spill cleaner's job easier.
41 --
42 -- TODO: On CISCy x86 and x86_64 we don't necessarily have to add a mov instruction
43 -- when making spills. If an instr is using a spilled virtual we may be able to
44 -- address the spill slot directly.
45 --
46 regSpill
47 :: Instruction instr
48 => Platform
49 -> [LiveCmmDecl statics instr] -- ^ the code
50 -> UniqSet Int -- ^ available stack slots
51 -> Int -- ^ current number of spill slots.
52 -> UniqSet VirtualReg -- ^ the regs to spill
53 -> UniqSM
54 ([LiveCmmDecl statics instr]
55 -- code with SPILL and RELOAD meta instructions added.
56 , UniqSet Int -- left over slots
57 , Int -- slot count in use now.
58 , SpillStats ) -- stats about what happened during spilling
59
60 regSpill platform code slotsFree slotCount regs
61
62 -- Not enough slots to spill these regs.
63 | sizeUniqSet slotsFree < sizeUniqSet regs
64 = -- pprTrace "Bumping slot count:" (ppr slotCount <> text " -> " <> ppr (slotCount+512)) $
65 let slotsFree' = (addListToUniqSet slotsFree [slotCount+1 .. slotCount+512])
66 in regSpill platform code slotsFree' (slotCount+512) regs
67
68 | otherwise
69 = do
70 -- Allocate a slot for each of the spilled regs.
71 let slots = take (sizeUniqSet regs) $ nonDetEltsUniqSet slotsFree
72 let regSlotMap = listToUFM
73 $ zip (nonDetEltsUniqSet regs) slots
74 -- This is non-deterministic but we do not
75 -- currently support deterministic code-generation.
76 -- See Note [Unique Determinism and code generation]
77
78 -- Grab the unique supply from the monad.
79 us <- getUniqueSupplyM
80
81 -- Run the spiller on all the blocks.
82 let (code', state') =
83 runState (mapM (regSpill_top platform regSlotMap) code)
84 (initSpillS us)
85
86 return ( code'
87 , minusUniqSet slotsFree (mkUniqSet slots)
88 , slotCount
89 , makeSpillStats state')
90
91
92 -- | Spill some registers to stack slots in a top-level thing.
93 regSpill_top
94 :: Instruction instr
95 => Platform
96 -> RegMap Int
97 -- ^ map of vregs to slots they're being spilled to.
98 -> LiveCmmDecl statics instr
99 -- ^ the top level thing.
100 -> SpillM (LiveCmmDecl statics instr)
101
102 regSpill_top platform regSlotMap cmm
103 = case cmm of
104 CmmData{}
105 -> return cmm
106
107 CmmProc info label live sccs
108 | LiveInfo static firstId mLiveVRegsOnEntry liveSlotsOnEntry <- info
109 -> do
110 -- We should only passed Cmms with the liveness maps filled in,
111 -- but we'll create empty ones if they're not there just in case.
112 let liveVRegsOnEntry = fromMaybe mapEmpty mLiveVRegsOnEntry
113
114 -- The liveVRegsOnEntry contains the set of vregs that are live
115 -- on entry to each basic block. If we spill one of those vregs
116 -- we remove it from that set and add the corresponding slot
117 -- number to the liveSlotsOnEntry set. The spill cleaner needs
118 -- this information to erase unneeded spill and reload instructions
119 -- after we've done a successful allocation.
120 let liveSlotsOnEntry' :: BlockMap IntSet
121 liveSlotsOnEntry'
122 = mapFoldlWithKey patchLiveSlot
123 liveSlotsOnEntry liveVRegsOnEntry
124
125 let info'
126 = LiveInfo static firstId
127 (Just liveVRegsOnEntry)
128 liveSlotsOnEntry'
129
130 -- Apply the spiller to all the basic blocks in the CmmProc.
131 sccs' <- mapM (mapSCCM (regSpill_block platform regSlotMap)) sccs
132
133 return $ CmmProc info' label live sccs'
134
135 where -- Given a BlockId and the set of registers live in it,
136 -- if registers in this block are being spilled to stack slots,
137 -- then record the fact that these slots are now live in those blocks
138 -- in the given slotmap.
139 patchLiveSlot
140 :: BlockMap IntSet -> BlockId -> RegSet -> BlockMap IntSet
141
142 patchLiveSlot slotMap blockId regsLive
143 = let
144 -- Slots that are already recorded as being live.
145 curSlotsLive = fromMaybe IntSet.empty
146 $ mapLookup blockId slotMap
147
148 moreSlotsLive = IntSet.fromList
149 $ catMaybes
150 $ map (lookupUFM regSlotMap)
151 $ nonDetEltsUniqSet regsLive
152 -- See Note [Unique Determinism and code generation]
153
154 slotMap'
155 = mapInsert blockId (IntSet.union curSlotsLive moreSlotsLive)
156 slotMap
157
158 in slotMap'
159
160
161 -- | Spill some registers to stack slots in a basic block.
162 regSpill_block
163 :: Instruction instr
164 => Platform
165 -> UniqFM Int -- ^ map of vregs to slots they're being spilled to.
166 -> LiveBasicBlock instr
167 -> SpillM (LiveBasicBlock instr)
168
169 regSpill_block platform regSlotMap (BasicBlock i instrs)
170 = do instrss' <- mapM (regSpill_instr platform regSlotMap) instrs
171 return $ BasicBlock i (concat instrss')
172
173
174 -- | Spill some registers to stack slots in a single instruction.
175 -- If the instruction uses registers that need to be spilled, then it is
176 -- prefixed (or postfixed) with the appropriate RELOAD or SPILL meta
177 -- instructions.
178 regSpill_instr
179 :: Instruction instr
180 => Platform
181 -> UniqFM Int -- ^ map of vregs to slots they're being spilled to.
182 -> LiveInstr instr
183 -> SpillM [LiveInstr instr]
184
185 regSpill_instr _ _ li@(LiveInstr _ Nothing)
186 = do return [li]
187
188 regSpill_instr platform regSlotMap
189 (LiveInstr instr (Just _))
190 = do
191 -- work out which regs are read and written in this instr
192 let RU rlRead rlWritten = regUsageOfInstr platform instr
193
194 -- sometimes a register is listed as being read more than once,
195 -- nub this so we don't end up inserting two lots of spill code.
196 let rsRead_ = nub rlRead
197 let rsWritten_ = nub rlWritten
198
199 -- if a reg is modified, it appears in both lists, want to undo this..
200 let rsRead = rsRead_ \\ rsWritten_
201 let rsWritten = rsWritten_ \\ rsRead_
202 let rsModify = intersect rsRead_ rsWritten_
203
204 -- work out if any of the regs being used are currently being spilled.
205 let rsSpillRead = filter (\r -> elemUFM r regSlotMap) rsRead
206 let rsSpillWritten = filter (\r -> elemUFM r regSlotMap) rsWritten
207 let rsSpillModify = filter (\r -> elemUFM r regSlotMap) rsModify
208
209 -- rewrite the instr and work out spill code.
210 (instr1, prepost1) <- mapAccumLM (spillRead regSlotMap) instr rsSpillRead
211 (instr2, prepost2) <- mapAccumLM (spillWrite regSlotMap) instr1 rsSpillWritten
212 (instr3, prepost3) <- mapAccumLM (spillModify regSlotMap) instr2 rsSpillModify
213
214 let (mPrefixes, mPostfixes) = unzip (prepost1 ++ prepost2 ++ prepost3)
215 let prefixes = concat mPrefixes
216 let postfixes = concat mPostfixes
217
218 -- final code
219 let instrs' = prefixes
220 ++ [LiveInstr instr3 Nothing]
221 ++ postfixes
222
223 return $ instrs'
224
225
226 -- | Add a RELOAD met a instruction to load a value for an instruction that
227 -- writes to a vreg that is being spilled.
228 spillRead
229 :: Instruction instr
230 => UniqFM Int
231 -> instr
232 -> Reg
233 -> SpillM (instr, ([LiveInstr instr'], [LiveInstr instr']))
234
235 spillRead regSlotMap instr reg
236 | Just slot <- lookupUFM regSlotMap reg
237 = do (instr', nReg) <- patchInstr reg instr
238
239 modify $ \s -> s
240 { stateSpillSL = addToUFM_C accSpillSL (stateSpillSL s) reg (reg, 0, 1) }
241
242 return ( instr'
243 , ( [LiveInstr (RELOAD slot nReg) Nothing]
244 , []) )
245
246 | otherwise = panic "RegSpill.spillRead: no slot defined for spilled reg"
247
248
249 -- | Add a SPILL meta instruction to store a value for an instruction that
250 -- writes to a vreg that is being spilled.
251 spillWrite
252 :: Instruction instr
253 => UniqFM Int
254 -> instr
255 -> Reg
256 -> SpillM (instr, ([LiveInstr instr'], [LiveInstr instr']))
257
258 spillWrite regSlotMap instr reg
259 | Just slot <- lookupUFM regSlotMap reg
260 = do (instr', nReg) <- patchInstr reg instr
261
262 modify $ \s -> s
263 { stateSpillSL = addToUFM_C accSpillSL (stateSpillSL s) reg (reg, 1, 0) }
264
265 return ( instr'
266 , ( []
267 , [LiveInstr (SPILL nReg slot) Nothing]))
268
269 | otherwise = panic "RegSpill.spillWrite: no slot defined for spilled reg"
270
271
272 -- | Add both RELOAD and SPILL meta instructions for an instruction that
273 -- both reads and writes to a vreg that is being spilled.
274 spillModify
275 :: Instruction instr
276 => UniqFM Int
277 -> instr
278 -> Reg
279 -> SpillM (instr, ([LiveInstr instr'], [LiveInstr instr']))
280
281 spillModify regSlotMap instr reg
282 | Just slot <- lookupUFM regSlotMap reg
283 = do (instr', nReg) <- patchInstr reg instr
284
285 modify $ \s -> s
286 { stateSpillSL = addToUFM_C accSpillSL (stateSpillSL s) reg (reg, 1, 1) }
287
288 return ( instr'
289 , ( [LiveInstr (RELOAD slot nReg) Nothing]
290 , [LiveInstr (SPILL nReg slot) Nothing]))
291
292 | otherwise = panic "RegSpill.spillModify: no slot defined for spilled reg"
293
294
295 -- | Rewrite uses of this virtual reg in an instr to use a different
296 -- virtual reg.
297 patchInstr
298 :: Instruction instr
299 => Reg -> instr -> SpillM (instr, Reg)
300
301 patchInstr reg instr
302 = do nUnique <- newUnique
303
304 -- The register we're rewriting is suppoed to be virtual.
305 -- If it's not then something has gone horribly wrong.
306 let nReg
307 = case reg of
308 RegVirtual vr
309 -> RegVirtual (renameVirtualReg nUnique vr)
310
311 RegReal{}
312 -> panic "RegAlloc.Graph.Spill.patchIntr: not patching real reg"
313
314 let instr' = patchReg1 reg nReg instr
315 return (instr', nReg)
316
317
318 patchReg1
319 :: Instruction instr
320 => Reg -> Reg -> instr -> instr
321
322 patchReg1 old new instr
323 = let patchF r
324 | r == old = new
325 | otherwise = r
326 in patchRegsOfInstr instr patchF
327
328
329 -- Spiller monad --------------------------------------------------------------
330 -- | State monad for the spill code generator.
331 type SpillM a
332 = State SpillS a
333
334 -- | Spill code generator state.
335 data SpillS
336 = SpillS
337 { -- | Unique supply for generating fresh vregs.
338 stateUS :: UniqSupply
339
340 -- | Spilled vreg vs the number of times it was loaded, stored.
341 , stateSpillSL :: UniqFM (Reg, Int, Int) }
342
343
344 -- | Create a new spiller state.
345 initSpillS :: UniqSupply -> SpillS
346 initSpillS uniqueSupply
347 = SpillS
348 { stateUS = uniqueSupply
349 , stateSpillSL = emptyUFM }
350
351
352 -- | Allocate a new unique in the spiller monad.
353 newUnique :: SpillM Unique
354 newUnique
355 = do us <- gets stateUS
356 case takeUniqFromSupply us of
357 (uniq, us')
358 -> do modify $ \s -> s { stateUS = us' }
359 return uniq
360
361
362 -- | Add a spill/reload count to a stats record for a register.
363 accSpillSL :: (Reg, Int, Int) -> (Reg, Int, Int) -> (Reg, Int, Int)
364 accSpillSL (r1, s1, l1) (_, s2, l2)
365 = (r1, s1 + s2, l1 + l2)
366
367
368 -- Spiller stats --------------------------------------------------------------
369 -- | Spiller statistics.
370 -- Tells us what registers were spilled.
371 data SpillStats
372 = SpillStats
373 { spillStoreLoad :: UniqFM (Reg, Int, Int) }
374
375
376 -- | Extract spiller statistics from the spiller state.
377 makeSpillStats :: SpillS -> SpillStats
378 makeSpillStats s
379 = SpillStats
380 { spillStoreLoad = stateSpillSL s }
381
382
383 instance Outputable SpillStats where
384 ppr stats
385 = pprUFM (spillStoreLoad stats)
386 (vcat . map (\(r, s, l) -> ppr r <+> int s <+> int l))