Spill.hs 12.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 10
)
where
11
import RegAlloc.Liveness
12 13
import Instruction
import Reg
14
import OldCmm hiding (RegSet)
15
import BlockId
16

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

import Data.List
26
import Data.Maybe
27 28 29 30
import Data.Map                 (Map)
import Data.Set                 (Set)
import qualified Data.Map       as Map
import qualified Data.Set       as Set
31 32


33
-- | Spill all these virtual regs to stack slots.
34
--
35 36
--   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.
37
--
38 39 40
--   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.
41 42
--
regSpill
43
        :: Instruction instr
44 45
        => Platform
        -> [LiveCmmDecl statics instr]  -- ^ the code
46 47 48 49 50 51
        -> UniqSet Int                  -- ^ available stack slots
        -> UniqSet VirtualReg           -- ^ the regs to spill
        -> UniqSM
                ([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 56 57 58 59
        -- not enough slots to spill these regs
        | 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 63 64 65 66
        | otherwise
        = do
                -- allocate a slot for each of the spilled regs
                let slots       = take (sizeUniqSet regs) $ uniqSetToList slotsFree
                let regSlotMap  = listToUFM
                                $ zip (uniqSetToList regs) slots
67

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

71 72
                -- run the spiller on all the blocks
                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 85
        => Platform
        -> RegMap Int                   -- ^ map of vregs to slots they're being spilled to.
86 87 88
        -> LiveCmmDecl statics instr    -- ^ the top level thing.
        -> SpillM (LiveCmmDecl statics instr)

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

94
        CmmProc info label live sccs
95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115
         |  LiveInfo static firstId mLiveVRegsOnEntry liveSlotsOnEntry <- info
         -> do
                -- 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.
                let liveVRegsOnEntry    = fromMaybe mapEmpty mLiveVRegsOnEntry

                -- 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.
                let liveSlotsOnEntry' :: Map BlockId (Set Int)
                    liveSlotsOnEntry'
                        = mapFoldWithKey patchLiveSlot liveSlotsOnEntry liveVRegsOnEntry

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

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

118
                return  $ CmmProc info' label live sccs'
119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136

 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)
        patchLiveSlot blockId regsLive slotMap
         = let  curSlotsLive    = fromMaybe Set.empty
                                $ Map.lookup blockId slotMap

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

                slotMap'        = Map.insert blockId (Set.union curSlotsLive moreSlotsLive) slotMap

           in   slotMap'
137 138 139 140 141



-- | Spill some registers to stack slots in a basic block.
regSpill_block
142
        :: Instruction instr
143 144
        => Platform
        -> UniqFM Int -- ^ map of vregs to slots they're being spilled to.
145 146 147
        -> LiveBasicBlock instr
        -> SpillM (LiveBasicBlock instr)

148 149
regSpill_block platform regSlotMap (BasicBlock i instrs)
 = do   instrss'        <- mapM (regSpill_instr platform regSlotMap) instrs
150
        return  $ BasicBlock i (concat instrss')
151

152

153 154 155
-- | 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.
156
regSpill_instr
157
        :: Instruction instr
158 159
        => Platform
        -> UniqFM Int -- ^ map of vregs to slots they're being spilled to.
160 161
        -> LiveInstr instr
        -> SpillM [LiveInstr instr]
162

163
regSpill_instr _ _ li@(LiveInstr _ Nothing)
164
 = do   return [li]
165

166
regSpill_instr platform regSlotMap
167
        (LiveInstr instr (Just _))
168
 = do
169
        -- work out which regs are read and written in this instr
170
        let RU rlRead rlWritten = regUsageOfInstr platform instr
171 172 173 174 175 176 177 178 179 180 181 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

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

        return
{-              $ pprTrace "* regSpill_instr spill"
                        (  text "instr  = " <> ppr instr
                        $$ text "read   = " <> ppr rsSpillRead
                        $$ text "write  = " <> ppr rsSpillWritten
                        $$ text "mod    = " <> ppr rsSpillModify
                        $$ text "-- out"
                        $$ (vcat $ map ppr instrs')
                        $$ text " ")
210
-}
211
                $ instrs'
212 213


214 215 216 217 218 219
spillRead
        :: Instruction instr
        => UniqFM Int
        -> instr
        -> Reg
        -> SpillM (instr, ([LiveInstr instr'], [LiveInstr instr']))
220
spillRead regSlotMap instr reg
221 222
        | Just slot     <- lookupUFM regSlotMap reg
        = do    (instr', nReg)  <- patchInstr reg instr
223

224 225
                modify $ \s -> s
                        { stateSpillSL  = addToUFM_C accSpillSL (stateSpillSL s) reg (reg, 0, 1) }
226

227 228 229
                return  ( instr'
                        , ( [LiveInstr (RELOAD slot nReg) Nothing]
                          , []) )
230

231
        | otherwise     = panic "RegSpill.spillRead: no slot defined for spilled reg"
232

233

234 235 236 237 238 239
spillWrite
        :: Instruction instr
        => UniqFM Int
        -> instr
        -> Reg
        -> SpillM (instr, ([LiveInstr instr'], [LiveInstr instr']))
240
spillWrite regSlotMap instr reg
241 242
        | Just slot     <- lookupUFM regSlotMap reg
        = do    (instr', nReg)  <- patchInstr reg instr
243

244 245
                modify $ \s -> s
                        { stateSpillSL  = addToUFM_C accSpillSL (stateSpillSL s) reg (reg, 1, 0) }
246

247 248 249
                return  ( instr'
                        , ( []
                          , [LiveInstr (SPILL nReg slot) Nothing]))
250

251
        | otherwise     = panic "RegSpill.spillWrite: no slot defined for spilled reg"
252

253

254 255 256 257 258 259
spillModify
        :: Instruction instr
        => UniqFM Int
        -> instr
        -> Reg
        -> SpillM (instr, ([LiveInstr instr'], [LiveInstr instr']))
260
spillModify regSlotMap instr reg
261 262
        | Just slot     <- lookupUFM regSlotMap reg
        = do    (instr', nReg)  <- patchInstr reg instr
263

264 265
                modify $ \s -> s
                        { stateSpillSL  = addToUFM_C accSpillSL (stateSpillSL s) reg (reg, 1, 1) }
266

267 268 269
                return  ( instr'
                        , ( [LiveInstr (RELOAD slot nReg) Nothing]
                          , [LiveInstr (SPILL nReg slot) Nothing]))
270

271
        | otherwise     = panic "RegSpill.spillModify: no slot defined for spilled reg"
272 273


274

275
-- | Rewrite uses of this virtual reg in an instr to use a different virtual reg
276 277 278
patchInstr
        :: Instruction instr
        => Reg -> instr -> SpillM (instr, Reg)
279

280
patchInstr reg instr
281 282 283 284 285 286
 = do   nUnique         <- newUnique
        let nReg        = case reg of
                                RegVirtual vr   -> RegVirtual (renameVirtualReg nUnique vr)
                                RegReal{}       -> panic "RegAlloc.Graph.Spill.patchIntr: not patching real reg"
        let instr'      = patchReg1 reg nReg instr
        return          (instr', nReg)
287

288 289 290
patchReg1
        :: Instruction instr
        => Reg -> Reg -> instr -> instr
291

292
patchReg1 old new instr
293 294 295 296
 = let  patchF r
                | r == old      = new
                | otherwise     = r
   in   patchRegsOfInstr instr patchF
297 298


299
-- Spiller monad --------------------------------------------------------------
300
data SpillS
301 302 303 304 305 306
        = SpillS
        { -- | unique supply for generating fresh vregs.
          stateUS       :: UniqSupply

          -- | spilled vreg vs the number of times it was loaded, stored
        , stateSpillSL  :: UniqFM (Reg, Int, Int) }
307

308
initSpillS :: UniqSupply -> SpillS
309
initSpillS uniqueSupply
310 311 312
        = SpillS
        { stateUS       = uniqueSupply
        , stateSpillSL  = emptyUFM }
313

314
type SpillM a   = State SpillS a
315 316 317

newUnique :: SpillM Unique
newUnique
Ian Lynagh's avatar
Ian Lynagh committed
318
 = do   us      <- gets stateUS
319 320 321
        case takeUniqFromSupply us of
         (uniq, us')
          -> do modify $ \s -> s { stateUS = us' }
Ian Lynagh's avatar
Ian Lynagh committed
322
                return uniq
323

324
accSpillSL :: (Reg, Int, Int) -> (Reg, Int, Int) -> (Reg, Int, Int)
Ben.Lippmeier@anu.edu.au's avatar
Ben.Lippmeier@anu.edu.au committed
325
accSpillSL (r1, s1, l1) (_, s2, l2)
326
        = (r1, s1 + s2, l1 + l2)
327 328


329
-- Spiller stats --------------------------------------------------------------
330
data SpillStats
331 332
        = SpillStats
        { spillStoreLoad        :: UniqFM (Reg, Int, Int) }
333 334 335

makeSpillStats :: SpillS -> SpillStats
makeSpillStats s
336 337
        = SpillStats
        { spillStoreLoad        = stateSpillSL s }
338

339
instance Outputable SpillStats where
340
 ppr stats
341 342
        = (vcat $ map (\(r, s, l) -> ppr r <+> int s <+> int l)
                        $ eltsUFM (spillStoreLoad stats))
343