Spill.hs 13.4 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 11
import GhcPrelude

12
import RegAlloc.Liveness
13 14
import Instruction
import Reg
15
import Cmm hiding (RegSet)
16
import BlockId
17
import Hoopl.Collections
18

19
import MonadUtils
20
import State
21 22 23 24 25
import Unique
import UniqFM
import UniqSet
import UniqSupply
import Outputable
26
import Platform
27 28

import Data.List
29
import Data.Maybe
30 31
import Data.IntSet              (IntSet)
import qualified Data.IntSet    as IntSet
32 33


34
-- | Spill all these virtual regs to stack slots.
35
--
36 37 38
--   Bumps the number of required stack slots if required.
--
--
39 40
--   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.
41
--
42
--   TODO: On CISCy x86 and x86_64 we don't necessarily have to add a mov instruction
43 44
--         when making spills. If an instr is using a spilled virtual we may be able to
--         address the spill slot directly.
45 46
--
regSpill
47
        :: Instruction instr
48 49
        => Platform
        -> [LiveCmmDecl statics instr]  -- ^ the code
50
        -> UniqSet Int                  -- ^ available stack slots
51
        -> Int                          -- ^ current number of spill slots.
52 53
        -> UniqSet VirtualReg           -- ^ the regs to spill
        -> UniqSM
54
            ([LiveCmmDecl statics instr]
55 56
                 -- code with SPILL and RELOAD meta instructions added.
            , UniqSet Int               -- left over slots
57
            , Int                       -- slot count in use now.
58
            , SpillStats )              -- stats about what happened during spilling
59

60
regSpill platform code slotsFree slotCount regs
61

62
        -- Not enough slots to spill these regs.
63
        | sizeUniqSet slotsFree < sizeUniqSet regs
64 65 66
        = -- pprTrace "Bumping slot count:" (ppr slotCount <> text " -> " <> ppr (slotCount+512)) $
          let slotsFree' = (addListToUniqSet slotsFree [slotCount+1 .. slotCount+512])
          in regSpill platform code slotsFree' (slotCount+512) regs
67

68 69
        | otherwise
        = do
70
                -- Allocate a slot for each of the spilled regs.
David Feuer's avatar
David Feuer committed
71
                let slots       = take (sizeUniqSet regs) $ nonDetEltsUniqSet slotsFree
72
                let regSlotMap  = listToUFM
David Feuer's avatar
David Feuer committed
73
                                $ zip (nonDetEltsUniqSet regs) slots
niteria's avatar
niteria committed
74 75 76
                    -- This is non-deterministic but we do not
                    -- currently support deterministic code-generation.
                    -- See Note [Unique Determinism and code generation]
77

78
                -- Grab the unique supply from the monad.
79
                us      <- getUniqueSupplyM
80

81
                -- Run the spiller on all the blocks.
82
                let (code', state')     =
83
                        runState (mapM (regSpill_top platform regSlotMap) code)
84
                                 (initSpillS us)
85

86 87
                return  ( code'
                        , minusUniqSet slotsFree (mkUniqSet slots)
88
                        , slotCount
89
                        , makeSpillStats state')
90 91


92
-- | Spill some registers to stack slots in a top-level thing.
93 94
regSpill_top
        :: Instruction instr
95
        => Platform
96
        -> RegMap Int
97
                -- ^ map of vregs to slots they're being spilled to.
98
        -> LiveCmmDecl statics instr
99
                -- ^ the top level thing.
100 101
        -> SpillM (LiveCmmDecl statics instr)

102
regSpill_top platform regSlotMap cmm
103
 = case cmm of
104 105 106
        CmmData{}
         -> return cmm

107
        CmmProc info label live sccs
108 109
         |  LiveInfo static firstId mLiveVRegsOnEntry liveSlotsOnEntry <- info
         -> do
110 111
                -- 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.
112 113
                let liveVRegsOnEntry    = fromMaybe mapEmpty mLiveVRegsOnEntry

114 115 116 117 118 119
                -- 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.
120
                let liveSlotsOnEntry' :: BlockMap IntSet
121
                    liveSlotsOnEntry'
122 123
                        = mapFoldlWithKey patchLiveSlot
                                          liveSlotsOnEntry liveVRegsOnEntry
124 125 126 127 128 129 130

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

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

133
                return  $ CmmProc info' label live sccs'
134

135 136 137 138
 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.
139
        patchLiveSlot
140
                :: BlockMap IntSet -> BlockId -> RegSet -> BlockMap IntSet
141

142
        patchLiveSlot slotMap blockId regsLive
143
         = let
144
                -- Slots that are already recorded as being live.
145
                curSlotsLive    = fromMaybe IntSet.empty
146
                                $ mapLookup blockId slotMap
147

148
                moreSlotsLive   = IntSet.fromList
149 150
                                $ catMaybes
                                $ map (lookupUFM regSlotMap)
David Feuer's avatar
David Feuer committed
151
                                $ nonDetEltsUniqSet regsLive
niteria's avatar
niteria committed
152
                    -- See Note [Unique Determinism and code generation]
153

154
                slotMap'
155 156
                 = mapInsert blockId (IntSet.union curSlotsLive moreSlotsLive)
                             slotMap
157 158

           in   slotMap'
159 160 161 162


-- | Spill some registers to stack slots in a basic block.
regSpill_block
163
        :: Instruction instr
164
        => Platform
165
        -> UniqFM Int   -- ^ map of vregs to slots they're being spilled to.
166 167 168
        -> LiveBasicBlock instr
        -> SpillM (LiveBasicBlock instr)

169 170
regSpill_block platform regSlotMap (BasicBlock i instrs)
 = do   instrss'        <- mapM (regSpill_instr platform regSlotMap) instrs
171
        return  $ BasicBlock i (concat instrss')
172

173

174 175 176 177
-- | 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.
178
regSpill_instr
179
        :: Instruction instr
180 181
        => Platform
        -> UniqFM Int -- ^ map of vregs to slots they're being spilled to.
182 183
        -> LiveInstr instr
        -> SpillM [LiveInstr instr]
184

185
regSpill_instr _ _ li@(LiveInstr _ Nothing)
186
 = do   return [li]
187

188
regSpill_instr platform regSlotMap
189
        (LiveInstr instr (Just _))
190
 = do
191
        -- work out which regs are read and written in this instr
192
        let RU rlRead rlWritten = regUsageOfInstr platform instr
193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222

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

223
        return $ instrs'
224 225


226 227
-- | Add a RELOAD met a instruction to load a value for an instruction that
--   writes to a vreg that is being spilled.
228 229 230 231 232 233
spillRead
        :: Instruction instr
        => UniqFM Int
        -> instr
        -> Reg
        -> SpillM (instr, ([LiveInstr instr'], [LiveInstr instr']))
234

235
spillRead regSlotMap instr reg
236 237
 | Just slot     <- lookupUFM regSlotMap reg
 = do    (instr', nReg)  <- patchInstr reg instr
238

239 240
         modify $ \s -> s
                { stateSpillSL  = addToUFM_C accSpillSL (stateSpillSL s) reg (reg, 0, 1) }
241

242 243 244
         return  ( instr'
                 , ( [LiveInstr (RELOAD slot nReg) Nothing]
                 , []) )
245

246
 | otherwise     = panic "RegSpill.spillRead: no slot defined for spilled reg"
247

248

249 250
-- | Add a SPILL meta instruction to store a value for an instruction that
--   writes to a vreg that is being spilled.
251 252 253 254 255 256
spillWrite
        :: Instruction instr
        => UniqFM Int
        -> instr
        -> Reg
        -> SpillM (instr, ([LiveInstr instr'], [LiveInstr instr']))
257

258
spillWrite regSlotMap instr reg
259 260
 | Just slot     <- lookupUFM regSlotMap reg
 = do    (instr', nReg)  <- patchInstr reg instr
261

262 263
         modify $ \s -> s
                { stateSpillSL  = addToUFM_C accSpillSL (stateSpillSL s) reg (reg, 1, 0) }
264

265 266 267
         return  ( instr'
                 , ( []
                   , [LiveInstr (SPILL nReg slot) Nothing]))
268

269
 | otherwise     = panic "RegSpill.spillWrite: no slot defined for spilled reg"
270

271

272 273
-- | Add both RELOAD and SPILL meta instructions for an instruction that
--   both reads and writes to a vreg that is being spilled.
274 275 276 277 278 279
spillModify
        :: Instruction instr
        => UniqFM Int
        -> instr
        -> Reg
        -> SpillM (instr, ([LiveInstr instr'], [LiveInstr instr']))
280

281 282 283
spillModify regSlotMap instr reg
 | Just slot     <- lookupUFM regSlotMap reg
 = do    (instr', nReg)  <- patchInstr reg instr
284

285 286
         modify $ \s -> s
                { stateSpillSL  = addToUFM_C accSpillSL (stateSpillSL s) reg (reg, 1, 1) }
287

288 289 290
         return  ( instr'
                 , ( [LiveInstr (RELOAD slot nReg) Nothing]
                   , [LiveInstr (SPILL nReg slot) Nothing]))
291

292
 | otherwise     = panic "RegSpill.spillModify: no slot defined for spilled reg"
293

294

295 296
-- | Rewrite uses of this virtual reg in an instr to use a different
--   virtual reg.
297 298 299
patchInstr
        :: Instruction instr
        => Reg -> instr -> SpillM (instr, Reg)
300

301
patchInstr reg instr
302
 = do   nUnique         <- newUnique
303 304 305 306 307

        -- 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
308
                RegVirtual vr
309 310
                 -> RegVirtual (renameVirtualReg nUnique vr)

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

314 315
        let instr'      = patchReg1 reg nReg instr
        return          (instr', nReg)
316

317

318 319 320
patchReg1
        :: Instruction instr
        => Reg -> Reg -> instr -> instr
321

322
patchReg1 old new instr
323 324 325 326
 = let  patchF r
                | r == old      = new
                | otherwise     = r
   in   patchRegsOfInstr instr patchF
327 328


329
-- Spiller monad --------------------------------------------------------------
330 331 332 333 334
-- | State monad for the spill code generator.
type SpillM a
        = State SpillS a

-- | Spill code generator state.
335
data SpillS
336
        = SpillS
337
        { -- | Unique supply for generating fresh vregs.
338 339
          stateUS       :: UniqSupply

340
          -- | Spilled vreg vs the number of times it was loaded, stored.
341
        , stateSpillSL  :: UniqFM (Reg, Int, Int) }
342

343 344

-- | Create a new spiller state.
345
initSpillS :: UniqSupply -> SpillS
346
initSpillS uniqueSupply
347 348 349
        = SpillS
        { stateUS       = uniqueSupply
        , stateSpillSL  = emptyUFM }
350 351


352
-- | Allocate a new unique in the spiller monad.
353 354
newUnique :: SpillM Unique
newUnique
Ian Lynagh's avatar
Ian Lynagh committed
355
 = do   us      <- gets stateUS
356 357 358
        case takeUniqFromSupply us of
         (uniq, us')
          -> do modify $ \s -> s { stateUS = us' }
Ian Lynagh's avatar
Ian Lynagh committed
359
                return uniq
360

361 362

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


368
-- Spiller stats --------------------------------------------------------------
369 370
-- | Spiller statistics.
--   Tells us what registers were spilled.
371
data SpillStats
372 373
        = SpillStats
        { spillStoreLoad        :: UniqFM (Reg, Int, Int) }
374

375 376

-- | Extract spiller statistics from the spiller state.
377 378
makeSpillStats :: SpillS -> SpillStats
makeSpillStats s
379 380
        = SpillStats
        { spillStoreLoad        = stateSpillSL s }
381

382

383
instance Outputable SpillStats where
384
 ppr stats
niteria's avatar
niteria committed
385 386
        = pprUFM (spillStoreLoad stats)
                 (vcat . map (\(r, s, l) -> ppr r <+> int s <+> int l))