Spill.hs 12.9 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 State
17 18 19 20 21
import Unique
import UniqFM
import UniqSet
import UniqSupply
import Outputable
22
import Platform
23 24

import Data.List
25
import Data.Maybe
26 27 28 29
import Data.Map                 (Map)
import Data.Set                 (Set)
import qualified Data.Map       as Map
import qualified Data.Set       as Set
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 49 50 51
            ([LiveCmmDecl statics instr] 
                 -- 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.
64 65 66
                let slots       = take (sizeUniqSet regs) $ uniqSetToList slotsFree
                let regSlotMap  = listToUFM
                                $ zip (uniqSetToList regs) slots
67

68
                -- Grab the unique supply from the monad.
69
                us      <- getUs
70

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

76 77 78
                return  ( code'
                        , minusUniqSet slotsFree (mkUniqSet slots)
                        , makeSpillStats state')
79 80


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

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

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

103 104 105 106 107 108
                -- 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.
109 110
                let liveSlotsOnEntry' :: Map BlockId (Set Int)
                    liveSlotsOnEntry'
111 112
                        = mapFoldWithKey patchLiveSlot 
                                         liveSlotsOnEntry liveVRegsOnEntry
113 114 115 116 117 118 119

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

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

122
                return  $ CmmProc info' label live sccs'
123

124 125 126 127 128 129 130 131
 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.
        patchLiveSlot 
                :: BlockId -> RegSet 
                -> Map BlockId (Set Int) -> Map BlockId (Set Int)

132
        patchLiveSlot blockId regsLive slotMap
133 134 135
         = let  
                -- Slots that are already recorded as being live.
                curSlotsLive    = fromMaybe Set.empty
136 137 138 139 140 141 142
                                $ Map.lookup blockId slotMap

                moreSlotsLive   = Set.fromList
                                $ catMaybes
                                $ map (lookupUFM regSlotMap)
                                $ uniqSetToList regsLive

143 144 145
                slotMap'
                 = Map.insert blockId (Set.union curSlotsLive moreSlotsLive) 
                              slotMap
146 147

           in   slotMap'
148 149 150 151


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

158 159
regSpill_block platform regSlotMap (BasicBlock i instrs)
 = do   instrss'        <- mapM (regSpill_instr platform regSlotMap) instrs
160
        return  $ BasicBlock i (concat instrss')
161

162

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

174
regSpill_instr _ _ li@(LiveInstr _ Nothing)
175
 = do   return [li]
176

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

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

212
        return $ instrs'
213 214


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

224
spillRead regSlotMap instr reg
225 226
 | Just slot     <- lookupUFM regSlotMap reg
 = do    (instr', nReg)  <- patchInstr reg instr
227

228 229
         modify $ \s -> s
                { stateSpillSL  = addToUFM_C accSpillSL (stateSpillSL s) reg (reg, 0, 1) }
230

231 232 233
         return  ( instr'
                 , ( [LiveInstr (RELOAD slot nReg) Nothing]
                 , []) )
234

235
 | otherwise     = panic "RegSpill.spillRead: no slot defined for spilled reg"
236

237

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

247
spillWrite regSlotMap instr reg
248 249
 | Just slot     <- lookupUFM regSlotMap reg
 = do    (instr', nReg)  <- patchInstr reg instr
250

251 252
         modify $ \s -> s
                { stateSpillSL  = addToUFM_C accSpillSL (stateSpillSL s) reg (reg, 1, 0) }
253

254 255 256
         return  ( instr'
                 , ( []
                   , [LiveInstr (SPILL nReg slot) Nothing]))
257

258
 | otherwise     = panic "RegSpill.spillWrite: no slot defined for spilled reg"
259

260

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

270 271 272
spillModify regSlotMap instr reg
 | Just slot     <- lookupUFM regSlotMap reg
 = do    (instr', nReg)  <- patchInstr reg instr
273

274 275
         modify $ \s -> s
                { stateSpillSL  = addToUFM_C accSpillSL (stateSpillSL s) reg (reg, 1, 1) }
276

277 278 279
         return  ( instr'
                 , ( [LiveInstr (RELOAD slot nReg) Nothing]
                   , [LiveInstr (SPILL nReg slot) Nothing]))
280

281
 | otherwise     = panic "RegSpill.spillModify: no slot defined for spilled reg"
282

283

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

290
patchInstr reg instr
291
 = do   nUnique         <- newUnique
292 293 294 295 296 297 298 299 300 301 302

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

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

303 304
        let instr'      = patchReg1 reg nReg instr
        return          (instr', nReg)
305

306

307 308 309
patchReg1
        :: Instruction instr
        => Reg -> Reg -> instr -> instr
310

311
patchReg1 old new instr
312 313 314 315
 = let  patchF r
                | r == old      = new
                | otherwise     = r
   in   patchRegsOfInstr instr patchF
316 317


318
-- Spiller monad --------------------------------------------------------------
319 320 321 322 323
-- | State monad for the spill code generator.
type SpillM a
        = State SpillS a

-- | Spill code generator state.
324
data SpillS
325
        = SpillS
326
        { -- | Unique supply for generating fresh vregs.
327 328
          stateUS       :: UniqSupply

329
          -- | Spilled vreg vs the number of times it was loaded, stored.
330
        , stateSpillSL  :: UniqFM (Reg, Int, Int) }
331

332 333

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


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

350 351

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


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

364 365

-- | Extract spiller statistics from the spiller state.
366 367
makeSpillStats :: SpillS -> SpillStats
makeSpillStats s
368 369
        = SpillStats
        { spillStoreLoad        = stateSpillSL s }
370

371

372
instance Outputable SpillStats where
373
 ppr stats
374 375
        = (vcat $ map (\(r, s, l) -> ppr r <+> int s <+> int l)
                        $ eltsUFM (spillStoreLoad stats))
376