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
import Hoopl
16

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

import Data.List
27
import Data.Maybe
28 29
import Data.IntSet              (IntSet)
import qualified Data.IntSet    as IntSet
30 31


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

53
regSpill platform code slotsFree regs
54

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

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

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

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

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


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

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

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

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

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

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

125
                return  $ CmmProc info' label live sccs'
126

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

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

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

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

           in   slotMap'
152 153 154 155


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

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

166

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

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

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

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

216
        return $ instrs'
217 218


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

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

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

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

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

241

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

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

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

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

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

264

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

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

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

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

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

287

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

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

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

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

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

310

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

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


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

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

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

336 337

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


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

354 355

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


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

368 369

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

375

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