never executed always true always false
1 {-# LANGUAGE BangPatterns #-}
2 {-# LANGUAGE DisambiguateRecordFields #-}
3 {-# LANGUAGE GADTs #-}
4
5 {-# OPTIONS_GHC -Wno-incomplete-record-updates #-}
6
7 module GHC.Cmm.ProcPoint
8 ( ProcPointSet, Status(..)
9 , callProcPoints, minimalProcPointSet
10 , splitAtProcPoints, procPointAnalysis
11 , attachContInfoTables
12 )
13 where
14
15 import GHC.Prelude hiding (last, unzip, succ, zip)
16
17 import GHC.Cmm.BlockId
18 import GHC.Cmm.CLabel
19 import GHC.Cmm
20 import GHC.Cmm.Ppr () -- For Outputable instances
21 import GHC.Cmm.Utils
22 import GHC.Cmm.Info
23 import GHC.Cmm.Liveness
24 import GHC.Cmm.Switch
25 import Data.List (sortBy)
26 import GHC.Data.Maybe
27 import Control.Monad
28 import GHC.Utils.Outputable
29 import GHC.Utils.Panic
30 import GHC.Platform
31 import GHC.Types.Unique.Supply
32 import GHC.Cmm.Dataflow.Block
33 import GHC.Cmm.Dataflow.Collections
34 import GHC.Cmm.Dataflow
35 import GHC.Cmm.Dataflow.Graph
36 import GHC.Cmm.Dataflow.Label
37
38 -- Compute a minimal set of proc points for a control-flow graph.
39
40 -- Determine a protocol for each proc point (which live variables will
41 -- be passed as arguments and which will be on the stack).
42
43 {-
44 A proc point is a basic block that, after CPS transformation, will
45 start a new function. The entry block of the original function is a
46 proc point, as is the continuation of each function call.
47 A third kind of proc point arises if we want to avoid copying code.
48 Suppose we have code like the following:
49
50 f() {
51 if (...) { ..1..; call foo(); ..2..}
52 else { ..3..; call bar(); ..4..}
53 x = y + z;
54 return x;
55 }
56
57 The statement 'x = y + z' can be reached from two different proc
58 points: the continuations of foo() and bar(). We would prefer not to
59 put a copy in each continuation; instead we would like 'x = y + z' to
60 be the start of a new procedure to which the continuations can jump:
61
62 f_cps () {
63 if (...) { ..1..; push k_foo; jump foo_cps(); }
64 else { ..3..; push k_bar; jump bar_cps(); }
65 }
66 k_foo() { ..2..; jump k_join(y, z); }
67 k_bar() { ..4..; jump k_join(y, z); }
68 k_join(y, z) { x = y + z; return x; }
69
70 You might think then that a criterion to make a node a proc point is
71 that it is directly reached by two distinct proc points. (Note
72 [Direct reachability].) But this criterion is a bit too simple; for
73 example, 'return x' is also reached by two proc points, yet there is
74 no point in pulling it out of k_join. A good criterion would be to
75 say that a node should be made a proc point if it is reached by a set
76 of proc points that is different than its immediate dominator. NR
77 believes this criterion can be shown to produce a minimum set of proc
78 points, and given a dominator tree, the proc points can be chosen in
79 time linear in the number of blocks. Lacking a dominator analysis,
80 however, we turn instead to an iterative solution, starting with no
81 proc points and adding them according to these rules:
82
83 1. The entry block is a proc point.
84 2. The continuation of a call is a proc point.
85 3. A node is a proc point if it is directly reached by more proc
86 points than one of its predecessors.
87
88 Because we don't understand the problem very well, we apply rule 3 at
89 most once per iteration, then recompute the reachability information.
90 (See Note [No simple dataflow].) The choice of the new proc point is
91 arbitrary, and I don't know if the choice affects the final solution,
92 so I don't know if the number of proc points chosen is the
93 minimum---but the set will be minimal.
94
95
96
97 Note [Proc-point analysis]
98 ~~~~~~~~~~~~~~~~~~~~~~~~~~
99
100 Given a specified set of proc-points (a set of block-ids), "proc-point
101 analysis" figures out, for every block, which proc-point it belongs to.
102 All the blocks belonging to proc-point P will constitute a single
103 top-level C procedure.
104
105 A non-proc-point block B "belongs to" a proc-point P iff B is
106 reachable from P without going through another proc-point.
107
108 Invariant: a block B should belong to at most one proc-point; if it
109 belongs to two, that's a bug.
110
111 Note [Non-existing proc-points]
112 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
113
114 On some architectures it might happen that the list of proc-points
115 computed before stack layout pass will be invalidated by the stack
116 layout. This will happen if stack layout removes from the graph
117 blocks that were determined to be proc-points. Later on in the pipeline
118 we use list of proc-points to perform [Proc-point analysis], but
119 if a proc-point does not exist anymore then we will get compiler panic.
120 See #8205.
121 -}
122
123 type ProcPointSet = LabelSet
124
125 data Status
126 = ReachedBy ProcPointSet -- set of proc points that directly reach the block
127 | ProcPoint -- this block is itself a proc point
128
129 instance Outputable Status where
130 ppr (ReachedBy ps)
131 | setNull ps = text "<not-reached>"
132 | otherwise = text "reached by" <+>
133 (hsep $ punctuate comma $ map ppr $ setElems ps)
134 ppr ProcPoint = text "<procpt>"
135
136 --------------------------------------------------
137 -- Proc point analysis
138
139 -- Once you know what the proc-points are, figure out
140 -- what proc-points each block is reachable from
141 -- See Note [Proc-point analysis]
142 procPointAnalysis :: ProcPointSet -> CmmGraph -> LabelMap Status
143 procPointAnalysis procPoints cmmGraph@(CmmGraph {g_graph = graph}) =
144 analyzeCmmFwd procPointLattice procPointTransfer cmmGraph initProcPoints
145 where
146 initProcPoints =
147 mkFactBase
148 procPointLattice
149 [ (id, ProcPoint)
150 | id <- setElems procPoints
151 -- See Note [Non-existing proc-points]
152 , id `setMember` labelsInGraph
153 ]
154 labelsInGraph = labelsDefined graph
155
156 procPointTransfer :: TransferFun Status
157 procPointTransfer block facts =
158 let label = entryLabel block
159 !fact = case getFact procPointLattice label facts of
160 ProcPoint -> ReachedBy $! setSingleton label
161 f -> f
162 result = map (\id -> (id, fact)) (successors block)
163 in mkFactBase procPointLattice result
164
165 procPointLattice :: DataflowLattice Status
166 procPointLattice = DataflowLattice unreached add_to
167 where
168 unreached = ReachedBy setEmpty
169 add_to (OldFact ProcPoint) _ = NotChanged ProcPoint
170 add_to _ (NewFact ProcPoint) = Changed ProcPoint -- because of previous case
171 add_to (OldFact (ReachedBy p)) (NewFact (ReachedBy p'))
172 | setSize union > setSize p = Changed (ReachedBy union)
173 | otherwise = NotChanged (ReachedBy p)
174 where
175 union = setUnion p' p
176
177 ----------------------------------------------------------------------
178
179 -- It is worth distinguishing two sets of proc points: those that are
180 -- induced by calls in the original graph and those that are
181 -- introduced because they're reachable from multiple proc points.
182 --
183 -- Extract the set of Continuation BlockIds, see Note [Continuation BlockIds].
184 callProcPoints :: CmmGraph -> ProcPointSet
185 callProcPoints g = foldlGraphBlocks add (setSingleton (g_entry g)) g
186 where add :: LabelSet -> CmmBlock -> LabelSet
187 add set b = case lastNode b of
188 CmmCall {cml_cont = Just k} -> setInsert k set
189 CmmForeignCall {succ=k} -> setInsert k set
190 _ -> set
191
192 minimalProcPointSet :: Platform -> ProcPointSet -> CmmGraph
193 -> UniqSM ProcPointSet
194 -- Given the set of successors of calls (which must be proc-points)
195 -- figure out the minimal set of necessary proc-points
196 minimalProcPointSet platform callProcPoints g
197 = extendPPSet platform g (revPostorder g) callProcPoints
198
199 extendPPSet
200 :: Platform -> CmmGraph -> [CmmBlock] -> ProcPointSet -> UniqSM ProcPointSet
201 extendPPSet platform g blocks procPoints =
202 let env = procPointAnalysis procPoints g
203 add pps block = let id = entryLabel block
204 in case mapLookup id env of
205 Just ProcPoint -> setInsert id pps
206 _ -> pps
207 procPoints' = foldlGraphBlocks add setEmpty g
208 newPoints = mapMaybe ppSuccessor blocks
209 newPoint = listToMaybe newPoints
210 ppSuccessor b =
211 let nreached id = case mapLookup id env `orElse`
212 pprPanic "no ppt" (ppr id <+> pdoc platform b) of
213 ProcPoint -> 1
214 ReachedBy ps -> setSize ps
215 block_procpoints = nreached (entryLabel b)
216 -- | Looking for a successor of b that is reached by
217 -- more proc points than b and is not already a proc
218 -- point. If found, it can become a proc point.
219 newId succ_id = not (setMember succ_id procPoints') &&
220 nreached succ_id > block_procpoints
221 in listToMaybe $ filter newId $ successors b
222
223 in case newPoint of
224 Just id ->
225 if setMember id procPoints'
226 then panic "added old proc pt"
227 else extendPPSet platform g blocks (setInsert id procPoints')
228 Nothing -> return procPoints'
229
230
231 -- At this point, we have found a set of procpoints, each of which should be
232 -- the entry point of a procedure.
233 -- Now, we create the procedure for each proc point,
234 -- which requires that we:
235 -- 1. build a map from proc points to the blocks reachable from the proc point
236 -- 2. turn each branch to a proc point into a jump
237 -- 3. turn calls and returns into jumps
238 -- 4. build info tables for the procedures -- and update the info table for
239 -- the SRTs in the entry procedure as well.
240 -- Input invariant: A block should only be reachable from a single ProcPoint.
241 -- ToDo: use the _ret naming convention that the old code generator
242 -- used. -- EZY
243 splitAtProcPoints :: Platform -> CLabel -> ProcPointSet-> ProcPointSet -> LabelMap Status -> CmmDecl
244 -> UniqSM [CmmDecl]
245 splitAtProcPoints _ _ _ _ _ t@(CmmData _ _) = return [t]
246 splitAtProcPoints platform entry_label callPPs procPoints procMap cmmProc = do
247 -- Build a map from procpoints to the blocks they reach
248 let (CmmProc (TopInfo {info_tbls = info_tbls}) top_l _ g@(CmmGraph {g_entry=entry})) = cmmProc
249
250 let add graphEnv procId bid b = mapInsert procId graph' graphEnv
251 where
252 graph' = mapInsert bid b graph
253 graph = mapLookup procId graphEnv `orElse` mapEmpty
254
255 let add_block :: LabelMap (LabelMap CmmBlock) -> CmmBlock -> LabelMap (LabelMap CmmBlock)
256 add_block graphEnv b =
257 case mapLookup bid procMap of
258 Just ProcPoint -> add graphEnv bid bid b
259 Just (ReachedBy set) ->
260 case setElems set of
261 [] -> graphEnv
262 [id] -> add graphEnv id bid b
263 _ -> panic "Each block should be reachable from only one ProcPoint"
264 Nothing -> graphEnv
265 where
266 bid = entryLabel b
267
268
269 let liveness = cmmGlobalLiveness platform g
270 let ppLiveness pp = filter isArgReg $ regSetToList $
271 expectJust "ppLiveness" $ mapLookup pp liveness
272 graphEnv <- return $ foldlGraphBlocks add_block mapEmpty g
273
274 -- Build a map from proc point BlockId to pairs of:
275 -- * Labels for their new procedures
276 -- * Labels for the info tables of their new procedures (only if
277 -- the proc point is a callPP)
278 -- Due to common blockification, we may overestimate the set of procpoints.
279 let add_label map pp = mapInsert pp lbls map
280 where lbls | pp == entry = (entry_label, fmap cit_lbl (mapLookup entry info_tbls))
281 | otherwise = (block_lbl, guard (setMember pp callPPs) >>
282 Just info_table_lbl)
283 where block_lbl = blockLbl pp
284 info_table_lbl = infoTblLbl pp
285
286 procLabels :: LabelMap (CLabel, Maybe CLabel)
287 procLabels = foldl' add_label mapEmpty
288 (filter (flip mapMember (toBlockMap g)) (setElems procPoints))
289
290 -- In each new graph, add blocks jumping off to the new procedures,
291 -- and replace branches to procpoints with branches to the jump-off blocks
292 let add_jump_block :: (LabelMap Label, [CmmBlock])
293 -> (Label, CLabel)
294 -> UniqSM (LabelMap Label, [CmmBlock])
295 add_jump_block (env, bs) (pp, l) = do
296 bid <- liftM mkBlockId getUniqueM
297 let b = blockJoin (CmmEntry bid GlobalScope) emptyBlock jump
298 live = ppLiveness pp
299 jump = CmmCall (CmmLit (CmmLabel l)) Nothing live 0 0 0
300 return (mapInsert pp bid env, b : bs)
301
302 -- when jumping to a PP that has an info table, if
303 -- tablesNextToCode is off we must jump to the entry
304 -- label instead.
305 let tablesNextToCode = platformTablesNextToCode platform
306
307 let jump_label (Just info_lbl) _
308 | tablesNextToCode = info_lbl
309 | otherwise = toEntryLbl platform info_lbl
310 jump_label Nothing block_lbl = block_lbl
311
312 let add_if_pp id rst =
313 case mapLookup id procLabels of
314 Just (lbl, mb_info_lbl) -> (id, jump_label mb_info_lbl lbl) : rst
315 Nothing -> rst
316
317 let add_if_branch_to_pp :: CmmBlock -> [(BlockId, CLabel)] -> [(BlockId, CLabel)]
318 add_if_branch_to_pp block rst =
319 case lastNode block of
320 CmmBranch id -> add_if_pp id rst
321 CmmCondBranch _ ti fi _ -> add_if_pp ti (add_if_pp fi rst)
322 CmmSwitch _ ids -> foldr add_if_pp rst $ switchTargetsToList ids
323 _ -> rst
324
325 let add_jumps :: LabelMap CmmGraph -> (Label, LabelMap CmmBlock) -> UniqSM (LabelMap CmmGraph)
326 add_jumps newGraphEnv (ppId, blockEnv) = do
327 -- find which procpoints we currently branch to
328 let needed_jumps = mapFoldr add_if_branch_to_pp [] blockEnv
329
330 (jumpEnv, jumpBlocks) <-
331 foldM add_jump_block (mapEmpty, []) needed_jumps
332 -- update the entry block
333 let b = expectJust "block in env" $ mapLookup ppId blockEnv
334 blockEnv' = mapInsert ppId b blockEnv
335 -- replace branches to procpoints with branches to jumps
336 blockEnv'' = toBlockMap $ replaceBranches jumpEnv $ ofBlockMap ppId blockEnv'
337 -- add the jump blocks to the graph
338 blockEnv''' = foldl' (flip addBlock) blockEnv'' jumpBlocks
339 let g' = ofBlockMap ppId blockEnv'''
340 -- pprTrace "g' pre jumps" (ppr g') $ do
341 return (mapInsert ppId g' newGraphEnv)
342
343 graphEnv <- foldM add_jumps mapEmpty $ mapToList graphEnv
344
345 let to_proc (bid, g)
346 | bid == entry
347 = CmmProc (TopInfo {info_tbls = info_tbls,
348 stack_info = stack_info})
349 top_l live g'
350 | otherwise
351 = case expectJust "pp label" $ mapLookup bid procLabels of
352 (lbl, Just info_lbl)
353 -> CmmProc (TopInfo { info_tbls = mapSingleton (g_entry g) (mkEmptyContInfoTable info_lbl)
354 , stack_info=stack_info})
355 lbl live g'
356 (lbl, Nothing)
357 -> CmmProc (TopInfo {info_tbls = mapEmpty, stack_info=stack_info})
358 lbl live g'
359 where
360 g' = replacePPIds g
361 live = ppLiveness (g_entry g')
362 stack_info = StackInfo { arg_space = 0
363 , do_layout = True }
364 -- cannot use panic, this is printed by -ddump-cmm
365
366 -- References to procpoint IDs can now be replaced with the
367 -- infotable's label
368 replacePPIds g = {-# SCC "replacePPIds" #-}
369 mapGraphNodes (id, mapExp repl, mapExp repl) g
370 where repl e@(CmmLit (CmmBlock bid)) =
371 case mapLookup bid procLabels of
372 Just (_, Just info_lbl) -> CmmLit (CmmLabel info_lbl)
373 _ -> e
374 repl e = e
375
376 -- The C back end expects to see return continuations before the
377 -- call sites. Here, we sort them in reverse order -- it gets
378 -- reversed later.
379 let add_block_num (i, map) block =
380 (i + 1, mapInsert (entryLabel block) i map)
381 let (_, block_order) =
382 foldl' add_block_num (0::Int, mapEmpty :: LabelMap Int)
383 (revPostorder g)
384 let sort_fn (bid, _) (bid', _) =
385 compare (expectJust "block_order" $ mapLookup bid block_order)
386 (expectJust "block_order" $ mapLookup bid' block_order)
387
388 return $ map to_proc $ sortBy sort_fn $ mapToList graphEnv
389
390 -- Only called from GHC.Cmm.ProcPoint.splitAtProcPoints. NB. does a
391 -- recursive lookup, see comment below.
392 replaceBranches :: LabelMap BlockId -> CmmGraph -> CmmGraph
393 replaceBranches env cmmg
394 = {-# SCC "replaceBranches" #-}
395 ofBlockMap (g_entry cmmg) $ mapMap f $ toBlockMap cmmg
396 where
397 f block = replaceLastNode block $ last (lastNode block)
398
399 last :: CmmNode O C -> CmmNode O C
400 last (CmmBranch id) = CmmBranch (lookup id)
401 last (CmmCondBranch e ti fi l) = CmmCondBranch e (lookup ti) (lookup fi) l
402 last (CmmSwitch e ids) = CmmSwitch e (mapSwitchTargets lookup ids)
403 last l@(CmmCall {}) = l { cml_cont = Nothing }
404 -- NB. remove the continuation of a CmmCall, since this
405 -- label will now be in a different CmmProc. Not only
406 -- is this tidier, it stops CmmLint from complaining.
407 last l@(CmmForeignCall {}) = l
408 lookup id = fmap lookup (mapLookup id env) `orElse` id
409 -- XXX: this is a recursive lookup, it follows chains
410 -- until the lookup returns Nothing, at which point we
411 -- return the last BlockId
412
413 -- --------------------------------------------------------------
414 -- Not splitting proc points: add info tables for continuations
415
416 attachContInfoTables :: ProcPointSet -> CmmDecl -> CmmDecl
417 attachContInfoTables call_proc_points (CmmProc top_info top_l live g)
418 = CmmProc top_info{info_tbls = info_tbls'} top_l live g
419 where
420 info_tbls' = mapUnion (info_tbls top_info) $
421 mapFromList [ (l, mkEmptyContInfoTable (infoTblLbl l))
422 | l <- setElems call_proc_points
423 , l /= g_entry g ]
424 attachContInfoTables _ other_decl
425 = other_decl
426
427 ----------------------------------------------------------------
428
429 {-
430 Note [Direct reachability]
431
432 Block B is directly reachable from proc point P iff control can flow
433 from P to B without passing through an intervening proc point.
434 -}
435
436 ----------------------------------------------------------------
437
438 {-
439 Note [No simple dataflow]
440
441 Sadly, it seems impossible to compute the proc points using a single
442 dataflow pass. One might attempt to use this simple lattice:
443
444 data Location = Unknown
445 | InProc BlockId -- node is in procedure headed by the named proc point
446 | ProcPoint -- node is itself a proc point
447
448 At a join, a node in two different blocks becomes a proc point.
449 The difficulty is that the change of information during iterative
450 computation may promote a node prematurely. Here's a program that
451 illustrates the difficulty:
452
453 f () {
454 entry:
455 ....
456 L1:
457 if (...) { ... }
458 else { ... }
459
460 L2: if (...) { g(); goto L1; }
461 return x + y;
462 }
463
464 The only proc-point needed (besides the entry) is L1. But in an
465 iterative analysis, consider what happens to L2. On the first pass
466 through, it rises from Unknown to 'InProc entry', but when L1 is
467 promoted to a proc point (because it's the successor of g()), L1's
468 successors will be promoted to 'InProc L1'. The problem hits when the
469 new fact 'InProc L1' flows into L2 which is already bound to 'InProc entry'.
470 The join operation makes it a proc point when in fact it needn't be,
471 because its immediate dominator L1 is already a proc point and there
472 are no other proc points that directly reach L2.
473 -}
474
475
476
477 {- Note [Separate Adams optimization]
478 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
479 It may be worthwhile to attempt the Adams optimization by rewriting
480 the graph before the assignment of proc-point protocols. Here are a
481 couple of rules:
482
483 g() returns to k; g() returns to L;
484 k: CopyIn c ress; goto L:
485 ... ==> ...
486 L: // no CopyIn node here L: CopyIn c ress;
487
488
489 And when c == c' and ress == ress', this also:
490
491 g() returns to k; g() returns to L;
492 k: CopyIn c ress; goto L:
493 ... ==> ...
494 L: CopyIn c' ress' L: CopyIn c' ress' ;
495
496 In both cases the goal is to eliminate k.
497 -}