blob: f7af8caae39d89c6a2d02dd1534ff7484bebc177 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
|
{-# OPTIONS_GHC -w #-}
-- The above warning supression flag is a temporary kludge.
-- While working on this module you are encouraged to remove it and fix
-- any warnings in the module. See
-- http://hackage.haskell.org/trac/ghc/wiki/WorkingConventions#Warnings
-- for details
module CmmProcPoint (
calculateProcPoints
) where
#include "HsVersions.h"
import Cmm
import CmmBrokenBlock
import Dataflow
import UniqSet
import UniqFM
import Panic
-- Determine the proc points for a set of basic blocks.
--
-- A proc point is any basic block that must start a new function.
-- The entry block of the original function is a proc point.
-- The continuation of a function call is also a proc point.
-- The third kind of proc point arises when there is a joint point
-- in the control flow. Suppose we have code like the following:
--
-- if (...) { ...; call foo(); ...}
-- else { ...; call bar(); ...}
-- x = y;
--
-- That last statement "x = y" must be a proc point because
-- it can be reached by blocks owned by different proc points
-- (the two branches of the conditional).
--
-- We calculate these proc points by starting with the minimal set
-- and finding blocks that are reachable from more proc points than
-- one of their parents. (This ensures we don't choose a block
-- simply beause it is reachable from another block that is reachable
-- from multiple proc points.) These new blocks are added to the
-- set of proc points and the process is repeated until there
-- are no more proc points to be found.
calculateProcPoints :: [BrokenBlock] -> UniqSet BlockId
calculateProcPoints blocks =
calculateProcPoints' init_proc_points blocks
where
init_proc_points = mkUniqSet $
map brokenBlockId $
filter always_proc_point blocks
always_proc_point BrokenBlock {
brokenBlockEntry = FunctionEntry _ _ _ } = True
always_proc_point BrokenBlock {
brokenBlockEntry = ContinuationEntry _ _ _ } = True
always_proc_point _ = False
calculateProcPoints' :: UniqSet BlockId -> [BrokenBlock] -> UniqSet BlockId
calculateProcPoints' old_proc_points blocks =
if sizeUniqSet old_proc_points == sizeUniqSet new_proc_points
then old_proc_points
else calculateProcPoints' new_proc_points blocks
where
blocks_ufm :: BlockEnv BrokenBlock
blocks_ufm = blocksToBlockEnv blocks
owners = calculateOwnership blocks_ufm old_proc_points blocks
new_proc_points =
unionManyUniqSets
(old_proc_points:
map (calculateNewProcPoints owners) blocks)
calculateNewProcPoints :: BlockEnv (UniqSet BlockId)
-> BrokenBlock
-> UniqSet BlockId
calculateNewProcPoints owners block =
unionManyUniqSets (map (maybe_proc_point parent_id) child_ids)
where
parent_id = brokenBlockId block
child_ids = brokenBlockTargets block
maybe_proc_point parent_id child_id =
if needs_proc_point
then unitUniqSet child_id
else emptyUniqSet
where
parent_owners = lookupWithDefaultUFM owners emptyUniqSet parent_id
child_owners = lookupWithDefaultUFM owners emptyUniqSet child_id
needs_proc_point =
-- only if parent isn't dead
(not $ isEmptyUniqSet parent_owners) &&
-- and only if child has more owners than parent
(not $ isEmptyUniqSet $
child_owners `minusUniqSet` parent_owners)
calculateOwnership :: BlockEnv BrokenBlock
-> UniqSet BlockId
-> [BrokenBlock]
-> BlockEnv (UniqSet BlockId)
calculateOwnership blocks_ufm proc_points blocks =
fixedpoint dependants update (map brokenBlockId blocks) emptyUFM
where
dependants :: BlockId -> [BlockId]
dependants ident =
brokenBlockTargets $ lookupWithDefaultUFM
blocks_ufm unknown_block ident
update :: BlockId
-> Maybe BlockId
-> BlockEnv (UniqSet BlockId)
-> Maybe (BlockEnv (UniqSet BlockId))
update ident cause owners =
case (cause, ident `elementOfUniqSet` proc_points) of
(Nothing, True) ->
Just $ addToUFM owners ident (unitUniqSet ident)
(Nothing, False) -> Nothing
(Just cause', True) -> Nothing
(Just cause', False) ->
if (sizeUniqSet old) == (sizeUniqSet new)
then Nothing
else Just $ addToUFM owners ident new
where
old = lookupWithDefaultUFM owners emptyUniqSet ident
new = old `unionUniqSets`
lookupWithDefaultUFM owners emptyUniqSet cause'
unknown_block = panic "unknown BlockId in calculateOwnership"
|
