5 #include "HsVersions.h"
15 -- Determine the proc points for a set of basic blocks.
17 -- A proc point is any basic block that must start a new function.
18 -- The entry block of the original function is a proc point.
19 -- The continuation of a function call is also a proc point.
20 -- The third kind of proc point arises when there is a joint point
21 -- in the control flow. Suppose we have code like the following:
23 -- if (...) { ...; call foo(); ...}
24 -- else { ...; call bar(); ...}
27 -- That last statement "x = y" must be a proc point because
28 -- it can be reached by blocks owned by different proc points
29 -- (the two branches of the conditional).
31 -- We calculate these proc points by starting with the minimal set
32 -- and finding blocks that are reachable from more proc points than
33 -- one of their parents. (This ensures we don't choose a block
34 -- simply beause it is reachable from another block that is reachable
35 -- from multiple proc points.) These new blocks are added to the
36 -- set of proc points and the process is repeated until there
37 -- are no more proc points to be found.
39 calculateProcPoints :: [BrokenBlock] -> UniqSet BlockId
40 calculateProcPoints blocks =
41 calculateProcPoints' init_proc_points blocks
43 init_proc_points = mkUniqSet $
45 filter always_proc_point blocks
46 always_proc_point BrokenBlock {
47 brokenBlockEntry = FunctionEntry _ _ _ } = True
48 always_proc_point BrokenBlock {
49 brokenBlockEntry = ContinuationEntry _ _ _ } = True
50 always_proc_point _ = False
52 calculateProcPoints' :: UniqSet BlockId -> [BrokenBlock] -> UniqSet BlockId
53 calculateProcPoints' old_proc_points blocks =
54 if sizeUniqSet old_proc_points == sizeUniqSet new_proc_points
56 else calculateProcPoints' new_proc_points blocks
58 blocks_ufm :: BlockEnv BrokenBlock
59 blocks_ufm = blocksToBlockEnv blocks
61 owners = calculateOwnership blocks_ufm old_proc_points blocks
65 map (calculateNewProcPoints owners) blocks)
67 calculateNewProcPoints :: BlockEnv (UniqSet BlockId)
70 calculateNewProcPoints owners block =
71 unionManyUniqSets (map (maybe_proc_point parent_id) child_ids)
73 parent_id = brokenBlockId block
74 child_ids = brokenBlockTargets block
75 maybe_proc_point parent_id child_id =
77 then unitUniqSet child_id
80 parent_owners = lookupWithDefaultUFM owners emptyUniqSet parent_id
81 child_owners = lookupWithDefaultUFM owners emptyUniqSet child_id
83 -- only if parent isn't dead
84 (not $ isEmptyUniqSet parent_owners) &&
85 -- and only if child has more owners than parent
86 (not $ isEmptyUniqSet $
87 child_owners `minusUniqSet` parent_owners)
89 calculateOwnership :: BlockEnv BrokenBlock
92 -> BlockEnv (UniqSet BlockId)
93 calculateOwnership blocks_ufm proc_points blocks =
94 fixedpoint dependants update (map brokenBlockId blocks) emptyUFM
96 dependants :: BlockId -> [BlockId]
98 brokenBlockTargets $ lookupWithDefaultUFM
99 blocks_ufm unknown_block ident
103 -> BlockEnv (UniqSet BlockId)
104 -> Maybe (BlockEnv (UniqSet BlockId))
105 update ident cause owners =
106 case (cause, ident `elementOfUniqSet` proc_points) of
108 Just $ addToUFM owners ident (unitUniqSet ident)
109 (Nothing, False) -> Nothing
110 (Just cause', True) -> Nothing
111 (Just cause', False) ->
112 if (sizeUniqSet old) == (sizeUniqSet new)
114 else Just $ addToUFM owners ident new
116 old = lookupWithDefaultUFM owners emptyUniqSet ident
117 new = old `unionUniqSets`
118 lookupWithDefaultUFM owners emptyUniqSet cause'
120 unknown_block = panic "unknown BlockId in calculateOwnership"