compiler/nativeGen/RegAlloc/Graph/SpillCost.hs

   1
   2 module RegAlloc.Graph.SpillCost (
   3         SpillCostRecord,
   4         plusSpillCostRecord,
   5         pprSpillCostRecord,
   6
   7         SpillCostInfo,
   8         zeroSpillCostInfo,
   9         plusSpillCostInfo,
  10
  11         slurpSpillCostInfo,
  12         chooseSpill,
  13
  14         lifeMapFromSpillCostInfo
  15 )
  16
  17 where
  18
  19 import GraphBase
  20 import RegAlloc.Liveness
  21 import RegAllocInfo
  22 import Instrs
  23 import Regs
  24 import BlockId
  25 import Cmm
  26
  27 import UniqFM
  28 import UniqSet
  29 import Outputable
  30 import State
  31
  32 import Data.List        (nub, minimumBy)
  33 import Data.Maybe
  34 import Control.Monad
  35
  36 type SpillCostRecord
  37  =      ( Reg   -- register name
  38         , Int   -- number of writes to this reg
  39         , Int   -- number of reads from this reg
  40         , Int)  -- number of instrs this reg was live on entry to
  41
  42 type SpillCostInfo
  43         = UniqFM SpillCostRecord
  44
  45
  46 zeroSpillCostInfo :: SpillCostInfo
  47 zeroSpillCostInfo       = emptyUFM
  48
  49 -- | Add two spillCostInfos
  50 plusSpillCostInfo :: SpillCostInfo -> SpillCostInfo -> SpillCostInfo
  51 plusSpillCostInfo sc1 sc2
  52         = plusUFM_C plusSpillCostRecord sc1 sc2
  53
  54 plusSpillCostRecord :: SpillCostRecord -> SpillCostRecord -> SpillCostRecord
  55 plusSpillCostRecord (r1, a1, b1, c1) (r2, a2, b2, c2)
  56         | r1 == r2      = (r1, a1 + a2, b1 + b2, c1 + c2)
  57         | otherwise     = error "RegSpillCost.plusRegInt: regs don't match"
  58
  59
  60 -- | Slurp out information used for determining spill costs
  61 --      for each vreg, the number of times it was written to, read from,
  62 --      and the number of instructions it was live on entry to (lifetime)
  63 --
  64 slurpSpillCostInfo
  65         :: LiveCmmTop
  66         -> SpillCostInfo
  67
  68 slurpSpillCostInfo cmm
  69         = execState (countCmm cmm) zeroSpillCostInfo
  70  where
  71         countCmm CmmData{}              = return ()
  72         countCmm (CmmProc info _ _ (ListGraph blocks))
  73                 = mapM_ (countComp info) blocks
  74
  75         countComp info (BasicBlock _ blocks)
  76                 = mapM_ (countBlock info) blocks
  77
  78         -- lookup the regs that are live on entry to this block in
  79         --      the info table from the CmmProc
  80         countBlock info (BasicBlock blockId instrs)
  81                 | LiveInfo _ _ blockLive        <- info
  82                 , Just rsLiveEntry              <- lookupBlockEnv blockLive blockId
  83                 = countLIs rsLiveEntry instrs
  84
  85                 | otherwise
  86                 = error "RegAlloc.SpillCost.slurpSpillCostInfo: bad block"
  87
  88         countLIs _      []
  89                 = return ()
  90
  91         -- skip over comment and delta pseudo instrs
  92         countLIs rsLive (Instr instr Nothing : lis)
  93                 | COMMENT{}     <- instr
  94                 = countLIs rsLive lis
  95
  96                 | DELTA{}       <- instr
  97                 = countLIs rsLive lis
  98
  99                 | otherwise
 100                 = pprPanic "RegSpillCost.slurpSpillCostInfo"
 101                         (text "no liveness information on instruction " <> ppr instr)
 102
 103         countLIs rsLiveEntry (Instr instr (Just live) : lis)
 104          = do
 105                 -- increment the lifetime counts for regs live on entry to this instr
 106                 mapM_ incLifetime $ uniqSetToList rsLiveEntry
 107
 108                 -- increment counts for what regs were read/written from
 109                 let (RU read written)   = regUsage instr
 110                 mapM_ incUses   $ filter (not . isRealReg) $ nub read
 111                 mapM_ incDefs   $ filter (not . isRealReg) $ nub written
 112
 113                 -- compute liveness for entry to next instruction.
 114                 let rsLiveAcross
 115                         = rsLiveEntry `minusUniqSet` (liveDieRead live)
 116
 117                 let rsLiveNext
 118                         = (rsLiveAcross `unionUniqSets` (liveBorn     live))
 119                                         `minusUniqSet` (liveDieWrite live)
 120
 121                 countLIs rsLiveNext lis
 122
 123         incDefs     reg = modify $ \s -> addToUFM_C plusSpillCostRecord s reg (reg, 1, 0, 0)
 124         incUses     reg = modify $ \s -> addToUFM_C plusSpillCostRecord s reg (reg, 0, 1, 0)
 125         incLifetime reg = modify $ \s -> addToUFM_C plusSpillCostRecord s reg (reg, 0, 0, 1)
 126
 127
 128 -- | Choose a node to spill from this graph
 129
 130 chooseSpill
 131         :: SpillCostInfo
 132         -> Graph Reg RegClass Reg
 133         -> Reg
 134
 135 chooseSpill info graph
 136  = let  cost    = spillCost_length info graph
 137         node    = minimumBy (\n1 n2 -> compare (cost $ nodeId n1) (cost $ nodeId n2))
 138                 $ eltsUFM $ graphMap graph
 139
 140    in   nodeId node
 141
 142
 143
 144 -- | Chaitins spill cost function is:
 145 --
 146 --          cost =     sum         loadCost * freq (u)  +    sum        storeCost * freq (d)
 147 --                  u <- uses (v)                         d <- defs (v)
 148 --
 149 --      There are no loops in our code at the momemnt, so we can set the freq's to 1
 150 --      We divide this by the degree if t
 151 --
 152 --
 153 --  If we don't have live range splitting then Chaitins function performs badly if we have
 154 --      lots of nested live ranges and very few registers.
 155 --
 156 --               v1 v2 v3
 157 --      def v1   .
 158 --      use v1   .
 159 --      def v2   .  .
 160 --      def v3   .  .  .
 161 --      use v1   .  .  .
 162 --      use v3   .  .  .
 163 --      use v2   .  .
 164 --      use v1   .
 165 --
 166 --
 167 --           defs uses degree   cost
 168 --      v1:  1     3     3      1.5
 169 --      v2:  1     2     3      1.0
 170 --      v3:  1     1     3      0.666
 171 --
 172 --      v3 has the lowest cost, but if we only have 2 hardregs and we insert spill code for v3
 173 --      then this isn't going to improve the colorability of the graph.
 174 --
 175 --  When compiling SHA1, which as very long basic blocks and some vregs with very long live ranges
 176 --      the allocator seems to try and spill from the inside out and eventually run out of stack slots.
 177 --
 178 --  Without live range splitting, its's better to spill from the outside in so set the cost of very
 179 --      long live ranges to zero
 180 --
 181 {-
 182 spillCost_chaitin
 183         :: SpillCostInfo
 184         -> Graph Reg RegClass Reg
 185         -> Reg
 186         -> Float
 187
 188 spillCost_chaitin info graph reg
 189         -- Spilling a live range that only lives for 1 instruction isn't going to help
 190         --      us at all - and we definately want to avoid trying to re-spill previously
 191         --      inserted spill code.
 192         | lifetime <= 1         = 1/0
 193
 194         -- It's unlikely that we'll find a reg for a live range this long
 195         --      better to spill it straight up and not risk trying to keep it around
 196         --      and have to go through the build/color cycle again.
 197         | lifetime > allocatableRegsInClass (regClass reg) * 10
 198         = 0
 199
 200         -- otherwise revert to chaitin's regular cost function.
 201         | otherwise     = fromIntegral (uses + defs) / fromIntegral (nodeDegree graph reg)
 202         where (_, defs, uses, lifetime)
 203                 = fromMaybe (reg, 0, 0, 0) $ lookupUFM info reg
 204 -}
 205
 206 -- Just spill the longest live range.
 207 spillCost_length
 208         :: SpillCostInfo
 209         -> Graph Reg RegClass Reg
 210         -> Reg
 211         -> Float
 212
 213 spillCost_length info _ reg
 214         | lifetime <= 1         = 1/0
 215         | otherwise             = 1 / fromIntegral lifetime
 216         where (_, _, _, lifetime)
 217                 = fromMaybe (reg, 0, 0, 0) $ lookupUFM info reg
 218
 219
 220
 221 lifeMapFromSpillCostInfo :: SpillCostInfo -> UniqFM (Reg, Int)
 222 lifeMapFromSpillCostInfo info
 223         = listToUFM
 224         $ map (\(r, _, _, life) -> (r, (r, life)))
 225         $ eltsUFM info
 226
 227
 228 -- | Work out the degree (number of neighbors) of this node which have the same class.
 229 nodeDegree :: Graph Reg RegClass Reg -> Reg -> Int
 230 nodeDegree graph reg
 231         | Just node     <- lookupUFM (graphMap graph) reg
 232         , virtConflicts <- length       $ filter (\r -> regClass r == regClass reg)
 233                                         $ uniqSetToList $ nodeConflicts node
 234         = virtConflicts + sizeUniqSet (nodeExclusions node)
 235
 236         | otherwise
 237         = 0
 238
 239
 240 -- | Show a spill cost record, including the degree from the graph and final calulated spill cos
 241 pprSpillCostRecord :: Graph Reg RegClass Reg -> SpillCostRecord -> SDoc
 242 pprSpillCostRecord graph (reg, uses, defs, life)
 243         =  hsep
 244         [ ppr reg
 245         , ppr uses
 246         , ppr defs
 247         , ppr life
 248         , ppr $ nodeDegree graph reg
 249         , text $ show $ (fromIntegral (uses + defs) / fromIntegral (nodeDegree graph reg) :: Float) ]