2 {-# OPTIONS -fno-warn-missing-signatures #-}
29 -- | Spill all these virtual regs to memory
30 -- TODO: see if we can split some of the live ranges instead of just globally
31 -- spilling the virtual reg.
33 -- TODO: On ciscy x86 and x86_64 we don't nessesarally have to add a mov instruction
34 -- when making spills. If an instr is using a spilled virtual we may be able to
35 -- address the spill slot directly.
38 :: [LiveCmmTop] -- ^ the code
39 -> UniqSet Int -- ^ available stack slots
40 -> UniqSet Reg -- ^ the regs to spill
42 ([LiveCmmTop] -- code will spill instructions
43 , UniqSet Int -- left over slots
44 , SpillStats ) -- stats about what happened during spilling
46 regSpill code slotsFree regs
48 -- not enough slots to spill these regs
49 | sizeUniqSet slotsFree < sizeUniqSet regs
50 = pprPanic "regSpill: out of spill slots!"
51 ( text " regs to spill = " <> ppr (sizeUniqSet regs)
52 $$ text " slots left = " <> ppr (sizeUniqSet slotsFree))
56 -- allocate a slot for each of the spilled regs
57 let slots = take (sizeUniqSet regs) $ uniqSetToList slotsFree
58 let regSlotMap = listToUFM
59 $ zip (uniqSetToList regs) slots
61 -- grab the unique supply from the monad
64 -- run the spiller on all the blocks
66 runState (mapM (mapBlockTopM (regSpill_block regSlotMap)) code)
70 , minusUniqSet slotsFree (mkUniqSet slots)
71 , makeSpillStats state')
74 regSpill_block regSlotMap (BasicBlock i instrs)
75 = do instrss' <- mapM (regSpill_instr regSlotMap) instrs
76 return $ BasicBlock i (concat instrss')
78 regSpill_instr _ li@(Instr _ Nothing)
81 regSpill_instr regSlotMap
82 (Instr instr (Just _))
84 -- work out which regs are read and written in this instr
85 let RU rlRead rlWritten = regUsage instr
87 -- sometimes a register is listed as being read more than once,
88 -- nub this so we don't end up inserting two lots of spill code.
89 let rsRead_ = nub rlRead
90 let rsWritten_ = nub rlWritten
92 -- if a reg is modified, it appears in both lists, want to undo this..
93 let rsRead = rsRead_ \\ rsWritten_
94 let rsWritten = rsWritten_ \\ rsRead_
95 let rsModify = intersect rsRead_ rsWritten_
97 -- work out if any of the regs being used are currently being spilled.
98 let rsSpillRead = filter (\r -> elemUFM r regSlotMap) rsRead
99 let rsSpillWritten = filter (\r -> elemUFM r regSlotMap) rsWritten
100 let rsSpillModify = filter (\r -> elemUFM r regSlotMap) rsModify
102 -- rewrite the instr and work out spill code.
103 (instr1, prepost1) <- mapAccumLM (spillRead regSlotMap) instr rsSpillRead
104 (instr2, prepost2) <- mapAccumLM (spillWrite regSlotMap) instr1 rsSpillWritten
105 (instr3, prepost3) <- mapAccumLM (spillModify regSlotMap) instr2 rsSpillModify
107 let (mPrefixes, mPostfixes) = unzip (prepost1 ++ prepost2 ++ prepost3)
108 let prefixes = concat mPrefixes
109 let postfixes = concat mPostfixes
112 let instrs' = map (\i -> Instr i Nothing) prefixes
113 ++ [ Instr instr3 Nothing ]
114 ++ map (\i -> Instr i Nothing) postfixes
117 {- $ pprTrace "* regSpill_instr spill"
118 ( text "instr = " <> ppr instr
119 $$ text "read = " <> ppr rsSpillRead
120 $$ text "write = " <> ppr rsSpillWritten
121 $$ text "mod = " <> ppr rsSpillModify
123 $$ (vcat $ map ppr instrs')
129 spillRead regSlotMap instr reg
130 | Just slot <- lookupUFM regSlotMap reg
131 = do (instr', nReg) <- patchInstr reg instr
134 { stateSpillSL = addToUFM_C accSpillSL (stateSpillSL s) reg (reg, 0, 1) }
137 , ( [RELOAD slot nReg]
140 | otherwise = panic "RegSpill.spillRead: no slot defined for spilled reg"
142 spillWrite regSlotMap instr reg
143 | Just slot <- lookupUFM regSlotMap reg
144 = do (instr', nReg) <- patchInstr reg instr
147 { stateSpillSL = addToUFM_C accSpillSL (stateSpillSL s) reg (reg, 1, 0) }
151 , [SPILL nReg slot]))
153 | otherwise = panic "RegSpill.spillWrite: no slot defined for spilled reg"
155 spillModify regSlotMap instr reg
156 | Just slot <- lookupUFM regSlotMap reg
157 = do (instr', nReg) <- patchInstr reg instr
160 { stateSpillSL = addToUFM_C accSpillSL (stateSpillSL s) reg (reg, 1, 1) }
163 , ( [RELOAD slot nReg]
164 , [SPILL nReg slot]))
166 | otherwise = panic "RegSpill.spillModify: no slot defined for spilled reg"
170 -- | rewrite uses of this virtual reg in an instr to use a different virtual reg
171 patchInstr :: Reg -> Instr -> SpillM (Instr, Reg)
173 = do nUnique <- newUnique
174 let nReg = renameVirtualReg nUnique reg
175 let instr' = patchReg1 reg nReg instr
176 return (instr', nReg)
178 patchReg1 :: Reg -> Reg -> Instr -> Instr
179 patchReg1 old new instr
183 in patchRegs instr patchF
186 ------------------------------------------------------
191 { stateUS :: UniqSupply
192 , stateSpillSL :: UniqFM (Reg, Int, Int) } -- ^ spilled reg vs number of times vreg was loaded, stored
194 initSpillS uniqueSupply
196 { stateUS = uniqueSupply
197 , stateSpillSL = emptyUFM }
199 type SpillM a = State SpillS a
201 newUnique :: SpillM Unique
203 = do us <- gets stateUS
204 case splitUniqSupply us of
206 -> do let uniq = uniqFromSupply us1
207 modify $ \s -> s { stateUS = us2 }
210 accSpillSL (r1, s1, l1) (_, s2, l2)
211 = (r1, s1 + s2, l1 + l2)
214 ----------------------------------------------------
219 { spillStoreLoad :: UniqFM (Reg, Int, Int) }
221 makeSpillStats :: SpillS -> SpillStats
224 { spillStoreLoad = stateSpillSL s }
226 instance Outputable SpillStats where
228 = (vcat $ map (\(r, s, l) -> ppr r <+> int s <+> int l)
229 $ eltsUFM (spillStoreLoad stats))