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