1 module CmmBrokenBlock (
6 cmmBlockFromBrokenBlock,
10 #include "HsVersions.h"
22 -- This module takes a 'CmmBasicBlock' which might have 'CmmCall'
23 -- statements in it with 'CmmSafe' set and breaks it up at each such call.
24 -- It also collects information about the block for later use
25 -- by the CPS algorithm.
27 -----------------------------------------------------------------------------
29 -----------------------------------------------------------------------------
31 -- |Similar to a 'CmmBlock' with a little extra information
32 -- to help the CPS analysis.
35 brokenBlockId :: BlockId, -- ^ The block's label like a 'CmmBasicBlock'
36 brokenBlockEntry :: BlockEntryInfo,
37 -- ^ Ways this block can be entered
39 brokenBlockStmts :: [CmmStmt],
40 -- ^ Body like a CmmBasicBlock
41 -- (but without the last statement)
43 brokenBlockTargets :: [BlockId],
44 -- ^ Blocks that this block could
45 -- branch to either by conditional
46 -- branches or via the last statement
48 brokenBlockExit :: FinalStmt
49 -- ^ The final statement of the block
52 -- | How a block could be entered
54 = FunctionEntry -- ^ Block is the beginning of a function
55 CmmInfo -- ^ Function header info
56 CLabel -- ^ The function name
57 CmmFormals -- ^ Aguments to function
59 | ContinuationEntry -- ^ Return point of a function call
60 CmmFormals -- ^ return values (argument to continuation)
61 C_SRT -- ^ SRT for the continuation's info table
63 | ControlEntry -- ^ Any other kind of block.
64 -- Only entered due to control flow.
66 -- TODO: Consider adding ProcPointEntry
67 -- no return values, but some live might end up as
68 -- params or possibly in the frame
71 -- | Final statement in a 'BlokenBlock'.
72 -- Constructors and arguments match those in 'Cmm',
73 -- but are restricted to branches, returns, jumps, calls and switches
75 = FinalBranch -- ^ Same as 'CmmBranch'
76 BlockId -- ^ Target must be a ControlEntry
78 | FinalReturn -- ^ Same as 'CmmReturn'
79 CmmActuals -- ^ Return values
81 | FinalJump -- ^ Same as 'CmmJump'
82 CmmExpr -- ^ The function to call
83 CmmActuals -- ^ Arguments of the call
85 | FinalCall -- ^ Same as 'CmmForeignCall'
86 -- followed by 'CmmGoto'
87 BlockId -- ^ Target of the 'CmmGoto'
88 -- (must be a 'ContinuationEntry')
89 CmmCallTarget -- ^ The function to call
90 CmmHintFormals -- ^ Results from call
91 -- (redundant with ContinuationEntry)
92 CmmActuals -- ^ Arguments to call
94 | FinalSwitch -- ^ Same as a 'CmmSwitch'
95 CmmExpr -- ^ Scrutinee (zero based)
96 [Maybe BlockId] -- ^ Targets
98 -----------------------------------------------------------------------------
99 -- Operations for broken blocks
100 -----------------------------------------------------------------------------
102 -----------------------------------------------------------------------------
103 -- | Takes a 'CmmBasicBlock' and breaks it up into a list of 'BrokenBlock'
104 -- by splitting on each 'CmmCall' in the 'CmmBasicBlock'.
107 [Unique] -- ^ An infinite list of uniques
108 -- to create names of the new blocks with
109 -> CmmBasicBlock -- ^ Input block to break apart
110 -> BlockEntryInfo -- ^ Info for the first created 'BrokenBlock'
112 breakBlock uniques (BasicBlock ident stmts) entry =
113 breakBlock' uniques ident entry [] [] stmts
115 breakBlock' uniques current_id entry exits accum_stmts stmts =
117 [] -> panic "block doesn't end in jump, goto, return or switch"
119 -- Last statement. Make the 'BrokenBlock'
120 [CmmJump target arguments] ->
121 [BrokenBlock current_id entry accum_stmts
123 (FinalJump target arguments)]
124 [CmmReturn arguments] ->
125 [BrokenBlock current_id entry accum_stmts
127 (FinalReturn arguments)]
128 [CmmBranch target] ->
129 [BrokenBlock current_id entry accum_stmts
131 (FinalBranch target)]
132 [CmmSwitch expr targets] ->
133 [BrokenBlock current_id entry accum_stmts
134 (mapMaybe id targets ++ exits)
135 (FinalSwitch expr targets)]
137 -- These shouldn't happen in the middle of a block.
138 -- They would cause dead code.
139 (CmmJump _ _:_) -> panic "jump in middle of block"
140 (CmmReturn _:_) -> panic "return in middle of block"
141 (CmmBranch _:_) -> panic "branch in middle of block"
142 (CmmSwitch _ _:_) -> panic "switch in middle of block"
144 -- Detect this special case to remain an inverse of
145 -- 'cmmBlockFromBrokenBlock'
146 {- TODO: Interferes with proc point detection
147 [CmmCall target results arguments,
148 CmmBranch next_id] -> [block]
150 block = do_call current_id entry accum_stmts exits next_id
151 target results arguments
154 -- Break the block on safe calls (the main job of this function)
155 (CmmCall target results arguments (CmmSafe srt):stmts) ->
158 next_id = BlockId $ head uniques
159 block = do_call current_id entry accum_stmts exits next_id
160 target results arguments
161 rest = breakBlock' (tail uniques) next_id
162 (ContinuationEntry (map fst results) srt)
165 -- Default case. Just keep accumulating statements
166 -- and branch targets.
168 breakBlock' uniques current_id entry
169 (cond_branch_target s++exits)
173 do_call current_id entry accum_stmts exits next_id
174 target results arguments =
175 BrokenBlock current_id entry accum_stmts (next_id:exits)
176 (FinalCall next_id target results arguments)
178 cond_branch_target (CmmCondBranch _ target) = [target]
179 cond_branch_target _ = []
181 -----------------------------------------------------------------------------
182 -- | Convert from a BrokenBlock back to an equivalent CmmBasicBlock
183 -- Needed by liveness analysis
184 cmmBlockFromBrokenBlock :: BrokenBlock -> CmmBasicBlock
185 cmmBlockFromBrokenBlock (BrokenBlock ident _ stmts _ exit) =
186 BasicBlock ident (stmts++exit_stmt)
190 FinalBranch target -> [CmmBranch target]
191 FinalReturn arguments -> [CmmReturn arguments]
192 FinalJump target arguments -> [CmmJump target arguments]
193 FinalSwitch expr targets -> [CmmSwitch expr targets]
194 FinalCall branch_target call_target results arguments ->
195 [CmmCall call_target results arguments (panic "needed SRT from cmmBlockFromBrokenBlock"),
196 CmmBranch branch_target]
198 -----------------------------------------------------------------------------
199 -- | Build a mapping so we can lookup a 'BrokenBlock' by its 'BlockId'
200 blocksToBlockEnv :: [BrokenBlock] -> BlockEnv BrokenBlock
201 blocksToBlockEnv blocks = listToUFM $ map (\b -> (brokenBlockId b, b)) blocks