10 #include "HsVersions.h"
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')
79 regSpill_instr _ li@(Instr (DELTA delta) _)
84 regSpill_instr _ li@(Instr _ Nothing)
88 regSpill_instr regSlotMap
89 (Instr instr (Just live))
91 -- work out which regs are read and written in this instr
92 let RU rlRead rlWritten = regUsage instr
94 -- sometimes a register is listed as being read more than once,
95 -- nub this so we don't end up inserting two lots of spill code.
96 let rsRead_ = nub rlRead
97 let rsWritten_ = nub rlWritten
99 -- if a reg is modified, it appears in both lists, want to undo this..
100 let rsRead = rsRead_ \\ rsWritten_
101 let rsWritten = rsWritten_ \\ rsRead_
102 let rsModify = intersect rsRead_ rsWritten_
104 -- work out if any of the regs being used are currently being spilled.
105 let rsSpillRead = filter (\r -> elemUFM r regSlotMap) rsRead
106 let rsSpillWritten = filter (\r -> elemUFM r regSlotMap) rsWritten
107 let rsSpillModify = filter (\r -> elemUFM r regSlotMap) rsModify
109 -- rewrite the instr and work out spill code.
110 (instr1, prepost1) <- mapAccumLM (spillRead regSlotMap) instr rsSpillRead
111 (instr2, prepost2) <- mapAccumLM (spillWrite regSlotMap) instr1 rsSpillWritten
112 (instr3, prepost3) <- mapAccumLM (spillModify regSlotMap) instr2 rsSpillModify
114 let (mPrefixes, mPostfixes) = unzip (prepost1 ++ prepost2 ++ prepost3)
115 let prefixes = concat mPrefixes
116 let postfixes = concat mPostfixes
119 let instrs' = map (\i -> Instr i Nothing) prefixes
120 ++ [ Instr instr3 Nothing ]
121 ++ map (\i -> Instr i Nothing) postfixes
124 {- $ pprTrace "* regSpill_instr spill"
125 ( text "instr = " <> ppr instr
126 $$ text "read = " <> ppr rsSpillRead
127 $$ text "write = " <> ppr rsSpillWritten
128 $$ text "mod = " <> ppr rsSpillModify
130 $$ (vcat $ map ppr instrs')
136 spillRead regSlotMap instr reg
137 | Just slot <- lookupUFM regSlotMap reg
138 = do delta <- getDelta
139 (instr', nReg) <- patchInstr reg instr
141 let pre = [ COMMENT FSLIT("spill load")
142 , mkLoadInstr nReg delta slot ]
145 { stateSpillSL = addToUFM_C accSpillSL (stateSpillSL s) reg (reg, 0, 1) }
147 return ( instr', (pre, []))
149 | otherwise = panic "RegSpill.spillRead: no slot defined for spilled reg"
151 spillWrite regSlotMap instr reg
152 | Just slot <- lookupUFM regSlotMap reg
153 = do delta <- getDelta
154 (instr', nReg) <- patchInstr reg instr
156 let post = [ COMMENT FSLIT("spill store")
157 , mkSpillInstr nReg delta slot ]
160 { stateSpillSL = addToUFM_C accSpillSL (stateSpillSL s) reg (reg, 1, 0) }
162 return ( instr', ([], post))
164 | otherwise = panic "RegSpill.spillWrite: no slot defined for spilled reg"
166 spillModify regSlotMap instr reg
167 | Just slot <- lookupUFM regSlotMap reg
168 = do delta <- getDelta
169 (instr', nReg) <- patchInstr reg instr
171 let pre = [ COMMENT FSLIT("spill mod load")
172 , mkLoadInstr nReg delta slot ]
174 let post = [ COMMENT FSLIT("spill mod store")
175 , mkSpillInstr nReg delta slot ]
178 { stateSpillSL = addToUFM_C accSpillSL (stateSpillSL s) reg (reg, 1, 1) }
180 return ( instr', (pre, post))
182 | otherwise = panic "RegSpill.spillModify: no slot defined for spilled reg"
186 -- | rewrite uses of this virtual reg in an instr to use a different virtual reg
187 patchInstr :: Reg -> Instr -> SpillM (Instr, Reg)
189 = do nUnique <- newUnique
190 let nReg = renameVirtualReg nUnique reg
191 let instr' = patchReg1 reg nReg instr
192 return (instr', nReg)
194 patchReg1 :: Reg -> Reg -> Instr -> Instr
195 patchReg1 old new instr
199 in patchRegs instr patchF
202 ------------------------------------------------------
208 , stateUS :: UniqSupply
209 , stateSpillSL :: UniqFM (Reg, Int, Int) } -- ^ spilled reg vs number of times vreg was loaded, stored
211 initSpillS uniqueSupply
214 , stateUS = uniqueSupply
215 , stateSpillSL = emptyUFM }
217 type SpillM a = State SpillS a
219 setDelta :: Int -> SpillM ()
221 = modify $ \s -> s { stateDelta = delta }
223 getDelta :: SpillM Int
224 getDelta = gets stateDelta
226 newUnique :: SpillM Unique
228 = do us <- gets stateUS
229 case splitUniqSupply us of
231 -> do let uniq = uniqFromSupply us1
232 modify $ \s -> s { stateUS = us2 }
235 accSpillSL (r1, s1, l1) (r2, s2, l2)
236 = (r1, s1 + s2, l1 + l2)
240 ----------------------------------------------------
245 { spillStoreLoad :: UniqFM (Reg, Int, Int) }
247 makeSpillStats :: SpillS -> SpillStats
250 { spillStoreLoad = stateSpillSL s }
252 instance Outputable SpillStats where
254 = (vcat $ map (\(r, s, l) -> ppr r <+> int s <+> int l)
255 $ eltsUFM (spillStoreLoad stats))