SpillCost.hs 10.8 KB
Newer Older
1
{-# LANGUAGE ScopedTypeVariables, GADTs, BangPatterns #-}
2
module RegAlloc.Graph.SpillCost (
benl's avatar
benl committed
3 4 5
        SpillCostRecord,
        plusSpillCostRecord,
        pprSpillCostRecord,
6

benl's avatar
benl committed
7 8 9
        SpillCostInfo,
        zeroSpillCostInfo,
        plusSpillCostInfo,
10

benl's avatar
benl committed
11 12
        slurpSpillCostInfo,
        chooseSpill,
13

benl's avatar
benl committed
14
        lifeMapFromSpillCostInfo
15
) where
16 17
import GhcPrelude

18
import RegAlloc.Liveness
19 20 21 22 23 24
import Instruction
import RegClass
import Reg

import GraphBase

25
import Hoopl.Collections (mapLookup)
26
import Hoopl.Label
27
import Cmm
28
import UniqFM
29
import UniqSet
benl's avatar
benl committed
30
import Digraph          (flattenSCCs)
31
import Outputable
John Ericson's avatar
John Ericson committed
32
import GHC.Platform
33
import State
34
import CFG
35

benl's avatar
benl committed
36
import Data.List        (nub, minimumBy)
37
import Data.Maybe
38
import Control.Monad (join)
39

40 41

-- | Records the expected cost to spill some regster.
42
type SpillCostRecord
benl's avatar
benl committed
43 44 45 46
 =      ( VirtualReg    -- register name
        , Int           -- number of writes to this reg
        , Int           -- number of reads from this reg
        , Int)          -- number of instrs this reg was live on entry to
47

48 49

-- | Map of `SpillCostRecord`
50
type SpillCostInfo
benl's avatar
benl committed
51
        = UniqFM SpillCostRecord
52

53
type SpillCostState = State (UniqFM SpillCostRecord) ()
54

55
-- | An empty map of spill costs.
56
zeroSpillCostInfo :: SpillCostInfo
benl's avatar
benl committed
57
zeroSpillCostInfo       = emptyUFM
58

59 60

-- | Add two spill cost infos.
61 62
plusSpillCostInfo :: SpillCostInfo -> SpillCostInfo -> SpillCostInfo
plusSpillCostInfo sc1 sc2
benl's avatar
benl committed
63
        = plusUFM_C plusSpillCostRecord sc1 sc2
64

65 66

-- | Add two spill cost records.
67 68
plusSpillCostRecord :: SpillCostRecord -> SpillCostRecord -> SpillCostRecord
plusSpillCostRecord (r1, a1, b1, c1) (r2, a2, b2, c2)
benl's avatar
benl committed
69 70
        | r1 == r2      = (r1, a1 + a2, b1 + b2, c1 + c2)
        | otherwise     = error "RegSpillCost.plusRegInt: regs don't match"
71 72


73 74 75 76
-- | Slurp out information used for determining spill costs.
--
--   For each vreg, the number of times it was written to, read from,
--   and the number of instructions it was live on entry to (lifetime)
77
--
78
slurpSpillCostInfo :: forall instr statics. (Outputable instr, Instruction instr)
79
                   => Platform
80
                   -> Maybe CFG
81
                   -> LiveCmmDecl statics instr
82
                   -> SpillCostInfo
83

84
slurpSpillCostInfo platform cfg cmm
benl's avatar
benl committed
85
        = execState (countCmm cmm) zeroSpillCostInfo
86
 where
benl's avatar
benl committed
87 88
        countCmm CmmData{}              = return ()
        countCmm (CmmProc info _ _ sccs)
89
                = mapM_ (countBlock info freqMap)
benl's avatar
benl committed
90
                $ flattenSCCs sccs
91 92 93
            where
                LiveInfo _ entries _ _ = info
                freqMap = (fst . mkGlobalWeights (head entries)) <$> cfg
94

95 96
        -- Lookup the regs that are live on entry to this block in
        --      the info table from the CmmProc.
97
        countBlock info freqMap (BasicBlock blockId instrs)
98
                | LiveInfo _ _ blockLive _ <- info
benl's avatar
benl committed
99 100
                , Just rsLiveEntry  <- mapLookup blockId blockLive
                , rsLiveEntry_virt  <- takeVirtuals rsLiveEntry
101
                = countLIs (ceiling $ blockFreq freqMap blockId) rsLiveEntry_virt instrs
102

benl's avatar
benl committed
103 104
                | otherwise
                = error "RegAlloc.SpillCost.slurpSpillCostInfo: bad block"
105

106 107

        countLIs :: Int -> UniqSet VirtualReg -> [LiveInstr instr] -> SpillCostState
108
        countLIs _      _      []
benl's avatar
benl committed
109
                = return ()
110

111
        -- Skip over comment and delta pseudo instrs.
112
        countLIs scale rsLive (LiveInstr instr Nothing : lis)
benl's avatar
benl committed
113
                | isMetaInstr instr
114
                = countLIs scale rsLive lis
115

benl's avatar
benl committed
116 117
                | otherwise
                = pprPanic "RegSpillCost.slurpSpillCostInfo"
118
                $ text "no liveness information on instruction " <> ppr instr
119

120
        countLIs scale rsLiveEntry (LiveInstr instr (Just live) : lis)
benl's avatar
benl committed
121
         = do
122
                -- Increment the lifetime counts for regs live on entry to this instr.
123
                mapM_ incLifetime $ nonDetEltsUniqSet rsLiveEntry
niteria's avatar
niteria committed
124 125 126
                    -- This is non-deterministic but we do not
                    -- currently support deterministic code-generation.
                    -- See Note [Unique Determinism and code generation]
127

128
                -- Increment counts for what regs were read/written from.
benl's avatar
benl committed
129
                let (RU read written)   = regUsageOfInstr platform instr
130 131
                mapM_ (incUses scale) $ catMaybes $ map takeVirtualReg $ nub read
                mapM_ (incDefs scale) $ catMaybes $ map takeVirtualReg $ nub written
132

133
                -- Compute liveness for entry to next instruction.
benl's avatar
benl committed
134 135 136
                let liveDieRead_virt    = takeVirtuals (liveDieRead  live)
                let liveDieWrite_virt   = takeVirtuals (liveDieWrite live)
                let liveBorn_virt       = takeVirtuals (liveBorn     live)
137

benl's avatar
benl committed
138 139
                let rsLiveAcross
                        = rsLiveEntry `minusUniqSet` liveDieRead_virt
140

benl's avatar
benl committed
141 142 143
                let rsLiveNext
                        = (rsLiveAcross `unionUniqSets` liveBorn_virt)
                                        `minusUniqSet`  liveDieWrite_virt
144

145
                countLIs scale rsLiveNext lis
146 147 148

        incDefs     count reg = modify $ \s -> addToUFM_C plusSpillCostRecord s reg (reg, count, 0, 0)
        incUses     count reg = modify $ \s -> addToUFM_C plusSpillCostRecord s reg (reg, 0, count, 0)
149
        incLifetime       reg = modify $ \s -> addToUFM_C plusSpillCostRecord s reg (reg, 0, 0, 1)
150

151 152 153 154
        blockFreq :: Maybe (LabelMap Double) -> Label -> Double
        blockFreq freqs bid
          | Just freq <- join (mapLookup bid <$> freqs)
          = max 1.0 (10000 * freq)
155
          | otherwise
156
          = 1.0 -- Only if no cfg given
157

158
-- | Take all the virtual registers from this set.
159
takeVirtuals :: UniqSet Reg -> UniqSet VirtualReg
niteria's avatar
niteria committed
160
takeVirtuals set = mkUniqSet
David Feuer's avatar
David Feuer committed
161
  [ vr | RegVirtual vr <- nonDetEltsUniqSet set ]
niteria's avatar
niteria committed
162
  -- See Note [Unique Determinism and code generation]
163

164

165
-- | Choose a node to spill from this graph
166
chooseSpill
benl's avatar
benl committed
167 168 169
        :: SpillCostInfo
        -> Graph VirtualReg RegClass RealReg
        -> VirtualReg
170 171

chooseSpill info graph
benl's avatar
benl committed
172 173
 = let  cost    = spillCost_length info graph
        node    = minimumBy (\n1 n2 -> compare (cost $ nodeId n1) (cost $ nodeId n2))
174 175
                $ nonDetEltsUFM $ graphMap graph
                -- See Note [Unique Determinism and code generation]
176

benl's avatar
benl committed
177
   in   nodeId node
178 179


180
-------------------------------------------------------------------------------
181 182
-- | Chaitins spill cost function is:
--
183 184
--   cost =     sum         loadCost * freq (u)  +    sum        storeCost * freq (d)
--          u <- uses (v)                         d <- defs (v)
185
--
Gabor Greif's avatar
Gabor Greif committed
186
--   There are no loops in our code at the moment, so we can set the freq's to 1.
187
--
188 189
--  If we don't have live range splitting then Chaitins function performs badly
--  if we have lots of nested live ranges and very few registers.
190
--
benl's avatar
benl committed
191 192 193 194 195 196 197 198 199
--               v1 v2 v3
--      def v1   .
--      use v1   .
--      def v2   .  .
--      def v3   .  .  .
--      use v1   .  .  .
--      use v3   .  .  .
--      use v2   .  .
--      use v1   .
200 201
--
--           defs uses degree   cost
benl's avatar
benl committed
202 203 204
--      v1:  1     3     3      1.5
--      v2:  1     2     3      1.0
--      v3:  1     1     3      0.666
205
--
206 207 208
--   v3 has the lowest cost, but if we only have 2 hardregs and we insert
--   spill code for v3 then this isn't going to improve the colorability of
--   the graph.
209
--
210 211 212
--  When compiling SHA1, which as very long basic blocks and some vregs
--  with very long live ranges the allocator seems to try and spill from
--  the inside out and eventually run out of stack slots.
213
--
214 215
--  Without live range splitting, its's better to spill from the outside
--  in so set the cost of very long live ranges to zero
216 217
--

218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248
-- spillCost_chaitin
--         :: SpillCostInfo
--         -> Graph VirtualReg RegClass RealReg
--         -> VirtualReg
--         -> Float

-- spillCost_chaitin info graph reg
--         -- Spilling a live range that only lives for 1 instruction
--         -- isn't going to help us at all - and we definitely want to avoid
--         -- trying to re-spill previously inserted spill code.
--         | lifetime <= 1         = 1/0

--         -- It's unlikely that we'll find a reg for a live range this long
--         -- better to spill it straight up and not risk trying to keep it around
--         -- and have to go through the build/color cycle again.

--         -- To facility this we scale down the spill cost of long ranges.
--         -- This makes sure long ranges are still spilled first.
--         -- But this way spill cost remains relevant for long live
--         -- ranges.
--         | lifetime >= 128
--         = (spillCost / conflicts) / 10.0


--         -- Otherwise revert to chaitin's regular cost function.
--         | otherwise = (spillCost / conflicts)
--         where
--             !spillCost = fromIntegral (uses + defs) :: Float
--             conflicts = fromIntegral (nodeDegree classOfVirtualReg graph reg)
--             (_, defs, uses, lifetime)
--                 = fromMaybe (reg, 0, 0, 0) $ lookupUFM info reg
benl's avatar
benl committed
249

250 251 252

-- Just spill the longest live range.
spillCost_length
benl's avatar
benl committed
253 254 255 256
        :: SpillCostInfo
        -> Graph VirtualReg RegClass RealReg
        -> VirtualReg
        -> Float
257 258

spillCost_length info _ reg
benl's avatar
benl committed
259 260 261
        | lifetime <= 1         = 1/0
        | otherwise             = 1 / fromIntegral lifetime
        where (_, _, _, lifetime)
262
                = fromMaybe (reg, 0, 0, 0)
benl's avatar
benl committed
263
                $ lookupUFM info reg
264

265

266
-- | Extract a map of register lifetimes from a `SpillCostInfo`.
267
lifeMapFromSpillCostInfo :: SpillCostInfo -> UniqFM (VirtualReg, Int)
268
lifeMapFromSpillCostInfo info
benl's avatar
benl committed
269 270
        = listToUFM
        $ map (\(r, _, _, life) -> (r, (r, life)))
271 272
        $ nonDetEltsUFM info
        -- See Note [Unique Determinism and code generation]
273 274


275 276
-- | Determine the degree (number of neighbors) of this node which
--   have the same class.
277
nodeDegree
benl's avatar
benl committed
278
        :: (VirtualReg -> RegClass)
279 280
        -> Graph VirtualReg RegClass RealReg
        -> VirtualReg
benl's avatar
benl committed
281
        -> Int
282

283
nodeDegree classOfVirtualReg graph reg
benl's avatar
benl committed
284
        | Just node     <- lookupUFM (graphMap graph) reg
285

286 287
        , virtConflicts
           <- length
288
           $ filter (\r -> classOfVirtualReg r == classOfVirtualReg reg)
David Feuer's avatar
David Feuer committed
289
           $ nonDetEltsUniqSet
niteria's avatar
niteria committed
290
           -- See Note [Unique Determinism and code generation]
291
           $ nodeConflicts node
292

benl's avatar
benl committed
293
        = virtConflicts + sizeUniqSet (nodeExclusions node)
294

benl's avatar
benl committed
295 296
        | otherwise
        = 0
297 298


299 300
-- | Show a spill cost record, including the degree from the graph
--   and final calulated spill cost.
301
pprSpillCostRecord
benl's avatar
benl committed
302 303
        :: (VirtualReg -> RegClass)
        -> (Reg -> SDoc)
304 305
        -> Graph VirtualReg RegClass RealReg
        -> SpillCostRecord
benl's avatar
benl committed
306
        -> SDoc
307 308

pprSpillCostRecord regClass pprReg graph (reg, uses, defs, life)
benl's avatar
benl committed
309 310 311 312 313 314
        =  hsep
        [ pprReg (RegVirtual reg)
        , ppr uses
        , ppr defs
        , ppr life
        , ppr $ nodeDegree regClass graph reg
315
        , text $ show $ (fromIntegral (uses + defs)
316
                       / fromIntegral (nodeDegree regClass graph reg) :: Float) ]
317