Spill.hs 12.3 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 23 24
import Unique
import UniqFM
import UniqSet
import UniqSupply
import Outputable

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 43 44 45 46 47 48 49
        :: Instruction instr
        => [LiveCmmDecl statics instr]  -- ^ the code
        -> 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
50 51 52

regSpill code slotsFree regs

53 54 55 56 57
        -- 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))
58

59 60 61 62 63 64
        | 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
65

66 67
                -- grab the unique supply from the monad
                us      <- getUs
68

69 70 71 72
                -- run the spiller on all the blocks
                let (code', state')     =
                        runState (mapM (regSpill_top regSlotMap) code)
                                 (initSpillS us)
73

74 75 76
                return  ( code'
                        , minusUniqSet slotsFree (mkUniqSet slots)
                        , makeSpillStats state')
77 78


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

86 87
regSpill_top regSlotMap cmm
 = case cmm of
88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133
        CmmData{}
         -> return cmm

        CmmProc info label sccs
         |  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.
                sccs'           <- mapM (mapSCCM (regSpill_block regSlotMap)) sccs

                return  $ CmmProc info' label sccs'

 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'
134 135 136 137 138



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

144
regSpill_block regSlotMap (BasicBlock i instrs)
145 146
 = do   instrss'        <- mapM (regSpill_instr regSlotMap) instrs
        return  $ BasicBlock i (concat instrss')
147

148

149 150 151
-- | 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.
152
regSpill_instr
153 154 155 156
        :: Instruction instr
        => UniqFM Int           -- ^ map of vregs to slots they're being spilled to.
        -> LiveInstr instr
        -> SpillM [LiveInstr instr]
157

158
regSpill_instr _ li@(LiveInstr _ Nothing)
159
 = do   return [li]
160 161

regSpill_instr regSlotMap
162
        (LiveInstr instr (Just _))
163
 = do
164 165 166 167 168 169 170 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
        -- work out which regs are read and written in this instr
        let RU rlRead rlWritten = regUsageOfInstr instr

        -- 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 " ")
205
-}
206
                $ instrs'
207 208


209 210 211 212 213 214
spillRead
        :: Instruction instr
        => UniqFM Int
        -> instr
        -> Reg
        -> SpillM (instr, ([LiveInstr instr'], [LiveInstr instr']))
215
spillRead regSlotMap instr reg
216 217
        | Just slot     <- lookupUFM regSlotMap reg
        = do    (instr', nReg)  <- patchInstr reg instr
218

219 220
                modify $ \s -> s
                        { stateSpillSL  = addToUFM_C accSpillSL (stateSpillSL s) reg (reg, 0, 1) }
221

222 223 224
                return  ( instr'
                        , ( [LiveInstr (RELOAD slot nReg) Nothing]
                          , []) )
225

226
        | otherwise     = panic "RegSpill.spillRead: no slot defined for spilled reg"
227

228

229 230 231 232 233 234
spillWrite
        :: Instruction instr
        => UniqFM Int
        -> instr
        -> Reg
        -> SpillM (instr, ([LiveInstr instr'], [LiveInstr instr']))
235
spillWrite regSlotMap instr reg
236 237
        | Just slot     <- lookupUFM regSlotMap reg
        = do    (instr', nReg)  <- patchInstr reg instr
238

239 240
                modify $ \s -> s
                        { stateSpillSL  = addToUFM_C accSpillSL (stateSpillSL s) reg (reg, 1, 0) }
241

242 243 244
                return  ( instr'
                        , ( []
                          , [LiveInstr (SPILL nReg slot) Nothing]))
245

246
        | otherwise     = panic "RegSpill.spillWrite: no slot defined for spilled reg"
247

248

249 250 251 252 253 254
spillModify
        :: Instruction instr
        => UniqFM Int
        -> instr
        -> Reg
        -> SpillM (instr, ([LiveInstr instr'], [LiveInstr instr']))
255
spillModify regSlotMap instr reg
256 257
        | Just slot     <- lookupUFM regSlotMap reg
        = do    (instr', nReg)  <- patchInstr reg instr
258

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

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

266
        | otherwise     = panic "RegSpill.spillModify: no slot defined for spilled reg"
267 268


269

270
-- | Rewrite uses of this virtual reg in an instr to use a different virtual reg
271 272 273
patchInstr
        :: Instruction instr
        => Reg -> instr -> SpillM (instr, Reg)
274

275
patchInstr reg instr
276 277 278 279 280 281
 = 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)
282

283 284 285
patchReg1
        :: Instruction instr
        => Reg -> Reg -> instr -> instr
286

287
patchReg1 old new instr
288 289 290 291
 = let  patchF r
                | r == old      = new
                | otherwise     = r
   in   patchRegsOfInstr instr patchF
292 293


294
-- Spiller monad --------------------------------------------------------------
295
data SpillS
296 297 298 299 300 301
        = 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) }
302

303
initSpillS :: UniqSupply -> SpillS
304
initSpillS uniqueSupply
305 306 307
        = SpillS
        { stateUS       = uniqueSupply
        , stateSpillSL  = emptyUFM }
308

309
type SpillM a   = State SpillS a
310 311 312

newUnique :: SpillM Unique
newUnique
Ian Lynagh's avatar
Ian Lynagh committed
313
 = do   us      <- gets stateUS
314 315 316
        case takeUniqFromSupply us of
         (uniq, us')
          -> do modify $ \s -> s { stateUS = us' }
Ian Lynagh's avatar
Ian Lynagh committed
317
                return uniq
318

319
accSpillSL :: (Reg, Int, Int) -> (Reg, Int, Int) -> (Reg, Int, Int)
Ben.Lippmeier@anu.edu.au's avatar
Ben.Lippmeier@anu.edu.au committed
320
accSpillSL (r1, s1, l1) (_, s2, l2)
321
        = (r1, s1 + s2, l1 + l2)
322 323


324
-- Spiller stats --------------------------------------------------------------
325
data SpillStats
326 327
        = SpillStats
        { spillStoreLoad        :: UniqFM (Reg, Int, Int) }
328 329 330

makeSpillStats :: SpillS -> SpillStats
makeSpillStats s
331 332
        = SpillStats
        { spillStoreLoad        = stateSpillSL s }
333

334
instance Outputable SpillStats where
335
 ppr stats
336 337
        = (vcat $ map (\(r, s, l) -> ppr r <+> int s <+> int l)
                        $ eltsUFM (spillStoreLoad stats))
338