Spill.hs 13.1 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
import Data.IntSet              (IntSet)
import qualified Data.IntSet    as IntSet
29 30


31
-- | Spill all these virtual regs to stack slots.
32
--
33 34
--   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.
35
--
36 37 38
--   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.
39 40
--
regSpill
41
        :: Instruction instr
42 43
        => Platform
        -> [LiveCmmDecl statics instr]  -- ^ the code
44 45 46
        -> UniqSet Int                  -- ^ available stack slots
        -> UniqSet VirtualReg           -- ^ the regs to spill
        -> UniqSM
47
            ([LiveCmmDecl statics instr]
48 49 50
                 -- code with SPILL and RELOAD meta instructions added.
            , UniqSet Int               -- left over slots
            , SpillStats )              -- stats about what happened during spilling
51

52
regSpill platform code slotsFree regs
53

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

60 61
        | otherwise
        = do
62
                -- Allocate a slot for each of the spilled regs.
niteria's avatar
niteria committed
63
                let slots       = take (sizeUniqSet regs) $ nonDetEltsUFM slotsFree
64
                let regSlotMap  = listToUFM
niteria's avatar
niteria committed
65 66 67 68
                                $ zip (nonDetEltsUFM regs) slots
                    -- This is non-deterministic but we do not
                    -- currently support deterministic code-generation.
                    -- See Note [Unique Determinism and code generation]
69

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

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

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


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

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

98
        CmmProc info label live sccs
99 100
         |  LiveInfo static firstId mLiveVRegsOnEntry liveSlotsOnEntry <- info
         -> do
101 102
                -- 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.
103 104
                let liveVRegsOnEntry    = fromMaybe mapEmpty mLiveVRegsOnEntry

105 106 107 108 109 110
                -- 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.
111
                let liveSlotsOnEntry' :: BlockMap IntSet
112
                    liveSlotsOnEntry'
113
                        = mapFoldWithKey patchLiveSlot
114
                                         liveSlotsOnEntry liveVRegsOnEntry
115 116 117 118 119 120 121

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

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

124
                return  $ CmmProc info' label live sccs'
125

126 127 128 129
 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.
130 131
        patchLiveSlot
                :: BlockId -> RegSet
132
                -> BlockMap IntSet -> BlockMap IntSet
133

134
        patchLiveSlot blockId regsLive slotMap
135
         = let
136
                -- Slots that are already recorded as being live.
137 138
                curSlotsLive    = fromMaybe IntSet.empty
                                $ lookupBlockMap blockId slotMap
139

140
                moreSlotsLive   = IntSet.fromList
141 142
                                $ catMaybes
                                $ map (lookupUFM regSlotMap)
niteria's avatar
niteria committed
143 144
                                $ nonDetEltsUFM regsLive
                    -- See Note [Unique Determinism and code generation]
145

146
                slotMap'
147 148
                 = insertBlockMap blockId (IntSet.union curSlotsLive moreSlotsLive)
                                  slotMap
149 150

           in   slotMap'
151 152 153 154


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

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

165

166 167 168 169
-- | 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.
170
regSpill_instr
171
        :: Instruction instr
172 173
        => Platform
        -> UniqFM Int -- ^ map of vregs to slots they're being spilled to.
174 175
        -> LiveInstr instr
        -> SpillM [LiveInstr instr]
176

177
regSpill_instr _ _ li@(LiveInstr _ Nothing)
178
 = do   return [li]
179

180
regSpill_instr platform regSlotMap
181
        (LiveInstr instr (Just _))
182
 = do
183
        -- work out which regs are read and written in this instr
184
        let RU rlRead rlWritten = regUsageOfInstr platform instr
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 213 214

        -- 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

215
        return $ instrs'
216 217


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

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

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

234 235 236
         return  ( instr'
                 , ( [LiveInstr (RELOAD slot nReg) Nothing]
                 , []) )
237

238
 | otherwise     = panic "RegSpill.spillRead: no slot defined for spilled reg"
239

240

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

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

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

257 258 259
         return  ( instr'
                 , ( []
                   , [LiveInstr (SPILL nReg slot) Nothing]))
260

261
 | otherwise     = panic "RegSpill.spillWrite: no slot defined for spilled reg"
262

263

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

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

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

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

284
 | otherwise     = panic "RegSpill.spillModify: no slot defined for spilled reg"
285

286

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

293
patchInstr reg instr
294
 = do   nUnique         <- newUnique
295 296 297 298 299

        -- 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
300
                RegVirtual vr
301 302
                 -> RegVirtual (renameVirtualReg nUnique vr)

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

306 307
        let instr'      = patchReg1 reg nReg instr
        return          (instr', nReg)
308

309

310 311 312
patchReg1
        :: Instruction instr
        => Reg -> Reg -> instr -> instr
313

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


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

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

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

335 336

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


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

353 354

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


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

367 368

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

374

375
instance Outputable SpillStats where
376
 ppr stats
niteria's avatar
niteria committed
377 378
        = pprUFM (spillStoreLoad stats)
                 (vcat . map (\(r, s, l) -> ppr r <+> int s <+> int l))