compiler/nativeGen/RegSpill.hs

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