compiler/nativeGen/RegAlloc/Graph/Spill.hs

   1 {-# OPTIONS -fno-warn-missing-signatures #-}
   2
   3 -- | When there aren't enough registers to hold all the vregs we have to spill some of those
   4 --   vregs to slots on the stack. This module is used modify the code to use those slots.
   5 --
   6 module RegAlloc.Graph.Spill (
   7         regSpill,
   8         SpillStats(..),
   9         accSpillSL
  10 )
  11 where
  12 import RegAlloc.Liveness
  13 import Instruction
  14 import Reg
  15 import OldCmm hiding (RegSet)
  16 import BlockId
  17
  18 import State
  19 import Unique
  20 import UniqFM
  21 import UniqSet
  22 import UniqSupply
  23 import Outputable
  24
  25 import Data.List
  26 import Data.Maybe
  27 import Data.Map                 (Map)
  28 import Data.Set                 (Set)
  29 import qualified Data.Map       as Map
  30 import qualified Data.Set       as Set
  31
  32
  33 -- | Spill all these virtual regs to stack slots.
  34 --
  35 --   TODO: See if we can split some of the live ranges instead of just globally
  36 --         spilling the virtual reg. This might make the spill cleaner's job easier.
  37 --
  38 --   TODO: On CISCy x86 and x86_64 we don't nessesarally have to add a mov instruction
  39 --         when making spills. If an instr is using a spilled virtual we may be able to
  40 --         address the spill slot directly.
  41 --
  42 regSpill
  43         :: Instruction instr
  44         => [LiveCmmTop instr]           -- ^ the code
  45         -> UniqSet Int                  -- ^ available stack slots
  46         -> UniqSet VirtualReg           -- ^ the regs to spill
  47         -> UniqSM
  48                 ([LiveCmmTop instr]     -- code with SPILL and RELOAD meta instructions added.
  49                 , UniqSet Int           -- left over slots
  50                 , SpillStats )          -- stats about what happened during spilling
  51
  52 regSpill code slotsFree regs
  53
  54         -- not enough slots to spill these regs
  55         | sizeUniqSet slotsFree < sizeUniqSet regs
  56         = pprPanic "regSpill: out of spill slots!"
  57                 (  text "   regs to spill = " <> ppr (sizeUniqSet regs)
  58                 $$ text "   slots left    = " <> ppr (sizeUniqSet slotsFree))
  59
  60         | otherwise
  61         = do
  62                 -- allocate a slot for each of the spilled regs
  63                 let slots       = take (sizeUniqSet regs) $ uniqSetToList slotsFree
  64                 let regSlotMap  = listToUFM
  65                                 $ zip (uniqSetToList regs) slots
  66
  67                 -- grab the unique supply from the monad
  68                 us      <- getUs
  69
  70                 -- run the spiller on all the blocks
  71                 let (code', state')     =
  72                         runState (mapM (regSpill_top regSlotMap) code)
  73                                  (initSpillS us)
  74
  75                 return  ( code'
  76                         , minusUniqSet slotsFree (mkUniqSet slots)
  77                         , makeSpillStats state')
  78
  79
  80 -- | Spill some registers to stack slots in a top-level thing.
  81 regSpill_top
  82         :: Instruction instr
  83         => RegMap Int                   -- ^ map of vregs to slots they're being spilled to.
  84         -> LiveCmmTop instr             -- ^ the top level thing.
  85         -> SpillM (LiveCmmTop instr)
  86
  87 regSpill_top regSlotMap cmm
  88  = case cmm of
  89         CmmData{}
  90          -> return cmm
  91
  92         CmmProc info label sccs
  93          |  LiveInfo static firstId mLiveVRegsOnEntry liveSlotsOnEntry <- info
  94          -> do
  95                 -- We should only passed Cmms with the liveness maps filled in,  but we'll
  96                 -- create empty ones if they're not there just in case.
  97                 let liveVRegsOnEntry    = fromMaybe mapEmpty mLiveVRegsOnEntry
  98
  99                 -- The liveVRegsOnEntry contains the set of vregs that are live on entry to
 100                 -- each basic block. If we spill one of those vregs we remove it from that
 101                 -- set and add the corresponding slot number to the liveSlotsOnEntry set.
 102                 -- The spill cleaner needs this information to erase unneeded spill and
 103                 -- reload instructions after we've done a successful allocation.
 104                 let liveSlotsOnEntry' :: Map BlockId (Set Int)
 105                     liveSlotsOnEntry'
 106                         = mapFoldWithKey patchLiveSlot liveSlotsOnEntry liveVRegsOnEntry
 107
 108                 let info'
 109                         = LiveInfo static firstId
 110                                 (Just liveVRegsOnEntry)
 111                                 liveSlotsOnEntry'
 112
 113                 -- Apply the spiller to all the basic blocks in the CmmProc.
 114                 sccs'           <- mapM (mapSCCM (regSpill_block regSlotMap)) sccs
 115
 116                 return  $ CmmProc info' label sccs'
 117
 118  where  -- | Given a BlockId and the set of registers live in it,
 119         --   if registers in this block are being spilled to stack slots,
 120         --   then record the fact that these slots are now live in those blocks
 121         --   in the given slotmap.
 122         patchLiveSlot :: BlockId -> RegSet -> Map BlockId (Set Int) -> Map BlockId (Set Int)
 123         patchLiveSlot blockId regsLive slotMap
 124          = let  curSlotsLive    = fromMaybe Set.empty
 125                                 $ Map.lookup blockId slotMap
 126
 127                 moreSlotsLive   = Set.fromList
 128                                 $ catMaybes
 129                                 $ map (lookupUFM regSlotMap)
 130                                 $ uniqSetToList regsLive
 131
 132                 slotMap'        = Map.insert blockId (Set.union curSlotsLive moreSlotsLive) slotMap
 133
 134            in   slotMap'
 135
 136
 137
 138 -- | Spill some registers to stack slots in a basic block.
 139 regSpill_block
 140         :: Instruction instr
 141         => UniqFM Int           -- ^ map of vregs to slots they're being spilled to.
 142         -> LiveBasicBlock instr
 143         -> SpillM (LiveBasicBlock instr)
 144
 145 regSpill_block regSlotMap (BasicBlock i instrs)
 146  = do   instrss'        <- mapM (regSpill_instr regSlotMap) instrs
 147         return  $ BasicBlock i (concat instrss')
 148
 149
 150 -- | Spill some registers to stack slots in a single instruction.  If the instruction
 151 --   uses registers that need to be spilled, then it is prefixed (or postfixed) with
 152 --   the appropriate RELOAD or SPILL meta instructions.
 153 regSpill_instr
 154         :: Instruction instr
 155         => UniqFM Int           -- ^ map of vregs to slots they're being spilled to.
 156         -> LiveInstr instr
 157         -> SpillM [LiveInstr instr]
 158
 159 regSpill_instr _ li@(LiveInstr _ Nothing)
 160  = do   return [li]
 161
 162 regSpill_instr regSlotMap
 163         (LiveInstr instr (Just _))
 164  = do
 165         -- work out which regs are read and written in this instr
 166         let RU rlRead rlWritten = regUsageOfInstr instr
 167
 168         -- sometimes a register is listed as being read more than once,
 169         --      nub this so we don't end up inserting two lots of spill code.
 170         let rsRead_             = nub rlRead
 171         let rsWritten_          = nub rlWritten
 172
 173         -- if a reg is modified, it appears in both lists, want to undo this..
 174         let rsRead              = rsRead_    \\ rsWritten_
 175         let rsWritten           = rsWritten_ \\ rsRead_
 176         let rsModify            = intersect rsRead_ rsWritten_
 177
 178         -- work out if any of the regs being used are currently being spilled.
 179         let rsSpillRead         = filter (\r -> elemUFM r regSlotMap) rsRead
 180         let rsSpillWritten      = filter (\r -> elemUFM r regSlotMap) rsWritten
 181         let rsSpillModify       = filter (\r -> elemUFM r regSlotMap) rsModify
 182
 183         -- rewrite the instr and work out spill code.
 184         (instr1, prepost1)      <- mapAccumLM (spillRead   regSlotMap) instr  rsSpillRead
 185         (instr2, prepost2)      <- mapAccumLM (spillWrite  regSlotMap) instr1 rsSpillWritten
 186         (instr3, prepost3)      <- mapAccumLM (spillModify regSlotMap) instr2 rsSpillModify
 187
 188         let (mPrefixes, mPostfixes)     = unzip (prepost1 ++ prepost2 ++ prepost3)
 189         let prefixes                    = concat mPrefixes
 190         let postfixes                   = concat mPostfixes
 191
 192         -- final code
 193         let instrs'     =  prefixes
 194                         ++ [LiveInstr instr3 Nothing]
 195                         ++ postfixes
 196
 197         return
 198 {-              $ pprTrace "* regSpill_instr spill"
 199                         (  text "instr  = " <> ppr instr
 200                         $$ text "read   = " <> ppr rsSpillRead
 201                         $$ text "write  = " <> ppr rsSpillWritten
 202                         $$ text "mod    = " <> ppr rsSpillModify
 203                         $$ text "-- out"
 204                         $$ (vcat $ map ppr instrs')
 205                         $$ text " ")
 206 -}
 207                 $ instrs'
 208
 209
 210 spillRead regSlotMap instr reg
 211         | Just slot     <- lookupUFM regSlotMap reg
 212         = do    (instr', nReg)  <- patchInstr reg instr
 213
 214                 modify $ \s -> s
 215                         { stateSpillSL  = addToUFM_C accSpillSL (stateSpillSL s) reg (reg, 0, 1) }
 216
 217                 return  ( instr'
 218                         , ( [LiveInstr (RELOAD slot nReg) Nothing]
 219                           , []) )
 220
 221         | otherwise     = panic "RegSpill.spillRead: no slot defined for spilled reg"
 222
 223
 224 spillWrite regSlotMap instr reg
 225         | Just slot     <- lookupUFM regSlotMap reg
 226         = do    (instr', nReg)  <- patchInstr reg instr
 227
 228                 modify $ \s -> s
 229                         { stateSpillSL  = addToUFM_C accSpillSL (stateSpillSL s) reg (reg, 1, 0) }
 230
 231                 return  ( instr'
 232                         , ( []
 233                           , [LiveInstr (SPILL nReg slot) Nothing]))
 234
 235         | otherwise     = panic "RegSpill.spillWrite: no slot defined for spilled reg"
 236
 237
 238 spillModify regSlotMap instr reg
 239         | Just slot     <- lookupUFM regSlotMap reg
 240         = do    (instr', nReg)  <- patchInstr reg instr
 241
 242                 modify $ \s -> s
 243                         { stateSpillSL  = addToUFM_C accSpillSL (stateSpillSL s) reg (reg, 1, 1) }
 244
 245                 return  ( instr'
 246                         , ( [LiveInstr (RELOAD slot nReg) Nothing]
 247                           , [LiveInstr (SPILL nReg slot) Nothing]))
 248
 249         | otherwise     = panic "RegSpill.spillModify: no slot defined for spilled reg"
 250
 251
 252
 253 -- | Rewrite uses of this virtual reg in an instr to use a different virtual reg
 254 patchInstr
 255         :: Instruction instr
 256         => Reg -> instr -> SpillM (instr, Reg)
 257
 258 patchInstr reg instr
 259  = do   nUnique         <- newUnique
 260         let nReg        = case reg of
 261                                 RegVirtual vr   -> RegVirtual (renameVirtualReg nUnique vr)
 262                                 RegReal{}       -> panic "RegAlloc.Graph.Spill.patchIntr: not patching real reg"
 263         let instr'      = patchReg1 reg nReg instr
 264         return          (instr', nReg)
 265
 266 patchReg1
 267         :: Instruction instr
 268         => Reg -> Reg -> instr -> instr
 269
 270 patchReg1 old new instr
 271  = let  patchF r
 272                 | r == old      = new
 273                 | otherwise     = r
 274    in   patchRegsOfInstr instr patchF
 275
 276
 277 -- Spiller monad --------------------------------------------------------------
 278 data SpillS
 279         = SpillS
 280         { -- | unique supply for generating fresh vregs.
 281           stateUS       :: UniqSupply
 282
 283           -- | spilled vreg vs the number of times it was loaded, stored
 284         , stateSpillSL  :: UniqFM (Reg, Int, Int) }
 285
 286 initSpillS uniqueSupply
 287         = SpillS
 288         { stateUS       = uniqueSupply
 289         , stateSpillSL  = emptyUFM }
 290
 291 type SpillM a   = State SpillS a
 292
 293 newUnique :: SpillM Unique
 294 newUnique
 295  = do   us      <- gets stateUS
 296         case takeUniqFromSupply us of
 297          (uniq, us')
 298           -> do modify $ \s -> s { stateUS = us' }
 299                 return uniq
 300
 301 accSpillSL (r1, s1, l1) (_, s2, l2)
 302         = (r1, s1 + s2, l1 + l2)
 303
 304
 305 -- Spiller stats --------------------------------------------------------------
 306 data SpillStats
 307         = SpillStats
 308         { spillStoreLoad        :: UniqFM (Reg, Int, Int) }
 309
 310 makeSpillStats :: SpillS -> SpillStats
 311 makeSpillStats s
 312         = SpillStats
 313         { spillStoreLoad        = stateSpillSL s }
 314
 315 instance Outputable SpillStats where
 316  ppr stats
 317         = (vcat $ map (\(r, s, l) -> ppr r <+> int s <+> int l)
 318                         $ eltsUFM (spillStoreLoad stats))
 319