compiler/nativeGen/RegAlloc/Graph/Spill.hs

   1
   2 {-# OPTIONS -fno-warn-missing-signatures #-}
   3
   4 module RegAlloc.Graph.Spill (
   5         regSpill,
   6         SpillStats(..),
   7         accSpillSL
   8 )
   9
  10 where
  11
  12 import RegAlloc.Liveness
  13 import Instruction
  14 import Reg
  15 import Cmm
  16
  17 import State
  18 import Unique
  19 import UniqFM
  20 import UniqSet
  21 import UniqSupply
  22 import Outputable
  23
  24 import Data.List
  25
  26
  27 -- | Spill all these virtual regs to memory
  28 --      TODO:   see if we can split some of the live ranges instead of just globally
  29 --              spilling the virtual reg.
  30 --
  31 --      TODO:   On ciscy x86 and x86_64 we don't nessesarally have to add a mov instruction
  32 --              when making spills. If an instr is using a spilled virtual we may be able to
  33 --              address the spill slot directly.
  34 --
  35 regSpill
  36         :: Instruction instr
  37         => [LiveCmmTop instr]           -- ^ the code
  38         -> UniqSet Int                  -- ^ available stack slots
  39         -> UniqSet VirtualReg           -- ^ the regs to spill
  40         -> UniqSM
  41                 ([LiveCmmTop instr]     -- code will spill instructions
  42                 , UniqSet Int           -- left over slots
  43                 , SpillStats )          -- stats about what happened during spilling
  44
  45 regSpill code slotsFree regs
  46
  47         -- not enough slots to spill these regs
  48         | sizeUniqSet slotsFree < sizeUniqSet regs
  49         = pprPanic "regSpill: out of spill slots!"
  50                 (  text "   regs to spill = " <> ppr (sizeUniqSet regs)
  51                 $$ text "   slots left    = " <> ppr (sizeUniqSet slotsFree))
  52
  53         | otherwise
  54         = do
  55                 -- allocate a slot for each of the spilled regs
  56                 let slots       = take (sizeUniqSet regs) $ uniqSetToList slotsFree
  57                 let regSlotMap  = listToUFM
  58                                 $ zip (uniqSetToList regs) slots
  59
  60                 -- grab the unique supply from the monad
  61                 us      <- getUs
  62
  63                 -- run the spiller on all the blocks
  64                 let (code', state')     =
  65                         runState (mapM (mapBlockTopM (regSpill_block regSlotMap)) code)
  66                                  (initSpillS us)
  67
  68                 return  ( code'
  69                         , minusUniqSet slotsFree (mkUniqSet slots)
  70                         , makeSpillStats state')
  71
  72
  73 regSpill_block regSlotMap (BasicBlock i instrs)
  74  = do   instrss'        <- mapM (regSpill_instr regSlotMap) instrs
  75         return  $ BasicBlock i (concat instrss')
  76
  77
  78 regSpill_instr
  79         :: Instruction instr
  80         => UniqFM Int
  81         -> LiveInstr instr -> SpillM [LiveInstr instr]
  82
  83 regSpill_instr _ li@(LiveInstr _ Nothing)
  84  = do   return [li]
  85
  86 regSpill_instr regSlotMap
  87         (LiveInstr instr (Just _))
  88  = do
  89         -- work out which regs are read and written in this instr
  90         let RU rlRead rlWritten = regUsageOfInstr instr
  91
  92         -- sometimes a register is listed as being read more than once,
  93         --      nub this so we don't end up inserting two lots of spill code.
  94         let rsRead_             = nub rlRead
  95         let rsWritten_          = nub rlWritten
  96
  97         -- if a reg is modified, it appears in both lists, want to undo this..
  98         let rsRead              = rsRead_    \\ rsWritten_
  99         let rsWritten           = rsWritten_ \\ rsRead_
 100         let rsModify            = intersect rsRead_ rsWritten_
 101
 102         -- work out if any of the regs being used are currently being spilled.
 103         let rsSpillRead         = filter (\r -> elemUFM r regSlotMap) rsRead
 104         let rsSpillWritten      = filter (\r -> elemUFM r regSlotMap) rsWritten
 105         let rsSpillModify       = filter (\r -> elemUFM r regSlotMap) rsModify
 106
 107         -- rewrite the instr and work out spill code.
 108         (instr1, prepost1)      <- mapAccumLM (spillRead   regSlotMap) instr  rsSpillRead
 109         (instr2, prepost2)      <- mapAccumLM (spillWrite  regSlotMap) instr1 rsSpillWritten
 110         (instr3, prepost3)      <- mapAccumLM (spillModify regSlotMap) instr2 rsSpillModify
 111
 112         let (mPrefixes, mPostfixes)     = unzip (prepost1 ++ prepost2 ++ prepost3)
 113         let prefixes                    = concat mPrefixes
 114         let postfixes                   = concat mPostfixes
 115
 116         -- final code
 117         let instrs'     =  prefixes
 118                         ++ [LiveInstr instr3 Nothing]
 119                         ++ postfixes
 120
 121         return
 122 {-              $ pprTrace "* regSpill_instr spill"
 123                         (  text "instr  = " <> ppr instr
 124                         $$ text "read   = " <> ppr rsSpillRead
 125                         $$ text "write  = " <> ppr rsSpillWritten
 126                         $$ text "mod    = " <> ppr rsSpillModify
 127                         $$ text "-- out"
 128                         $$ (vcat $ map ppr instrs')
 129                         $$ text " ")
 130 -}
 131                 $ instrs'
 132
 133
 134 spillRead regSlotMap instr reg
 135         | Just slot     <- lookupUFM regSlotMap reg
 136         = do    (instr', nReg)  <- patchInstr reg instr
 137
 138                 modify $ \s -> s
 139                         { stateSpillSL  = addToUFM_C accSpillSL (stateSpillSL s) reg (reg, 0, 1) }
 140
 141                 return  ( instr'
 142                         , ( [LiveInstr (RELOAD slot nReg) Nothing]
 143                           , []) )
 144
 145         | otherwise     = panic "RegSpill.spillRead: no slot defined for spilled reg"
 146
 147
 148 spillWrite regSlotMap instr reg
 149         | Just slot     <- lookupUFM regSlotMap reg
 150         = do    (instr', nReg)  <- patchInstr reg instr
 151
 152                 modify $ \s -> s
 153                         { stateSpillSL  = addToUFM_C accSpillSL (stateSpillSL s) reg (reg, 1, 0) }
 154
 155                 return  ( instr'
 156                         , ( []
 157                           , [LiveInstr (SPILL nReg slot) Nothing]))
 158
 159         | otherwise     = panic "RegSpill.spillWrite: no slot defined for spilled reg"
 160
 161
 162 spillModify regSlotMap instr reg
 163         | Just slot     <- lookupUFM regSlotMap reg
 164         = do    (instr', nReg)  <- patchInstr reg instr
 165
 166                 modify $ \s -> s
 167                         { stateSpillSL  = addToUFM_C accSpillSL (stateSpillSL s) reg (reg, 1, 1) }
 168
 169                 return  ( instr'
 170                         , ( [LiveInstr (RELOAD slot nReg) Nothing]
 171                           , [LiveInstr (SPILL nReg slot) Nothing]))
 172
 173         | otherwise     = panic "RegSpill.spillModify: no slot defined for spilled reg"
 174
 175
 176
 177 -- | rewrite uses of this virtual reg in an instr to use a different virtual reg
 178 patchInstr
 179         :: Instruction instr
 180         => Reg -> instr -> SpillM (instr, Reg)
 181
 182 patchInstr reg instr
 183  = do   nUnique         <- newUnique
 184         let nReg        = case reg of
 185                                 RegVirtual vr   -> RegVirtual (renameVirtualReg nUnique vr)
 186                                 RegReal{}       -> panic "RegAlloc.Graph.Spill.patchIntr: not patching real reg"
 187         let instr'      = patchReg1 reg nReg instr
 188         return          (instr', nReg)
 189
 190 patchReg1
 191         :: Instruction instr
 192         => Reg -> Reg -> instr -> instr
 193
 194 patchReg1 old new instr
 195  = let  patchF r
 196                 | r == old      = new
 197                 | otherwise     = r
 198    in   patchRegsOfInstr instr patchF
 199
 200
 201 ------------------------------------------------------
 202 -- Spiller monad
 203
 204 data SpillS
 205         = SpillS
 206         { stateUS       :: UniqSupply
 207         , stateSpillSL  :: UniqFM (Reg, Int, Int) } -- ^ spilled reg vs number of times vreg was loaded, stored
 208
 209 initSpillS uniqueSupply
 210         = SpillS
 211         { stateUS       = uniqueSupply
 212         , stateSpillSL  = emptyUFM }
 213
 214 type SpillM a   = State SpillS a
 215
 216 newUnique :: SpillM Unique
 217 newUnique
 218  = do   us      <- gets stateUS
 219         case splitUniqSupply us of
 220          (us1, us2)
 221           -> do let uniq = uniqFromSupply us1
 222                 modify $ \s -> s { stateUS = us2 }
 223                 return uniq
 224
 225 accSpillSL (r1, s1, l1) (_, s2, l2)
 226         = (r1, s1 + s2, l1 + l2)
 227
 228
 229 ----------------------------------------------------
 230 -- Spiller stats
 231
 232 data SpillStats
 233         = SpillStats
 234         { spillStoreLoad        :: UniqFM (Reg, Int, Int) }
 235
 236 makeSpillStats :: SpillS -> SpillStats
 237 makeSpillStats s
 238         = SpillStats
 239         { spillStoreLoad        = stateSpillSL s }
 240
 241 instance Outputable SpillStats where
 242  ppr stats
 243         = (vcat $ map (\(r, s, l) -> ppr r <+> int s <+> int l)
 244                         $ eltsUFM (spillStoreLoad stats))
 245