2 {-# OPTIONS -fno-warn-missing-signatures #-}
4 module RegAlloc.Graph.Spill (
12 import RegAlloc.Liveness
27 -- | Spill all these virtual regs to memory
28 -- TODO: see if we can split some of the live ranges instead of just globally
29 -- spilling the virtual reg.
31 -- TODO: On ciscy x86 and x86_64 we don't nessesarally have to add a mov instruction
32 -- when making spills. If an instr is using a spilled virtual we may be able to
33 -- address the spill slot directly.
37 => [LiveCmmTop instr] -- ^ the code
38 -> UniqSet Int -- ^ available stack slots
39 -> UniqSet VirtualReg -- ^ the regs to spill
41 ([LiveCmmTop instr] -- code will spill instructions
42 , UniqSet Int -- left over slots
43 , SpillStats ) -- stats about what happened during spilling
45 regSpill code slotsFree regs
47 -- not enough slots to spill these regs
48 | sizeUniqSet slotsFree < sizeUniqSet regs
49 = pprPanic "regSpill: out of spill slots!"
50 ( text " regs to spill = " <> ppr (sizeUniqSet regs)
51 $$ text " slots left = " <> ppr (sizeUniqSet slotsFree))
55 -- allocate a slot for each of the spilled regs
56 let slots = take (sizeUniqSet regs) $ uniqSetToList slotsFree
57 let regSlotMap = listToUFM
58 $ zip (uniqSetToList regs) slots
60 -- grab the unique supply from the monad
63 -- run the spiller on all the blocks
65 runState (mapM (mapBlockTopM (regSpill_block regSlotMap)) code)
69 , minusUniqSet slotsFree (mkUniqSet slots)
70 , makeSpillStats state')
73 regSpill_block regSlotMap (BasicBlock i instrs)
74 = do instrss' <- mapM (regSpill_instr regSlotMap) instrs
75 return $ BasicBlock i (concat instrss')
81 -> LiveInstr instr -> SpillM [LiveInstr instr]
83 regSpill_instr _ li@(LiveInstr _ Nothing)
86 regSpill_instr regSlotMap
87 (LiveInstr instr (Just _))
89 -- work out which regs are read and written in this instr
90 let RU rlRead rlWritten = regUsageOfInstr instr
92 -- sometimes a register is listed as being read more than once,
93 -- nub this so we don't end up inserting two lots of spill code.
94 let rsRead_ = nub rlRead
95 let rsWritten_ = nub rlWritten
97 -- if a reg is modified, it appears in both lists, want to undo this..
98 let rsRead = rsRead_ \\ rsWritten_
99 let rsWritten = rsWritten_ \\ rsRead_
100 let rsModify = intersect rsRead_ rsWritten_
102 -- work out if any of the regs being used are currently being spilled.
103 let rsSpillRead = filter (\r -> elemUFM r regSlotMap) rsRead
104 let rsSpillWritten = filter (\r -> elemUFM r regSlotMap) rsWritten
105 let rsSpillModify = filter (\r -> elemUFM r regSlotMap) rsModify
107 -- rewrite the instr and work out spill code.
108 (instr1, prepost1) <- mapAccumLM (spillRead regSlotMap) instr rsSpillRead
109 (instr2, prepost2) <- mapAccumLM (spillWrite regSlotMap) instr1 rsSpillWritten
110 (instr3, prepost3) <- mapAccumLM (spillModify regSlotMap) instr2 rsSpillModify
112 let (mPrefixes, mPostfixes) = unzip (prepost1 ++ prepost2 ++ prepost3)
113 let prefixes = concat mPrefixes
114 let postfixes = concat mPostfixes
117 let instrs' = prefixes
118 ++ [LiveInstr instr3 Nothing]
122 {- $ pprTrace "* regSpill_instr spill"
123 ( text "instr = " <> ppr instr
124 $$ text "read = " <> ppr rsSpillRead
125 $$ text "write = " <> ppr rsSpillWritten
126 $$ text "mod = " <> ppr rsSpillModify
128 $$ (vcat $ map ppr instrs')
134 spillRead regSlotMap instr reg
135 | Just slot <- lookupUFM regSlotMap reg
136 = do (instr', nReg) <- patchInstr reg instr
139 { stateSpillSL = addToUFM_C accSpillSL (stateSpillSL s) reg (reg, 0, 1) }
142 , ( [LiveInstr (RELOAD slot nReg) Nothing]
145 | otherwise = panic "RegSpill.spillRead: no slot defined for spilled reg"
148 spillWrite regSlotMap instr reg
149 | Just slot <- lookupUFM regSlotMap reg
150 = do (instr', nReg) <- patchInstr reg instr
153 { stateSpillSL = addToUFM_C accSpillSL (stateSpillSL s) reg (reg, 1, 0) }
157 , [LiveInstr (SPILL nReg slot) Nothing]))
159 | otherwise = panic "RegSpill.spillWrite: no slot defined for spilled reg"
162 spillModify regSlotMap instr reg
163 | Just slot <- lookupUFM regSlotMap reg
164 = do (instr', nReg) <- patchInstr reg instr
167 { stateSpillSL = addToUFM_C accSpillSL (stateSpillSL s) reg (reg, 1, 1) }
170 , ( [LiveInstr (RELOAD slot nReg) Nothing]
171 , [LiveInstr (SPILL nReg slot) Nothing]))
173 | otherwise = panic "RegSpill.spillModify: no slot defined for spilled reg"
177 -- | rewrite uses of this virtual reg in an instr to use a different virtual reg
180 => Reg -> instr -> SpillM (instr, Reg)
183 = do nUnique <- newUnique
184 let nReg = case reg of
185 RegVirtual vr -> RegVirtual (renameVirtualReg nUnique vr)
186 RegReal{} -> panic "RegAlloc.Graph.Spill.patchIntr: not patching real reg"
187 let instr' = patchReg1 reg nReg instr
188 return (instr', nReg)
192 => Reg -> Reg -> instr -> instr
194 patchReg1 old new instr
198 in patchRegsOfInstr instr patchF
201 ------------------------------------------------------
206 { stateUS :: UniqSupply
207 , stateSpillSL :: UniqFM (Reg, Int, Int) } -- ^ spilled reg vs number of times vreg was loaded, stored
209 initSpillS uniqueSupply
211 { stateUS = uniqueSupply
212 , stateSpillSL = emptyUFM }
214 type SpillM a = State SpillS a
216 newUnique :: SpillM Unique
218 = do us <- gets stateUS
219 case splitUniqSupply us of
221 -> do let uniq = uniqFromSupply us1
222 modify $ \s -> s { stateUS = us2 }
225 accSpillSL (r1, s1, l1) (_, s2, l2)
226 = (r1, s1 + s2, l1 + l2)
229 ----------------------------------------------------
234 { spillStoreLoad :: UniqFM (Reg, Int, Int) }
236 makeSpillStats :: SpillS -> SpillStats
239 { spillStoreLoad = stateSpillSL s }
241 instance Outputable SpillStats where
243 = (vcat $ map (\(r, s, l) -> ppr r <+> int s <+> int l)
244 $ eltsUFM (spillStoreLoad stats))