8 #include "HsVersions.h"
26 -- | Spill all these virtual regs to memory
27 -- TODO: see if we can split some of the live ranges instead of just globally
28 -- spilling the virtual reg.
30 -- TODO: On ciscy x86 and x86_64 we don't nessesarally have to add a mov instruction
31 -- when making spills. If an instr is using a spilled virtual we may be able to
32 -- address the spill slot directly.
35 :: [LiveCmmTop] -- ^ the code
36 -> UniqSet Int -- ^ available stack slots
37 -> UniqSet Reg -- ^ the regs to spill
39 ([LiveCmmTop] -- ^ code will spill instructions
40 , UniqSet Int) -- ^ left over slots
42 regSpill code slotsFree regs
44 -- not enough slots to spill these regs
45 | sizeUniqSet slotsFree < sizeUniqSet regs
46 = pprPanic "regSpill: out of spill slots!"
47 ( text " regs to spill = " <> ppr (sizeUniqSet regs)
48 $$ text " slots left = " <> ppr (sizeUniqSet slotsFree))
52 -- allocate a slot for each of the spilled regs
53 let slots = take (sizeUniqSet regs) $ uniqSetToList slotsFree
54 let regSlotMap = listToUFM
55 $ zip (uniqSetToList regs) slots
57 -- grab the unique supply from the monad
60 -- run the spiller on all the blocks
62 runSpill (mapM (mapBlockTopM (regSpill_block regSlotMap)) code)
66 , minusUniqSet slotsFree (mkUniqSet slots) )
69 regSpill_block regSlotMap (BasicBlock i instrs)
70 = do instrss' <- mapM (regSpill_instr regSlotMap) instrs
71 return $ BasicBlock i (concat instrss')
74 regSpill_instr _ li@(Instr (DELTA delta) _)
79 regSpill_instr _ li@(Instr _ Nothing)
83 regSpill_instr regSlotMap
84 (Instr instr (Just live))
86 -- work out which regs are read and written in this instr
87 let RU rlRead rlWritten = regUsage instr
89 -- sometimes a register is listed as being read more than once,
90 -- nub this so we don't end up inserting two lots of spill code.
91 let rsRead_ = nub rlRead
92 let rsWritten_ = nub rlWritten
94 -- if a reg is modified, it appears in both lists, want to undo this..
95 let rsRead = rsRead_ \\ rsWritten_
96 let rsWritten = rsWritten_ \\ rsRead_
97 let rsModify = intersect rsRead_ rsWritten_
99 -- work out if any of the regs being used are currently being spilled.
100 let rsSpillRead = filter (\r -> elemUFM r regSlotMap) rsRead
101 let rsSpillWritten = filter (\r -> elemUFM r regSlotMap) rsWritten
102 let rsSpillModify = filter (\r -> elemUFM r regSlotMap) rsModify
104 -- rewrite the instr and work out spill code.
105 (instr1, prepost1) <- mapAccumLM (spillRead regSlotMap) instr rsSpillRead
106 (instr2, prepost2) <- mapAccumLM (spillWrite regSlotMap) instr1 rsSpillWritten
107 (instr3, prepost3) <- mapAccumLM (spillModify regSlotMap) instr2 rsSpillModify
109 let (mPrefixes, mPostfixes) = unzip (prepost1 ++ prepost2 ++ prepost3)
110 let prefixes = concat mPrefixes
111 let postfixes = concat mPostfixes
114 let instrs' = map (\i -> Instr i Nothing) prefixes
115 ++ [ Instr instr3 Nothing ]
116 ++ map (\i -> Instr i Nothing) postfixes
119 {- $ pprTrace "* regSpill_instr spill"
120 ( text "instr = " <> ppr instr
121 $$ text "read = " <> ppr rsSpillRead
122 $$ text "write = " <> ppr rsSpillWritten
123 $$ text "mod = " <> ppr rsSpillModify
125 $$ (vcat $ map ppr instrs')
131 spillRead regSlotMap instr reg
132 | Just slot <- lookupUFM regSlotMap reg
133 = do delta <- getDelta
134 (instr', nReg) <- patchInstr reg instr
136 let pre = [ COMMENT FSLIT("spill read")
137 , mkLoadInstr nReg delta slot ]
139 return ( instr', (pre, []))
141 | otherwise = panic "RegSpill.spillRead: no slot defined for spilled reg"
143 spillWrite regSlotMap instr reg
144 | Just slot <- lookupUFM regSlotMap reg
145 = do delta <- getDelta
146 (instr', nReg) <- patchInstr reg instr
148 let post = [ COMMENT FSLIT("spill write")
149 , mkSpillInstr nReg delta slot ]
151 return ( instr', ([], post))
153 | otherwise = panic "RegSpill.spillWrite: no slot defined for spilled reg"
155 spillModify regSlotMap instr reg
156 | Just slot <- lookupUFM regSlotMap reg
157 = do delta <- getDelta
158 (instr', nReg) <- patchInstr reg instr
160 let pre = [ COMMENT FSLIT("spill mod load")
161 , mkLoadInstr nReg delta slot ]
163 let post = [ COMMENT FSLIT("spill mod write")
164 , mkSpillInstr nReg delta slot ]
166 return ( instr', (pre, post))
168 | otherwise = panic "RegSpill.spillModify: no slot defined for spilled reg"
171 -- | rewrite uses of this virtual reg in an instr to use a different virtual reg
172 patchInstr :: Reg -> Instr -> SpillM (Instr, Reg)
174 = do nUnique <- newUnique
175 let nReg = renameVirtualReg nUnique reg
176 let instr' = patchReg1 reg nReg instr
177 return (instr', nReg)
179 patchReg1 :: Reg -> Reg -> Instr -> Instr
180 patchReg1 old new instr
184 in patchRegs instr patchF
187 -------------------------------------------------------------------------------------------
193 , stateUS :: UniqSupply }
195 initSpillS uniqueSupply
198 , stateUS = uniqueSupply }
202 { runSpill :: SpillS -> (# a, SpillS #) }
204 instance Monad SpillM where
205 return x = SpillM $ \s -> (# x, s #)
207 m >>= n = SpillM $ \s ->
209 (# r, s' #) -> runSpill (n r) s'
211 setDelta :: Int -> SpillM ()
213 = SpillM $ \s -> (# (), s { stateDelta = delta } #)
215 getDelta :: SpillM Int
216 getDelta = SpillM $ \s -> (# stateDelta s, s #)
218 newUnique :: SpillM Unique
221 -> case splitUniqSupply (stateUS s) of
223 -> (# uniqFromSupply us1
224 , s { stateUS = us2 } #)
226 mapAccumLM _ s [] = return (s, [])
227 mapAccumLM f s (x:xs)
230 (s2, xs') <- mapAccumLM f s1 xs
231 return (s2, x' : xs')