1 module CmmBrokenBlock (
6 cmmBlockFromBrokenBlock,
11 makeContinuationEntries,
14 #include "HsVersions.h"
18 import MachOp (MachHint(..))
29 -- This module takes a 'CmmBasicBlock' which might have 'CmmCall'
30 -- statements in it with 'CmmSafe' set and breaks it up at each such call.
31 -- It also collects information about the block for later use
32 -- by the CPS algorithm.
34 -----------------------------------------------------------------------------
36 -----------------------------------------------------------------------------
38 -- |Similar to a 'CmmBlock' with a little extra information
39 -- to help the CPS analysis.
42 brokenBlockId :: BlockId, -- ^ The block's label like a 'CmmBasicBlock'
43 brokenBlockEntry :: BlockEntryInfo,
44 -- ^ Ways this block can be entered
46 brokenBlockStmts :: [CmmStmt],
47 -- ^ Body like a CmmBasicBlock
48 -- (but without the last statement)
50 brokenBlockTargets :: [BlockId],
51 -- ^ Blocks that this block could
52 -- branch to either by conditional
53 -- branches or via the last statement
55 brokenBlockExit :: FinalStmt
56 -- ^ The final statement of the block
59 -- | How a block could be entered
61 = FunctionEntry -- ^ Block is the beginning of a function
62 CmmInfo -- ^ Function header info
63 CLabel -- ^ The function name
64 CmmFormals -- ^ Aguments to function
66 | ContinuationEntry -- ^ Return point of a function call
67 CmmFormals -- ^ return values (argument to continuation)
68 C_SRT -- ^ SRT for the continuation's info table
69 Bool -- ^ True <=> GC block so ignore stack size
71 | ControlEntry -- ^ Any other kind of block.
72 -- Only entered due to control flow.
74 -- TODO: Consider adding ProcPointEntry
75 -- no return values, but some live might end up as
76 -- params or possibly in the frame
78 data ContFormat = ContFormat
79 CmmHintFormals -- ^ return values (argument to continuation)
80 C_SRT -- ^ SRT for the continuation's info table
81 Bool -- ^ True <=> GC block so ignore stack size
84 -- | Final statement in a 'BlokenBlock'.
85 -- Constructors and arguments match those in 'Cmm',
86 -- but are restricted to branches, returns, jumps, calls and switches
88 = FinalBranch -- ^ Same as 'CmmBranch'
89 BlockId -- ^ Target must be a ControlEntry
91 | FinalReturn -- ^ Same as 'CmmReturn'
92 CmmActuals -- ^ Return values
94 | FinalJump -- ^ Same as 'CmmJump'
95 CmmExpr -- ^ The function to call
96 CmmActuals -- ^ Arguments of the call
98 | FinalCall -- ^ Same as 'CmmForeignCall'
99 -- followed by 'CmmGoto'
100 BlockId -- ^ Target of the 'CmmGoto'
101 -- (must be a 'ContinuationEntry')
102 CmmCallTarget -- ^ The function to call
103 CmmHintFormals -- ^ Results from call
104 -- (redundant with ContinuationEntry)
105 CmmActuals -- ^ Arguments to call
106 C_SRT -- ^ SRT for the continuation's info table
107 Bool -- ^ True <=> GC block so ignore stack size
109 | FinalSwitch -- ^ Same as a 'CmmSwitch'
110 CmmExpr -- ^ Scrutinee (zero based)
111 [Maybe BlockId] -- ^ Targets
113 -----------------------------------------------------------------------------
114 -- Operations for broken blocks
115 -----------------------------------------------------------------------------
117 -- Naively breaking at *every* CmmCall leads to sub-optimal code.
118 -- In particular, a CmmCall followed by a CmmBranch would result
119 -- in a continuation that has the single CmmBranch statement in it.
120 -- It would be better have the CmmCall directly return to the block
121 -- that the branch jumps to.
123 -- This requires the target of the branch to look like the parameter
124 -- format that the CmmCall is expecting. If other CmmCall/CmmBranch
125 -- sequences go to the same place they might not be expecting the
126 -- same format. So this transformation uses the following solution.
127 -- First the blocks are broken up but none of the blocks are marked
128 -- as continuations yet. This is the 'breakBlock' function.
129 -- Second, the blocks "vote" on what other blocks need to be continuations
130 -- and how they should be layed out. Plurality wins, but other selection
131 -- methods could be selected at a later time.
132 -- This is the 'selectContinuations' function.
133 -- Finally, the blocks are upgraded to 'ContEntry' continuations
134 -- based on the results with the 'makeContinuationEntries' function,
135 -- and the blocks that didn't get the format they wanted for their
136 -- targets get a small adaptor block created for them by
137 -- the 'adaptBlockToFormat' function.
141 [BlockId] -- ^ Any GC blocks that should be special
142 -> [[Unique]] -- ^ An infinite list of uniques
143 -- to create names of the new blocks with
144 -> CmmInfo -- ^ Info table for the procedure
145 -> CLabel -- ^ Name of the procedure
146 -> CmmFormals -- ^ Parameters of the procedure
147 -> [CmmBasicBlock] -- ^ Blocks of the procecure
148 -- (First block is the entry block)
151 breakProc gc_block_idents uniques info ident params blocks =
153 (adaptor_uniques : block_uniques) = uniques
155 broken_blocks :: ([(BlockId, ContFormat)], [BrokenBlock])
158 zipWith3 (breakBlock gc_block_idents)
161 (FunctionEntry info ident params :
163 in (concatMap fst new_blocks, concatMap snd new_blocks)
165 selected = selectContinuations (fst broken_blocks)
167 in map (makeContinuationEntries selected) $
169 zipWith (adaptBlockToFormat selected)
173 -----------------------------------------------------------------------------
174 -- | Takes a 'CmmBasicBlock' and breaks it up into a list of 'BrokenBlock'
175 -- by splitting on each 'CmmCall' in the 'CmmBasicBlock'.
178 [BlockId] -- ^ Any GC blocks that should be special
179 -> [Unique] -- ^ An infinite list of uniques
180 -- to create names of the new blocks with
181 -> CmmBasicBlock -- ^ Input block to break apart
182 -> BlockEntryInfo -- ^ Info for the first created 'BrokenBlock'
183 -> ([(BlockId, ContFormat)], [BrokenBlock])
184 breakBlock gc_block_idents uniques (BasicBlock ident stmts) entry =
185 breakBlock' uniques ident entry [] [] stmts
187 breakBlock' uniques current_id entry exits accum_stmts stmts =
189 [] -> panic "block doesn't end in jump, goto, return or switch"
191 -- Last statement. Make the 'BrokenBlock'
192 [CmmJump target arguments] ->
194 [BrokenBlock current_id entry accum_stmts
196 (FinalJump target arguments)])
197 [CmmReturn arguments] ->
199 [BrokenBlock current_id entry accum_stmts
201 (FinalReturn arguments)])
202 [CmmBranch target] ->
204 [BrokenBlock current_id entry accum_stmts
206 (FinalBranch target)])
207 [CmmSwitch expr targets] ->
209 [BrokenBlock current_id entry accum_stmts
210 (mapMaybe id targets ++ exits)
211 (FinalSwitch expr targets)])
213 -- These shouldn't happen in the middle of a block.
214 -- They would cause dead code.
215 (CmmJump _ _:_) -> panic "jump in middle of block"
216 (CmmReturn _:_) -> panic "return in middle of block"
217 (CmmBranch _:_) -> panic "branch in middle of block"
218 (CmmSwitch _ _:_) -> panic "switch in middle of block"
220 -- Detect this special case to remain an inverse of
221 -- 'cmmBlockFromBrokenBlock'
222 [CmmCall target results arguments (CmmSafe srt),
223 CmmBranch next_id] ->
224 ([cont_info], [block])
226 cont_info = (next_id,
227 ContFormat results srt
228 (ident `elem` gc_block_idents))
229 block = do_call current_id entry accum_stmts exits next_id
230 target results arguments srt
232 -- Break the block on safe calls (the main job of this function)
233 (CmmCall target results arguments (CmmSafe srt):stmts) ->
234 (cont_info : cont_infos, block : blocks)
236 next_id = BlockId $ head uniques
237 block = do_call current_id entry accum_stmts exits next_id
238 target results arguments srt
239 cont_info = (next_id,
240 ContFormat results srt
241 (ident `elem` gc_block_idents))
242 (cont_infos, blocks) = breakBlock' (tail uniques) next_id
243 ControlEntry [] [] stmts
245 -- Default case. Just keep accumulating statements
246 -- and branch targets.
248 breakBlock' uniques current_id entry
249 (cond_branch_target s++exits)
253 do_call current_id entry accum_stmts exits next_id
254 target results arguments srt =
255 BrokenBlock current_id entry accum_stmts (next_id:exits)
256 (FinalCall next_id target results arguments srt
257 (current_id `elem` gc_block_idents))
259 cond_branch_target (CmmCondBranch _ target) = [target]
260 cond_branch_target _ = []
262 -----------------------------------------------------------------------------
264 selectContinuations :: [(BlockId, ContFormat)] -> [(BlockId, ContFormat)]
265 selectContinuations needed_continuations = formats
267 formats = map select_format format_groups
268 format_groups = groupBy by_target needed_continuations
269 by_target x y = fst x == fst y
271 select_format formats = winner
273 winner = head $ head $ sortBy more_votes format_votes
274 format_votes = groupBy by_format formats
275 by_format x y = snd x == snd y
276 more_votes x y = compare (length y) (length x)
277 -- sort so the most votes goes *first*
278 -- (thus the order of x and y is reversed)
280 makeContinuationEntries formats
281 block@(BrokenBlock ident entry stmts targets exit) =
282 case lookup ident formats of
284 Just (ContFormat formals srt is_gc) ->
285 BrokenBlock ident (ContinuationEntry (map fst formals) srt is_gc)
288 adaptBlockToFormat :: [(BlockId, ContFormat)]
292 adaptBlockToFormat formats unique
293 block@(BrokenBlock ident entry stmts targets
294 exit@(FinalCall next target formals
295 actuals srt is_gc)) =
296 if format_formals == formals &&
298 format_is_gc == is_gc
299 then [block] -- Woohoo! This block got the continuation format it wanted
300 else [adaptor_block, revised_block]
301 -- This block didn't get the format it wanted for the
302 -- continuation, so we have to build an adaptor.
304 (ContFormat format_formals format_srt format_is_gc) =
305 maybe unknown_block id $ lookup next formats
306 unknown_block = panic "unknown block in adaptBlockToFormat"
308 revised_block = BrokenBlock ident entry stmts revised_targets revised_exit
309 revised_targets = adaptor_ident : delete next targets
310 revised_exit = FinalCall
311 adaptor_ident -- ^ The only part that changed
312 target formals actuals srt is_gc
314 adaptor_block = mk_adaptor_block adaptor_ident
315 (ContinuationEntry (map fst formals) srt is_gc)
317 adaptor_ident = BlockId unique
319 mk_adaptor_block :: BlockId -> BlockEntryInfo -> BlockId -> CmmHintFormals -> BrokenBlock
320 mk_adaptor_block ident entry next formals =
321 BrokenBlock ident entry [] [next] exit
324 (CmmLit (CmmLabel (mkReturnPtLabel (getUnique next))))
325 (map formal_to_actual format_formals)
327 formal_to_actual (reg, hint) = ((CmmReg (CmmLocal reg)), hint)
328 -- TODO: Check if NoHint is right. We're
329 -- jumping to a C-- function not a foreign one
330 -- so it might always be right.
331 adaptBlockToFormat _ _ block = [block]
333 -----------------------------------------------------------------------------
334 -- | Convert from a BrokenBlock back to an equivalent CmmBasicBlock
335 -- Needed by liveness analysis
336 cmmBlockFromBrokenBlock :: BrokenBlock -> CmmBasicBlock
337 cmmBlockFromBrokenBlock (BrokenBlock ident _ stmts _ exit) =
338 BasicBlock ident (stmts++exit_stmt)
342 FinalBranch target -> [CmmBranch target]
343 FinalReturn arguments -> [CmmReturn arguments]
344 FinalJump target arguments -> [CmmJump target arguments]
345 FinalSwitch expr targets -> [CmmSwitch expr targets]
346 FinalCall branch_target call_target results arguments srt _ ->
347 [CmmCall call_target results arguments (CmmSafe srt),
348 CmmBranch branch_target]
350 -----------------------------------------------------------------------------
351 -- | Build a mapping so we can lookup a 'BrokenBlock' by its 'BlockId'
352 blocksToBlockEnv :: [BrokenBlock] -> BlockEnv BrokenBlock
353 blocksToBlockEnv blocks = listToUFM $ map (\b -> (brokenBlockId b, b)) blocks