compiler/nativeGen/RegSpill.hs

   1
   2 module RegSpill (
   3         regSpill,
   4         SpillStats(..)
   5 )
   6
   7 where
   8
   9 #include "HsVersions.h"
  10
  11 import RegLiveness
  12 import RegAllocInfo
  13 import MachRegs
  14 import MachInstrs
  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 import Data.Maybe
  26
  27
  28 -- | Spill all these virtual regs to memory
  29 --      TODO:   see if we can split some of the live ranges instead of just globally
  30 --              spilling the virtual reg.
  31 --
  32 --      TODO:   On ciscy x86 and x86_64 we don't nessesarally have to add a mov instruction
  33 --              when making spills. If an instr is using a spilled virtual we may be able to
  34 --              address the spill slot directly.
  35 --
  36 regSpill
  37         :: [LiveCmmTop]                 -- ^ the code
  38         -> UniqSet Int                  -- ^ available stack slots
  39         -> UniqSet Reg                  -- ^ the regs to spill
  40         -> UniqSM
  41                 ([LiveCmmTop]           -- 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 _        li@(Instr (DELTA delta) _)
  79  = do
  80         setDelta delta
  81         return [li]
  82
  83 regSpill_instr _        li@(Instr _ Nothing)
  84  = do   return [li]
  85
  86
  87 regSpill_instr regSlotMap
  88         (Instr instr (Just live))
  89  = do
  90         -- work out which regs are read and written in this instr
  91         let RU rlRead rlWritten = regUsage instr
  92
  93         -- sometimes a register is listed as being read more than once,
  94         --      nub this so we don't end up inserting two lots of spill code.
  95         let rsRead_             = nub rlRead
  96         let rsWritten_          = nub rlWritten
  97
  98         -- if a reg is modified, it appears in both lists, want to undo this..
  99         let rsRead              = rsRead_    \\ rsWritten_
 100         let rsWritten           = rsWritten_ \\ rsRead_
 101         let rsModify            = intersect rsRead_ rsWritten_
 102
 103         -- work out if any of the regs being used are currently being spilled.
 104         let rsSpillRead         = filter (\r -> elemUFM r regSlotMap) rsRead
 105         let rsSpillWritten      = filter (\r -> elemUFM r regSlotMap) rsWritten
 106         let rsSpillModify       = filter (\r -> elemUFM r regSlotMap) rsModify
 107
 108         -- rewrite the instr and work out spill code.
 109         (instr1, prepost1)      <- mapAccumLM (spillRead   regSlotMap) instr  rsSpillRead
 110         (instr2, prepost2)      <- mapAccumLM (spillWrite  regSlotMap) instr1 rsSpillWritten
 111         (instr3, prepost3)      <- mapAccumLM (spillModify regSlotMap) instr2 rsSpillModify
 112
 113         let (mPrefixes, mPostfixes)     = unzip (prepost1 ++ prepost2 ++ prepost3)
 114         let prefixes                    = concat mPrefixes
 115         let postfixes                   = concat mPostfixes
 116
 117         -- final code
 118         let instrs'     =  map (\i -> Instr i Nothing) prefixes
 119                         ++ [ Instr instr3 Nothing ]
 120                         ++ map (\i -> Instr i Nothing) postfixes
 121
 122         return
 123 {-              $ pprTrace "* regSpill_instr spill"
 124                         (  text "instr  = " <> ppr instr
 125                         $$ text "read   = " <> ppr rsSpillRead
 126                         $$ text "write  = " <> ppr rsSpillWritten
 127                         $$ text "mod    = " <> ppr rsSpillModify
 128                         $$ text "-- out"
 129                         $$ (vcat $ map ppr instrs')
 130                         $$ text " ")
 131 -}
 132                 $ instrs'
 133
 134
 135 spillRead regSlotMap instr reg
 136         | Just slot     <- lookupUFM regSlotMap reg
 137         = do    delta           <- getDelta
 138                 (instr', nReg)  <- patchInstr reg instr
 139
 140                 let pre         = [ COMMENT FSLIT("spill load")
 141                                   , mkLoadInstr nReg delta slot ]
 142
 143                 modify $ \s -> s
 144                         { stateSpillLS  = addToUFM_C accSpillLS (stateSpillLS s) reg (reg, 1, 0) }
 145
 146                 return  ( instr', (pre, []))
 147
 148         | otherwise     = panic "RegSpill.spillRead: no slot defined for spilled reg"
 149
 150 spillWrite regSlotMap instr reg
 151         | Just slot     <- lookupUFM regSlotMap reg
 152         = do    delta           <- getDelta
 153                 (instr', nReg)  <- patchInstr reg instr
 154
 155                 let post        = [ COMMENT FSLIT("spill store")
 156                                   , mkSpillInstr nReg delta slot ]
 157
 158                 modify $ \s -> s
 159                         { stateSpillLS  = addToUFM_C accSpillLS (stateSpillLS s) reg (reg, 0, 1) }
 160
 161                 return  ( instr', ([], post))
 162
 163         | otherwise     = panic "RegSpill.spillWrite: no slot defined for spilled reg"
 164
 165 spillModify regSlotMap instr reg
 166         | Just slot     <- lookupUFM regSlotMap reg
 167         = do    delta           <- getDelta
 168                 (instr', nReg)  <- patchInstr reg instr
 169
 170                 let pre         = [ COMMENT FSLIT("spill mod load")
 171                                   , mkLoadInstr  nReg delta slot ]
 172
 173                 let post        = [ COMMENT FSLIT("spill mod store")
 174                                   , mkSpillInstr nReg delta slot ]
 175
 176                 modify $ \s -> s
 177                         { stateSpillLS  = addToUFM_C accSpillLS (stateSpillLS s) reg (reg, 1, 1) }
 178
 179                 return  ( instr', (pre, post))
 180
 181         | otherwise     = panic "RegSpill.spillModify: no slot defined for spilled reg"
 182
 183
 184
 185 -- | rewrite uses of this virtual reg in an instr to use a different virtual reg
 186 patchInstr :: Reg -> Instr -> SpillM (Instr, Reg)
 187 patchInstr reg instr
 188  = do   nUnique         <- newUnique
 189         let nReg        = renameVirtualReg nUnique reg
 190         let instr'      = patchReg1 reg nReg instr
 191         return          (instr', nReg)
 192
 193 patchReg1 :: Reg -> Reg -> Instr -> Instr
 194 patchReg1 old new instr
 195  = let  patchF r
 196                 | r == old      = new
 197                 | otherwise     = r
 198    in   patchRegs instr patchF
 199
 200
 201 ------------------------------------------------------
 202 -- Spiller monad
 203
 204 data SpillS
 205         = SpillS
 206         { stateDelta    :: Int
 207         , stateUS       :: UniqSupply
 208         , stateSpillLS  :: UniqFM (Reg, Int, Int) } -- ^ spilled reg vs number of times vreg was loaded, stored
 209
 210 initSpillS uniqueSupply
 211         = SpillS
 212         { stateDelta    = 0
 213         , stateUS       = uniqueSupply
 214         , stateSpillLS  = emptyUFM }
 215
 216 type SpillM a   = State SpillS a
 217
 218 setDelta :: Int -> SpillM ()
 219 setDelta delta
 220         = modify $ \s -> s { stateDelta = delta }
 221
 222 getDelta  :: SpillM Int
 223 getDelta = gets stateDelta
 224
 225 newUnique :: SpillM Unique
 226 newUnique
 227  = do   us      <- gets stateUS
 228         case splitUniqSupply us of
 229          (us1, us2)
 230           -> do let uniq = uniqFromSupply us1
 231                 modify $ \s -> s { stateUS = us2 }
 232                 return uniq
 233
 234 accSpillLS (r1, l1, s1) (r2, l2, s2)
 235         = (r1, l1 + l2, s1 + s2)
 236
 237
 238
 239 ----------------------------------------------------
 240 -- Spiller stats
 241
 242 data SpillStats
 243         = SpillStats
 244         { spillLoadStore        :: UniqFM (Reg, Int, Int) }
 245
 246 makeSpillStats :: SpillS -> SpillStats
 247 makeSpillStats s
 248         = SpillStats
 249         { spillLoadStore        = stateSpillLS s }
 250
 251 instance Outputable SpillStats where
 252  ppr s
 253         = (vcat $ map (\(r, l, s) -> ppr r <+> int l <+> int s)
 254                         $ eltsUFM (spillLoadStore s))
 255