Spill.hs 13.2 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
John Ericson's avatar
John Ericson committed
26
import GHC.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
         |  LiveInfo static firstId liveVRegsOnEntry liveSlotsOnEntry <- info
109
         -> do
110 111 112 113 114 115
                -- 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.
116
                let liveSlotsOnEntry' :: BlockMap IntSet
117
                    liveSlotsOnEntry'
118 119
                        = mapFoldlWithKey patchLiveSlot
                                          liveSlotsOnEntry liveVRegsOnEntry
120 121 122

                let info'
                        = LiveInfo static firstId
123
                                liveVRegsOnEntry
124 125 126
                                liveSlotsOnEntry'

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

129
                return  $ CmmProc info' label live sccs'
130

131 132 133 134
 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.
135
        patchLiveSlot
136
                :: BlockMap IntSet -> BlockId -> RegSet -> BlockMap IntSet
137

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

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

150
                slotMap'
151 152
                 = mapInsert blockId (IntSet.union curSlotsLive moreSlotsLive)
                             slotMap
153 154

           in   slotMap'
155 156 157 158


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

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

169

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

181
regSpill_instr _ _ li@(LiveInstr _ Nothing)
182
 = do   return [li]
183

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

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

219
        return $ instrs'
220 221


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

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

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

238 239 240
         return  ( instr'
                 , ( [LiveInstr (RELOAD slot nReg) Nothing]
                 , []) )
241

242
 | otherwise     = panic "RegSpill.spillRead: no slot defined for spilled reg"
243

244

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

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

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

261 262 263
         return  ( instr'
                 , ( []
                   , [LiveInstr (SPILL nReg slot) Nothing]))
264

265
 | otherwise     = panic "RegSpill.spillWrite: no slot defined for spilled reg"
266

267

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

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

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

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

288
 | otherwise     = panic "RegSpill.spillModify: no slot defined for spilled reg"
289

290

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

297
patchInstr reg instr
298
 = do   nUnique         <- newUnique
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
304
                RegVirtual vr
305 306
                 -> RegVirtual (renameVirtualReg nUnique vr)

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

310 311
        let instr'      = patchReg1 reg nReg instr
        return          (instr', nReg)
312

313

314 315 316
patchReg1
        :: Instruction instr
        => Reg -> Reg -> instr -> instr
317

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


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

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

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

339 340

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


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

357 358

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


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

371 372

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

378

379
instance Outputable SpillStats where
380
 ppr stats
niteria's avatar
niteria committed
381 382
        = pprUFM (spillStoreLoad stats)
                 (vcat . map (\(r, s, l) -> ppr r <+> int s <+> int l))