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