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

55
regSpill platform code slotsFree regs
56

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

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

73
                -- Grab the unique supply from the monad.
74
                us      <- getUniqueSupplyM
75

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

81 82 83
                return  ( code'
                        , minusUniqSet slotsFree (mkUniqSet slots)
                        , makeSpillStats state')
84 85


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

96
regSpill_top platform regSlotMap cmm
97
 = case cmm of
98 99 100
        CmmData{}
         -> return cmm

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

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

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

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

127
                return  $ CmmProc info' label live sccs'
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.
133
        patchLiveSlot
134
                :: BlockMap IntSet -> BlockId -> RegSet -> BlockMap IntSet
135

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

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

148
                slotMap'
149 150
                 = mapInsert blockId (IntSet.union curSlotsLive moreSlotsLive)
                             slotMap
151 152

           in   slotMap'
153 154 155 156


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

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

167

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

179
regSpill_instr _ _ li@(LiveInstr _ Nothing)
180
 = do   return [li]
181

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

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

217
        return $ instrs'
218 219


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

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

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

236 237 238
         return  ( instr'
                 , ( [LiveInstr (RELOAD slot nReg) Nothing]
                 , []) )
239

240
 | otherwise     = panic "RegSpill.spillRead: no slot defined for spilled reg"
241

242

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

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

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

259 260 261
         return  ( instr'
                 , ( []
                   , [LiveInstr (SPILL nReg slot) Nothing]))
262

263
 | otherwise     = panic "RegSpill.spillWrite: no slot defined for spilled reg"
264

265

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

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

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

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

286
 | otherwise     = panic "RegSpill.spillModify: no slot defined for spilled reg"
287

288

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

295
patchInstr reg instr
296
 = do   nUnique         <- newUnique
297 298 299 300 301

        -- 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
302
                RegVirtual vr
303 304
                 -> RegVirtual (renameVirtualReg nUnique vr)

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

308 309
        let instr'      = patchReg1 reg nReg instr
        return          (instr', nReg)
310

311

312 313 314
patchReg1
        :: Instruction instr
        => Reg -> Reg -> instr -> instr
315

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


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

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

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

337 338

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


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

355 356

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


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

369 370

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

376

377
instance Outputable SpillStats where
378
 ppr stats
379 380
        = pprUFM (spillStoreLoad stats)
                 (vcat . map (\(r, s, l) -> ppr r <+> int s <+> int l))