1 {-# OPTIONS -fno-warn-missing-signatures #-}
3 -- | When there aren't enough registers to hold all the vregs we have to spill some of those
4 -- vregs to slots on the stack. This module is used modify the code to use those slots.
6 module RegAlloc.Graph.Spill (
12 import RegAlloc.Liveness
15 import Cmm hiding (RegSet)
29 import qualified Data.Map as Map
30 import qualified Data.Set as Set
33 -- | Spill all these virtual regs to stack slots.
35 -- TODO: See if we can split some of the live ranges instead of just globally
36 -- spilling the virtual reg. This might make the spill cleaner's job easier.
38 -- TODO: On CISCy x86 and x86_64 we don't nessesarally have to add a mov instruction
39 -- when making spills. If an instr is using a spilled virtual we may be able to
40 -- address the spill slot directly.
44 => [LiveCmmTop instr] -- ^ the code
45 -> UniqSet Int -- ^ available stack slots
46 -> UniqSet VirtualReg -- ^ the regs to spill
48 ([LiveCmmTop instr] -- code with SPILL and RELOAD meta instructions added.
49 , UniqSet Int -- left over slots
50 , SpillStats ) -- stats about what happened during spilling
52 regSpill code slotsFree regs
54 -- not enough slots to spill these regs
55 | sizeUniqSet slotsFree < sizeUniqSet regs
56 = pprPanic "regSpill: out of spill slots!"
57 ( text " regs to spill = " <> ppr (sizeUniqSet regs)
58 $$ text " slots left = " <> ppr (sizeUniqSet slotsFree))
62 -- allocate a slot for each of the spilled regs
63 let slots = take (sizeUniqSet regs) $ uniqSetToList slotsFree
64 let regSlotMap = listToUFM
65 $ zip (uniqSetToList regs) slots
67 -- grab the unique supply from the monad
70 -- run the spiller on all the blocks
72 runState (mapM (regSpill_top regSlotMap) code)
76 , minusUniqSet slotsFree (mkUniqSet slots)
77 , makeSpillStats state')
80 -- | Spill some registers to stack slots in a top-level thing.
83 => RegMap Int -- ^ map of vregs to slots they're being spilled to.
84 -> LiveCmmTop instr -- ^ the top level thing.
85 -> SpillM (LiveCmmTop instr)
87 regSpill_top regSlotMap cmm
92 CmmProc info label params sccs
93 | LiveInfo static firstId mLiveVRegsOnEntry liveSlotsOnEntry <- info
95 -- We should only passed Cmms with the liveness maps filled in, but we'll
96 -- create empty ones if they're not there just in case.
97 let liveVRegsOnEntry = fromMaybe emptyBlockEnv mLiveVRegsOnEntry
99 -- The liveVRegsOnEntry contains the set of vregs that are live on entry to
100 -- each basic block. If we spill one of those vregs we remove it from that
101 -- set and add the corresponding slot number to the liveSlotsOnEntry set.
102 -- The spill cleaner needs this information to erase unneeded spill and
103 -- reload instructions after we've done a successful allocation.
104 let liveSlotsOnEntry' :: Map BlockId (Set Int)
106 = foldBlockEnv patchLiveSlot liveSlotsOnEntry liveVRegsOnEntry
109 = LiveInfo static firstId
110 (Just liveVRegsOnEntry)
113 -- Apply the spiller to all the basic blocks in the CmmProc.
114 sccs' <- mapM (mapSCCM (regSpill_block regSlotMap)) sccs
116 return $ CmmProc info' label params sccs'
118 where -- | Given a BlockId and the set of registers live in it,
119 -- if registers in this block are being spilled to stack slots,
120 -- then record the fact that these slots are now live in those blocks
121 -- in the given slotmap.
122 patchLiveSlot :: BlockId -> RegSet -> Map BlockId (Set Int) -> Map BlockId (Set Int)
123 patchLiveSlot blockId regsLive slotMap
124 = let curSlotsLive = fromMaybe Set.empty
125 $ Map.lookup blockId slotMap
127 moreSlotsLive = Set.fromList
129 $ map (lookupUFM regSlotMap)
130 $ uniqSetToList regsLive
132 slotMap' = Map.insert blockId (Set.union curSlotsLive moreSlotsLive) slotMap
138 -- | Spill some registers to stack slots in a basic block.
141 => UniqFM Int -- ^ map of vregs to slots they're being spilled to.
142 -> LiveBasicBlock instr
143 -> SpillM (LiveBasicBlock instr)
145 regSpill_block regSlotMap (BasicBlock i instrs)
146 = do instrss' <- mapM (regSpill_instr regSlotMap) instrs
147 return $ BasicBlock i (concat instrss')
150 -- | Spill some registers to stack slots in a single instruction. If the instruction
151 -- uses registers that need to be spilled, then it is prefixed (or postfixed) with
152 -- the appropriate RELOAD or SPILL meta instructions.
155 => UniqFM Int -- ^ map of vregs to slots they're being spilled to.
157 -> SpillM [LiveInstr instr]
159 regSpill_instr _ li@(LiveInstr _ Nothing)
162 regSpill_instr regSlotMap
163 (LiveInstr instr (Just _))
165 -- work out which regs are read and written in this instr
166 let RU rlRead rlWritten = regUsageOfInstr instr
168 -- sometimes a register is listed as being read more than once,
169 -- nub this so we don't end up inserting two lots of spill code.
170 let rsRead_ = nub rlRead
171 let rsWritten_ = nub rlWritten
173 -- if a reg is modified, it appears in both lists, want to undo this..
174 let rsRead = rsRead_ \\ rsWritten_
175 let rsWritten = rsWritten_ \\ rsRead_
176 let rsModify = intersect rsRead_ rsWritten_
178 -- work out if any of the regs being used are currently being spilled.
179 let rsSpillRead = filter (\r -> elemUFM r regSlotMap) rsRead
180 let rsSpillWritten = filter (\r -> elemUFM r regSlotMap) rsWritten
181 let rsSpillModify = filter (\r -> elemUFM r regSlotMap) rsModify
183 -- rewrite the instr and work out spill code.
184 (instr1, prepost1) <- mapAccumLM (spillRead regSlotMap) instr rsSpillRead
185 (instr2, prepost2) <- mapAccumLM (spillWrite regSlotMap) instr1 rsSpillWritten
186 (instr3, prepost3) <- mapAccumLM (spillModify regSlotMap) instr2 rsSpillModify
188 let (mPrefixes, mPostfixes) = unzip (prepost1 ++ prepost2 ++ prepost3)
189 let prefixes = concat mPrefixes
190 let postfixes = concat mPostfixes
193 let instrs' = prefixes
194 ++ [LiveInstr instr3 Nothing]
198 {- $ pprTrace "* regSpill_instr spill"
199 ( text "instr = " <> ppr instr
200 $$ text "read = " <> ppr rsSpillRead
201 $$ text "write = " <> ppr rsSpillWritten
202 $$ text "mod = " <> ppr rsSpillModify
204 $$ (vcat $ map ppr instrs')
210 spillRead regSlotMap instr reg
211 | Just slot <- lookupUFM regSlotMap reg
212 = do (instr', nReg) <- patchInstr reg instr
215 { stateSpillSL = addToUFM_C accSpillSL (stateSpillSL s) reg (reg, 0, 1) }
218 , ( [LiveInstr (RELOAD slot nReg) Nothing]
221 | otherwise = panic "RegSpill.spillRead: no slot defined for spilled reg"
224 spillWrite regSlotMap instr reg
225 | Just slot <- lookupUFM regSlotMap reg
226 = do (instr', nReg) <- patchInstr reg instr
229 { stateSpillSL = addToUFM_C accSpillSL (stateSpillSL s) reg (reg, 1, 0) }
233 , [LiveInstr (SPILL nReg slot) Nothing]))
235 | otherwise = panic "RegSpill.spillWrite: no slot defined for spilled reg"
238 spillModify regSlotMap instr reg
239 | Just slot <- lookupUFM regSlotMap reg
240 = do (instr', nReg) <- patchInstr reg instr
243 { stateSpillSL = addToUFM_C accSpillSL (stateSpillSL s) reg (reg, 1, 1) }
246 , ( [LiveInstr (RELOAD slot nReg) Nothing]
247 , [LiveInstr (SPILL nReg slot) Nothing]))
249 | otherwise = panic "RegSpill.spillModify: no slot defined for spilled reg"
253 -- | Rewrite uses of this virtual reg in an instr to use a different virtual reg
256 => Reg -> instr -> SpillM (instr, Reg)
259 = do nUnique <- newUnique
260 let nReg = case reg of
261 RegVirtual vr -> RegVirtual (renameVirtualReg nUnique vr)
262 RegReal{} -> panic "RegAlloc.Graph.Spill.patchIntr: not patching real reg"
263 let instr' = patchReg1 reg nReg instr
264 return (instr', nReg)
268 => Reg -> Reg -> instr -> instr
270 patchReg1 old new instr
274 in patchRegsOfInstr instr patchF
277 -- Spiller monad --------------------------------------------------------------
280 { -- | unique supply for generating fresh vregs.
281 stateUS :: UniqSupply
283 -- | spilled vreg vs the number of times it was loaded, stored
284 , stateSpillSL :: UniqFM (Reg, Int, Int) }
286 initSpillS uniqueSupply
288 { stateUS = uniqueSupply
289 , stateSpillSL = emptyUFM }
291 type SpillM a = State SpillS a
293 newUnique :: SpillM Unique
295 = do us <- gets stateUS
296 case splitUniqSupply us of
298 -> do let uniq = uniqFromSupply us1
299 modify $ \s -> s { stateUS = us2 }
302 accSpillSL (r1, s1, l1) (_, s2, l2)
303 = (r1, s1 + s2, l1 + l2)
306 -- Spiller stats --------------------------------------------------------------
309 { spillStoreLoad :: UniqFM (Reg, Int, Int) }
311 makeSpillStats :: SpillS -> SpillStats
314 { spillStoreLoad = stateSpillSL s }
316 instance Outputable SpillStats where
318 = (vcat $ map (\(r, s, l) -> ppr r <+> int s <+> int l)
319 $ eltsUFM (spillStoreLoad stats))