never executed always true always false
    1 -- | When there aren't enough registers to hold all the vregs we have to spill
    2 --   some of those vregs to slots on the stack. This module is used modify the
    3 --   code to use those slots.
    4 module GHC.CmmToAsm.Reg.Graph.Spill (
    5         regSpill,
    6         SpillStats(..),
    7         accSpillSL
    8 ) where
    9 
   10 import GHC.Prelude
   11 
   12 import GHC.CmmToAsm.Reg.Liveness
   13 import GHC.CmmToAsm.Reg.Utils
   14 import GHC.CmmToAsm.Instr
   15 import GHC.Platform.Reg
   16 import GHC.Cmm hiding (RegSet)
   17 import GHC.Cmm.BlockId
   18 import GHC.Cmm.Dataflow.Collections
   19 
   20 import GHC.Utils.Monad
   21 import GHC.Utils.Monad.State.Strict
   22 import GHC.Types.Unique
   23 import GHC.Types.Unique.FM
   24 import GHC.Types.Unique.Set
   25 import GHC.Types.Unique.Supply
   26 import GHC.Utils.Outputable
   27 import GHC.Utils.Panic
   28 import GHC.Platform
   29 
   30 import Data.List (nub, (\\), intersect)
   31 import Data.Maybe
   32 import Data.IntSet              (IntSet)
   33 import qualified Data.IntSet    as IntSet
   34 
   35 
   36 -- | Spill all these virtual regs to stack slots.
   37 --
   38 --   Bumps the number of required stack slots if required.
   39 --
   40 --
   41 --   TODO: See if we can split some of the live ranges instead of just globally
   42 --         spilling the virtual reg. This might make the spill cleaner's job easier.
   43 --
   44 --   TODO: On CISCy x86 and x86_64 we don't necessarily have to add a mov instruction
   45 --         when making spills. If an instr is using a spilled virtual we may be able to
   46 --         address the spill slot directly.
   47 --
   48 regSpill
   49         :: Instruction instr
   50         => Platform
   51         -> [LiveCmmDecl statics instr]  -- ^ the code
   52         -> UniqSet Int                  -- ^ available stack slots
   53         -> Int                          -- ^ current number of spill slots.
   54         -> UniqSet VirtualReg           -- ^ the regs to spill
   55         -> UniqSM
   56             ([LiveCmmDecl statics instr]
   57                  -- code with SPILL and RELOAD meta instructions added.
   58             , UniqSet Int               -- left over slots
   59             , Int                       -- slot count in use now.
   60             , SpillStats )              -- stats about what happened during spilling
   61 
   62 regSpill platform code slotsFree slotCount regs
   63 
   64         -- Not enough slots to spill these regs.
   65         | sizeUniqSet slotsFree < sizeUniqSet regs
   66         = -- pprTrace "Bumping slot count:" (ppr slotCount <> text " -> " <> ppr (slotCount+512)) $
   67           let slotsFree' = (addListToUniqSet slotsFree [slotCount+1 .. slotCount+512])
   68           in regSpill platform code slotsFree' (slotCount+512) regs
   69 
   70         | otherwise
   71         = do
   72                 -- Allocate a slot for each of the spilled regs.
   73                 let slots       = take (sizeUniqSet regs) $ nonDetEltsUniqSet slotsFree
   74                 let
   75                     regSlotMap  = toRegMap -- Cast keys from VirtualReg to Reg
   76                                            -- See Note [UniqFM and the register allocator]
   77                                 $ listToUFM
   78                                 $ zip (nonDetEltsUniqSet regs) slots :: UniqFM Reg Int
   79                     -- This is non-deterministic but we do not
   80                     -- currently support deterministic code-generation.
   81                     -- See Note [Unique Determinism and code generation]
   82 
   83                 -- Grab the unique supply from the monad.
   84                 us      <- getUniqueSupplyM
   85 
   86                 -- Run the spiller on all the blocks.
   87                 let (code', state')     =
   88                         runState (mapM (regSpill_top platform regSlotMap) code)
   89                                  (initSpillS us)
   90 
   91                 return  ( code'
   92                         , minusUniqSet slotsFree (mkUniqSet slots)
   93                         , slotCount
   94                         , makeSpillStats state')
   95 
   96 
   97 -- | Spill some registers to stack slots in a top-level thing.
   98 regSpill_top
   99         :: Instruction instr
  100         => Platform
  101         -> RegMap Int
  102                 -- ^ map of vregs to slots they're being spilled to.
  103         -> LiveCmmDecl statics instr
  104                 -- ^ the top level thing.
  105         -> SpillM (LiveCmmDecl statics instr)
  106 
  107 regSpill_top platform regSlotMap cmm
  108  = case cmm of
  109         CmmData{}
  110          -> return cmm
  111 
  112         CmmProc info label live sccs
  113          |  LiveInfo static firstId liveVRegsOnEntry liveSlotsOnEntry <- info
  114          -> do
  115                 -- The liveVRegsOnEntry contains the set of vregs that are live
  116                 -- on entry to each basic block. If we spill one of those vregs
  117                 -- we remove it from that set and add the corresponding slot
  118                 -- number to the liveSlotsOnEntry set. The spill cleaner needs
  119                 -- this information to erase unneeded spill and reload instructions
  120                 -- after we've done a successful allocation.
  121                 let liveSlotsOnEntry' :: BlockMap IntSet
  122                     liveSlotsOnEntry'
  123                         = mapFoldlWithKey patchLiveSlot
  124                                           liveSlotsOnEntry liveVRegsOnEntry
  125 
  126                 let info'
  127                         = LiveInfo static firstId
  128                                 liveVRegsOnEntry
  129                                 liveSlotsOnEntry'
  130 
  131                 -- Apply the spiller to all the basic blocks in the CmmProc.
  132                 sccs'   <- mapM (mapSCCM (regSpill_block platform regSlotMap)) sccs
  133 
  134                 return  $ CmmProc info' label live sccs'
  135 
  136  where  -- Given a BlockId and the set of registers live in it,
  137         -- if registers in this block are being spilled to stack slots,
  138         -- then record the fact that these slots are now live in those blocks
  139         -- in the given slotmap.
  140         patchLiveSlot
  141                 :: BlockMap IntSet -> BlockId -> RegSet -> BlockMap IntSet
  142 
  143         patchLiveSlot slotMap blockId regsLive
  144          = let
  145                 -- Slots that are already recorded as being live.
  146                 curSlotsLive    = fromMaybe IntSet.empty
  147                                 $ mapLookup blockId slotMap
  148 
  149                 moreSlotsLive   = IntSet.fromList
  150                                 $ catMaybes
  151                                 $ map (lookupUFM regSlotMap)
  152                                 $ nonDetEltsUniqSet regsLive
  153                     -- See Note [Unique Determinism and code generation]
  154 
  155                 slotMap'
  156                  = mapInsert blockId (IntSet.union curSlotsLive moreSlotsLive)
  157                              slotMap
  158 
  159            in   slotMap'
  160 
  161 
  162 -- | Spill some registers to stack slots in a basic block.
  163 regSpill_block
  164         :: Instruction instr
  165         => Platform
  166         -> UniqFM Reg Int   -- ^ map of vregs to slots they're being spilled to.
  167         -> LiveBasicBlock instr
  168         -> SpillM (LiveBasicBlock instr)
  169 
  170 regSpill_block platform regSlotMap (BasicBlock i instrs)
  171  = do   instrss'        <- mapM (regSpill_instr platform regSlotMap) instrs
  172         return  $ BasicBlock i (concat instrss')
  173 
  174 
  175 -- | Spill some registers to stack slots in a single instruction.
  176 --   If the instruction uses registers that need to be spilled, then it is
  177 --   prefixed (or postfixed) with the appropriate RELOAD or SPILL meta
  178 --   instructions.
  179 regSpill_instr
  180         :: Instruction instr
  181         => Platform
  182         -> UniqFM Reg Int -- ^ map of vregs to slots they're being spilled to.
  183         -> LiveInstr instr
  184         -> SpillM [LiveInstr instr]
  185 regSpill_instr _ _ li@(LiveInstr _ Nothing) = return [li]
  186 regSpill_instr platform regSlotMap (LiveInstr instr (Just _)) = do
  187   -- work out which regs are read and written in this instr
  188   let RU rlRead rlWritten = regUsageOfInstr platform instr
  189 
  190   -- sometimes a register is listed as being read more than once,
  191   --      nub this so we don't end up inserting two lots of spill code.
  192   let rsRead_             = nub rlRead
  193   let rsWritten_          = nub rlWritten
  194 
  195   -- if a reg is modified, it appears in both lists, want to undo this..
  196   let rsRead              = rsRead_    \\ rsWritten_
  197   let rsWritten           = rsWritten_ \\ rsRead_
  198   let rsModify            = intersect rsRead_ rsWritten_
  199 
  200   -- work out if any of the regs being used are currently being spilled.
  201   let rsSpillRead         = filter (\r -> elemUFM r regSlotMap) rsRead
  202   let rsSpillWritten      = filter (\r -> elemUFM r regSlotMap) rsWritten
  203   let rsSpillModify       = filter (\r -> elemUFM r regSlotMap) rsModify
  204 
  205   -- rewrite the instr and work out spill code.
  206   (instr1, prepost1)      <- mapAccumLM (spillRead   regSlotMap) instr  rsSpillRead
  207   (instr2, prepost2)      <- mapAccumLM (spillWrite  regSlotMap) instr1 rsSpillWritten
  208   (instr3, prepost3)      <- mapAccumLM (spillModify regSlotMap) instr2 rsSpillModify
  209 
  210   let (mPrefixes, mPostfixes) = unzip (prepost1 ++ prepost2 ++ prepost3)
  211   let prefixes                = concat mPrefixes
  212   let postfixes               = concat mPostfixes
  213 
  214   -- final code
  215   let instrs' =  prefixes
  216               ++ [LiveInstr instr3 Nothing]
  217               ++ postfixes
  218 
  219   return instrs'
  220 
  221 
  222 -- | Add a RELOAD met a instruction to load a value for an instruction that
  223 --   writes to a vreg that is being spilled.
  224 spillRead
  225         :: Instruction instr
  226         => UniqFM Reg Int
  227         -> instr
  228         -> Reg
  229         -> SpillM (instr, ([LiveInstr instr'], [LiveInstr instr']))
  230 
  231 spillRead regSlotMap instr reg
  232  | Just slot     <- lookupUFM regSlotMap reg
  233  = do    (instr', nReg)  <- patchInstr reg instr
  234 
  235          modify $ \s -> s
  236                 { stateSpillSL  = addToUFM_C accSpillSL (stateSpillSL s) reg (reg, 0, 1) }
  237 
  238          return  ( instr'
  239                  , ( [LiveInstr (RELOAD slot nReg) Nothing]
  240                  , []) )
  241 
  242  | otherwise     = panic "RegSpill.spillRead: no slot defined for spilled reg"
  243 
  244 
  245 -- | Add a SPILL meta instruction to store a value for an instruction that
  246 --   writes to a vreg that is being spilled.
  247 spillWrite
  248         :: Instruction instr
  249         => UniqFM Reg Int
  250         -> instr
  251         -> Reg
  252         -> SpillM (instr, ([LiveInstr instr'], [LiveInstr instr']))
  253 
  254 spillWrite regSlotMap instr reg
  255  | Just slot     <- lookupUFM regSlotMap reg
  256  = do    (instr', nReg)  <- patchInstr reg instr
  257 
  258          modify $ \s -> s
  259                 { stateSpillSL  = addToUFM_C accSpillSL (stateSpillSL s) reg (reg, 1, 0) }
  260 
  261          return  ( instr'
  262                  , ( []
  263                    , [LiveInstr (SPILL nReg slot) Nothing]))
  264 
  265  | otherwise     = panic "RegSpill.spillWrite: no slot defined for spilled reg"
  266 
  267 
  268 -- | Add both RELOAD and SPILL meta instructions for an instruction that
  269 --   both reads and writes to a vreg that is being spilled.
  270 spillModify
  271         :: Instruction instr
  272         => UniqFM Reg Int
  273         -> instr
  274         -> Reg
  275         -> SpillM (instr, ([LiveInstr instr'], [LiveInstr instr']))
  276 
  277 spillModify regSlotMap instr reg
  278  | Just slot     <- lookupUFM regSlotMap reg
  279  = do    (instr', nReg)  <- patchInstr reg instr
  280 
  281          modify $ \s -> s
  282                 { stateSpillSL  = addToUFM_C accSpillSL (stateSpillSL s) reg (reg, 1, 1) }
  283 
  284          return  ( instr'
  285                  , ( [LiveInstr (RELOAD slot nReg) Nothing]
  286                    , [LiveInstr (SPILL nReg slot) Nothing]))
  287 
  288  | otherwise     = panic "RegSpill.spillModify: no slot defined for spilled reg"
  289 
  290 
  291 -- | Rewrite uses of this virtual reg in an instr to use a different
  292 --   virtual reg.
  293 patchInstr
  294         :: Instruction instr
  295         => Reg -> instr -> SpillM (instr, Reg)
  296 
  297 patchInstr reg instr
  298  = do   nUnique         <- newUnique
  299 
  300         -- The register we're rewriting is supposed to be virtual.
  301         -- If it's not then something has gone horribly wrong.
  302         let nReg
  303              = case reg of
  304                 RegVirtual vr
  305                  -> RegVirtual (renameVirtualReg nUnique vr)
  306 
  307                 RegReal{}
  308                  -> panic "RegAlloc.Graph.Spill.patchIntr: not patching real reg"
  309 
  310         let instr'      = patchReg1 reg nReg instr
  311         return          (instr', nReg)
  312 
  313 
  314 patchReg1
  315         :: Instruction instr
  316         => Reg -> Reg -> instr -> instr
  317 
  318 patchReg1 old new instr
  319  = let  patchF r
  320                 | r == old      = new
  321                 | otherwise     = r
  322    in   patchRegsOfInstr instr patchF
  323 
  324 
  325 -- Spiller monad --------------------------------------------------------------
  326 -- | State monad for the spill code generator.
  327 type SpillM a
  328         = State SpillS a
  329 
  330 -- | Spill code generator state.
  331 data SpillS
  332         = SpillS
  333         { -- | Unique supply for generating fresh vregs.
  334           stateUS       :: UniqSupply
  335 
  336           -- | Spilled vreg vs the number of times it was loaded, stored.
  337         , stateSpillSL  :: UniqFM Reg (Reg, Int, Int) }
  338 
  339 
  340 -- | Create a new spiller state.
  341 initSpillS :: UniqSupply -> SpillS
  342 initSpillS uniqueSupply
  343         = SpillS
  344         { stateUS       = uniqueSupply
  345         , stateSpillSL  = emptyUFM }
  346 
  347 
  348 -- | Allocate a new unique in the spiller monad.
  349 newUnique :: SpillM Unique
  350 newUnique
  351  = do   us      <- gets stateUS
  352         case takeUniqFromSupply us of
  353          (uniq, us')
  354           -> do modify $ \s -> s { stateUS = us' }
  355                 return uniq
  356 
  357 
  358 -- | Add a spill/reload count to a stats record for a register.
  359 accSpillSL :: (Reg, Int, Int) -> (Reg, Int, Int) -> (Reg, Int, Int)
  360 accSpillSL (r1, s1, l1) (_, s2, l2)
  361         = (r1, s1 + s2, l1 + l2)
  362 
  363 
  364 -- Spiller stats --------------------------------------------------------------
  365 -- | Spiller statistics.
  366 --   Tells us what registers were spilled.
  367 data SpillStats
  368         = SpillStats
  369         { spillStoreLoad        :: UniqFM Reg (Reg, Int, Int) }
  370 
  371 
  372 -- | Extract spiller statistics from the spiller state.
  373 makeSpillStats :: SpillS -> SpillStats
  374 makeSpillStats s
  375         = SpillStats
  376         { spillStoreLoad        = stateSpillSL s }
  377 
  378 
  379 instance Outputable SpillStats where
  380  ppr stats
  381         = pprUFM (spillStoreLoad stats)
  382                  (vcat . map (\(r, s, l) -> ppr r <+> int s <+> int l))