Spill.hs 13 KB
Newer Older
1

2 3 4
-- | When there aren't enough registers to hold all the vregs we have to spill
--   some of those vregs to slots on the stack. This module is used modify the
--   code to use those slots.
5
module RegAlloc.Graph.Spill (
6 7 8
        regSpill,
        SpillStats(..),
        accSpillSL
9
) where
10
import RegAlloc.Liveness
11 12
import Instruction
import Reg
13
import Cmm hiding (RegSet)
14
import BlockId
15

16
import MonadUtils
17
import State
18 19 20 21 22
import Unique
import UniqFM
import UniqSet
import UniqSupply
import Outputable
23
import Platform
24 25

import Data.List
26
import Data.Maybe
27 28 29 30
import Data.Map                 (Map)
import Data.Set                 (Set)
import qualified Data.Map       as Map
import qualified Data.Set       as Set
31 32


33
-- | Spill all these virtual regs to stack slots.
34
--
35 36
--   TODO: See if we can split some of the live ranges instead of just globally
--         spilling the virtual reg. This might make the spill cleaner's job easier.
37
--
38 39 40
--   TODO: On CISCy x86 and x86_64 we don't nessesarally have to add a mov instruction
--         when making spills. If an instr is using a spilled virtual we may be able to
--         address the spill slot directly.
41 42
--
regSpill
43
        :: Instruction instr
44 45
        => Platform
        -> [LiveCmmDecl statics instr]  -- ^ the code
46 47 48
        -> UniqSet Int                  -- ^ available stack slots
        -> UniqSet VirtualReg           -- ^ the regs to spill
        -> UniqSM
49 50 51 52
            ([LiveCmmDecl statics instr] 
                 -- code with SPILL and RELOAD meta instructions added.
            , UniqSet Int               -- left over slots
            , SpillStats )              -- stats about what happened during spilling
53

54
regSpill platform code slotsFree regs
55

56
        -- Not enough slots to spill these regs.
57 58 59 60
        | sizeUniqSet slotsFree < sizeUniqSet regs
        = pprPanic "regSpill: out of spill slots!"
                (  text "   regs to spill = " <> ppr (sizeUniqSet regs)
                $$ text "   slots left    = " <> ppr (sizeUniqSet slotsFree))
61

62 63
        | otherwise
        = do
64
                -- Allocate a slot for each of the spilled regs.
65 66 67
                let slots       = take (sizeUniqSet regs) $ uniqSetToList slotsFree
                let regSlotMap  = listToUFM
                                $ zip (uniqSetToList regs) slots
68

69
                -- Grab the unique supply from the monad.
70
                us      <- getUniqueSupplyM
71

72
                -- Run the spiller on all the blocks.
73
                let (code', state')     =
74
                        runState (mapM (regSpill_top platform regSlotMap) code)
75
                                 (initSpillS us)
76

77 78 79
                return  ( code'
                        , minusUniqSet slotsFree (mkUniqSet slots)
                        , makeSpillStats state')
80 81


82
-- | Spill some registers to stack slots in a top-level thing.
83 84
regSpill_top
        :: Instruction instr
85
        => Platform
86 87 88 89
        -> RegMap Int                   
                -- ^ map of vregs to slots they're being spilled to.
        -> LiveCmmDecl statics instr    
                -- ^ the top level thing.
90 91
        -> SpillM (LiveCmmDecl statics instr)

92
regSpill_top platform regSlotMap cmm
93
 = case cmm of
94 95 96
        CmmData{}
         -> return cmm

97
        CmmProc info label live sccs
98 99
         |  LiveInfo static firstId mLiveVRegsOnEntry liveSlotsOnEntry <- info
         -> do
100 101
                -- We should only passed Cmms with the liveness maps filled in,
                -- but we'll create empty ones if they're not there just in case.
102 103
                let liveVRegsOnEntry    = fromMaybe mapEmpty mLiveVRegsOnEntry

104 105 106 107 108 109
                -- The liveVRegsOnEntry contains the set of vregs that are live
                -- on entry to each basic block. If we spill one of those vregs
                -- we remove it from that set and add the corresponding slot
                -- number to the liveSlotsOnEntry set. The spill cleaner needs
                -- this information to erase unneeded spill and reload instructions
                -- after we've done a successful allocation.
110 111
                let liveSlotsOnEntry' :: Map BlockId (Set Int)
                    liveSlotsOnEntry'
112 113
                        = mapFoldWithKey patchLiveSlot 
                                         liveSlotsOnEntry liveVRegsOnEntry
114 115 116 117 118 119 120

                let info'
                        = LiveInfo static firstId
                                (Just liveVRegsOnEntry)
                                liveSlotsOnEntry'

                -- Apply the spiller to all the basic blocks in the CmmProc.
121
                sccs'   <- mapM (mapSCCM (regSpill_block platform regSlotMap)) sccs
122

123
                return  $ CmmProc info' label live sccs'
124

125 126 127 128 129 130 131 132
 where  -- Given a BlockId and the set of registers live in it,
        -- if registers in this block are being spilled to stack slots,
        -- then record the fact that these slots are now live in those blocks
        -- in the given slotmap.
        patchLiveSlot 
                :: BlockId -> RegSet 
                -> Map BlockId (Set Int) -> Map BlockId (Set Int)

133
        patchLiveSlot blockId regsLive slotMap
134 135 136
         = let  
                -- Slots that are already recorded as being live.
                curSlotsLive    = fromMaybe Set.empty
137 138 139 140 141 142 143
                                $ Map.lookup blockId slotMap

                moreSlotsLive   = Set.fromList
                                $ catMaybes
                                $ map (lookupUFM regSlotMap)
                                $ uniqSetToList regsLive

144 145 146
                slotMap'
                 = Map.insert blockId (Set.union curSlotsLive moreSlotsLive) 
                              slotMap
147 148

           in   slotMap'
149 150 151 152


-- | Spill some registers to stack slots in a basic block.
regSpill_block
153
        :: Instruction instr
154
        => Platform
155
        -> UniqFM Int   -- ^ map of vregs to slots they're being spilled to.
156 157 158
        -> LiveBasicBlock instr
        -> SpillM (LiveBasicBlock instr)

159 160
regSpill_block platform regSlotMap (BasicBlock i instrs)
 = do   instrss'        <- mapM (regSpill_instr platform regSlotMap) instrs
161
        return  $ BasicBlock i (concat instrss')
162

163

164 165 166 167
-- | Spill some registers to stack slots in a single instruction.
--   If the instruction uses registers that need to be spilled, then it is
--   prefixed (or postfixed) with the appropriate RELOAD or SPILL meta
--   instructions.
168
regSpill_instr
169
        :: Instruction instr
170 171
        => Platform
        -> UniqFM Int -- ^ map of vregs to slots they're being spilled to.
172 173
        -> LiveInstr instr
        -> SpillM [LiveInstr instr]
174

175
regSpill_instr _ _ li@(LiveInstr _ Nothing)
176
 = do   return [li]
177

178
regSpill_instr platform regSlotMap
179
        (LiveInstr instr (Just _))
180
 = do
181
        -- work out which regs are read and written in this instr
182
        let RU rlRead rlWritten = regUsageOfInstr platform instr
183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212

        -- sometimes a register is listed as being read more than once,
        --      nub this so we don't end up inserting two lots of spill code.
        let rsRead_             = nub rlRead
        let rsWritten_          = nub rlWritten

        -- if a reg is modified, it appears in both lists, want to undo this..
        let rsRead              = rsRead_    \\ rsWritten_
        let rsWritten           = rsWritten_ \\ rsRead_
        let rsModify            = intersect rsRead_ rsWritten_

        -- work out if any of the regs being used are currently being spilled.
        let rsSpillRead         = filter (\r -> elemUFM r regSlotMap) rsRead
        let rsSpillWritten      = filter (\r -> elemUFM r regSlotMap) rsWritten
        let rsSpillModify       = filter (\r -> elemUFM r regSlotMap) rsModify

        -- rewrite the instr and work out spill code.
        (instr1, prepost1)      <- mapAccumLM (spillRead   regSlotMap) instr  rsSpillRead
        (instr2, prepost2)      <- mapAccumLM (spillWrite  regSlotMap) instr1 rsSpillWritten
        (instr3, prepost3)      <- mapAccumLM (spillModify regSlotMap) instr2 rsSpillModify

        let (mPrefixes, mPostfixes)     = unzip (prepost1 ++ prepost2 ++ prepost3)
        let prefixes                    = concat mPrefixes
        let postfixes                   = concat mPostfixes

        -- final code
        let instrs'     =  prefixes
                        ++ [LiveInstr instr3 Nothing]
                        ++ postfixes

213
        return $ instrs'
214 215


216 217
-- | Add a RELOAD met a instruction to load a value for an instruction that
--   writes to a vreg that is being spilled.
218 219 220 221 222 223
spillRead
        :: Instruction instr
        => UniqFM Int
        -> instr
        -> Reg
        -> SpillM (instr, ([LiveInstr instr'], [LiveInstr instr']))
224

225
spillRead regSlotMap instr reg
226 227
 | Just slot     <- lookupUFM regSlotMap reg
 = do    (instr', nReg)  <- patchInstr reg instr
228

229 230
         modify $ \s -> s
                { stateSpillSL  = addToUFM_C accSpillSL (stateSpillSL s) reg (reg, 0, 1) }
231

232 233 234
         return  ( instr'
                 , ( [LiveInstr (RELOAD slot nReg) Nothing]
                 , []) )
235

236
 | otherwise     = panic "RegSpill.spillRead: no slot defined for spilled reg"
237

238

239 240
-- | Add a SPILL meta instruction to store a value for an instruction that
--   writes to a vreg that is being spilled.
241 242 243 244 245 246
spillWrite
        :: Instruction instr
        => UniqFM Int
        -> instr
        -> Reg
        -> SpillM (instr, ([LiveInstr instr'], [LiveInstr instr']))
247

248
spillWrite regSlotMap instr reg
249 250
 | Just slot     <- lookupUFM regSlotMap reg
 = do    (instr', nReg)  <- patchInstr reg instr
251

252 253
         modify $ \s -> s
                { stateSpillSL  = addToUFM_C accSpillSL (stateSpillSL s) reg (reg, 1, 0) }
254

255 256 257
         return  ( instr'
                 , ( []
                   , [LiveInstr (SPILL nReg slot) Nothing]))
258

259
 | otherwise     = panic "RegSpill.spillWrite: no slot defined for spilled reg"
260

261

262 263
-- | Add both RELOAD and SPILL meta instructions for an instruction that
--   both reads and writes to a vreg that is being spilled.
264 265 266 267 268 269
spillModify
        :: Instruction instr
        => UniqFM Int
        -> instr
        -> Reg
        -> SpillM (instr, ([LiveInstr instr'], [LiveInstr instr']))
270

271 272 273
spillModify regSlotMap instr reg
 | Just slot     <- lookupUFM regSlotMap reg
 = do    (instr', nReg)  <- patchInstr reg instr
274

275 276
         modify $ \s -> s
                { stateSpillSL  = addToUFM_C accSpillSL (stateSpillSL s) reg (reg, 1, 1) }
277

278 279 280
         return  ( instr'
                 , ( [LiveInstr (RELOAD slot nReg) Nothing]
                   , [LiveInstr (SPILL nReg slot) Nothing]))
281

282
 | otherwise     = panic "RegSpill.spillModify: no slot defined for spilled reg"
283

284

285 286
-- | Rewrite uses of this virtual reg in an instr to use a different
--   virtual reg.
287 288 289
patchInstr
        :: Instruction instr
        => Reg -> instr -> SpillM (instr, Reg)
290

291
patchInstr reg instr
292
 = do   nUnique         <- newUnique
293 294 295 296 297 298 299 300 301 302 303

        -- The register we're rewriting is suppoed to be virtual.
        -- If it's not then something has gone horribly wrong.
        let nReg
             = case reg of
                RegVirtual vr   
                 -> RegVirtual (renameVirtualReg nUnique vr)

                RegReal{}       
                 -> panic "RegAlloc.Graph.Spill.patchIntr: not patching real reg"

304 305
        let instr'      = patchReg1 reg nReg instr
        return          (instr', nReg)
306

307

308 309 310
patchReg1
        :: Instruction instr
        => Reg -> Reg -> instr -> instr
311

312
patchReg1 old new instr
313 314 315 316
 = let  patchF r
                | r == old      = new
                | otherwise     = r
   in   patchRegsOfInstr instr patchF
317 318


319
-- Spiller monad --------------------------------------------------------------
320 321 322 323 324
-- | State monad for the spill code generator.
type SpillM a
        = State SpillS a

-- | Spill code generator state.
325
data SpillS
326
        = SpillS
327
        { -- | Unique supply for generating fresh vregs.
328 329
          stateUS       :: UniqSupply

330
          -- | Spilled vreg vs the number of times it was loaded, stored.
331
        , stateSpillSL  :: UniqFM (Reg, Int, Int) }
332

333 334

-- | Create a new spiller state.
335
initSpillS :: UniqSupply -> SpillS
336
initSpillS uniqueSupply
337 338 339
        = SpillS
        { stateUS       = uniqueSupply
        , stateSpillSL  = emptyUFM }
340 341


342
-- | Allocate a new unique in the spiller monad.
343 344
newUnique :: SpillM Unique
newUnique
Ian Lynagh's avatar
Ian Lynagh committed
345
 = do   us      <- gets stateUS
346 347 348
        case takeUniqFromSupply us of
         (uniq, us')
          -> do modify $ \s -> s { stateUS = us' }
Ian Lynagh's avatar
Ian Lynagh committed
349
                return uniq
350

351 352

-- | Add a spill/reload count to a stats record for a register.
353
accSpillSL :: (Reg, Int, Int) -> (Reg, Int, Int) -> (Reg, Int, Int)
Ben.Lippmeier@anu.edu.au's avatar
Ben.Lippmeier@anu.edu.au committed
354
accSpillSL (r1, s1, l1) (_, s2, l2)
355
        = (r1, s1 + s2, l1 + l2)
356 357


358
-- Spiller stats --------------------------------------------------------------
359 360
-- | Spiller statistics.
--   Tells us what registers were spilled.
361
data SpillStats
362 363
        = SpillStats
        { spillStoreLoad        :: UniqFM (Reg, Int, Int) }
364

365 366

-- | Extract spiller statistics from the spiller state.
367 368
makeSpillStats :: SpillS -> SpillStats
makeSpillStats s
369 370
        = SpillStats
        { spillStoreLoad        = stateSpillSL s }
371

372

373
instance Outputable SpillStats where
374
 ppr stats
375 376
        = (vcat $ map (\(r, s, l) -> ppr r <+> int s <+> int l)
                        $ eltsUFM (spillStoreLoad stats))
377