1 module CmmBrokenBlock (
6 cmmBlockFromBrokenBlock,
11 makeContinuationEntries,
14 #include "HsVersions.h"
19 import MachOp (MachHint(..))
21 import CgUtils (callerSaveVolatileRegs)
31 -- This module takes a 'CmmBasicBlock' which might have 'CmmCall'
32 -- statements in it with 'CmmSafe' set and breaks it up at each such call.
33 -- It also collects information about the block for later use
34 -- by the CPS algorithm.
36 -----------------------------------------------------------------------------
38 -----------------------------------------------------------------------------
40 -- |Similar to a 'CmmBlock' with a little extra information
41 -- to help the CPS analysis.
44 brokenBlockId :: BlockId, -- ^ The block's label like a 'CmmBasicBlock'
45 brokenBlockEntry :: BlockEntryInfo,
46 -- ^ Ways this block can be entered
48 brokenBlockStmts :: [CmmStmt],
49 -- ^ Body like a CmmBasicBlock
50 -- (but without the last statement)
52 brokenBlockTargets :: [BlockId],
53 -- ^ Blocks that this block could
54 -- branch to either by conditional
55 -- branches or via the last statement
57 brokenBlockExit :: FinalStmt
58 -- ^ The final statement of the block
61 -- | How a block could be entered
62 -- See Note [An example of CPS conversion]
64 = FunctionEntry -- ^ Block is the beginning of a function
65 CmmInfo -- ^ Function header info
66 CLabel -- ^ The function name
67 CmmFormals -- ^ Aguments to function
68 -- Only the formal parameters are live
70 | ContinuationEntry -- ^ Return point of a function call
71 CmmFormals -- ^ return values (argument to continuation)
72 C_SRT -- ^ SRT for the continuation's info table
73 Bool -- ^ True <=> GC block so ignore stack size
74 -- Live variables, other than
75 -- the return values, are on the stack
77 | ControlEntry -- ^ Any other kind of block.
78 -- Only entered due to control flow.
80 -- TODO: Consider adding ProcPointEntry
81 -- no return values, but some live might end up as
82 -- params or possibly in the frame
84 {- Note [An example of CPS conversion]
86 This is NR's and SLPJ's guess about how things might work;
87 it may not be consistent with the actual code (particularly
88 in the matter of what's in parameters and what's on the stack).
93 L: if x>1 then y = g(y)
99 f(x,y) { // FunctionEntry
103 if x>1 then push x; push f1; jump g(y)
104 else x=x+1; jump f2(x, y)
107 f1(y) { // ContinuationEntry
108 pop x; jump f2(x, y);
111 f2(x, y) { // ProcPointEntry
117 data ContFormat = ContFormat
118 CmmHintFormals -- ^ return values (argument to continuation)
119 C_SRT -- ^ SRT for the continuation's info table
120 Bool -- ^ True <=> GC block so ignore stack size
123 -- | Final statement in a 'BlokenBlock'.
124 -- Constructors and arguments match those in 'Cmm',
125 -- but are restricted to branches, returns, jumps, calls and switches
127 = FinalBranch -- ^ Same as 'CmmBranch'
128 BlockId -- ^ Target must be a ControlEntry
130 | FinalReturn -- ^ Same as 'CmmReturn'
131 CmmActuals -- ^ Return values
133 | FinalJump -- ^ Same as 'CmmJump'
134 CmmExpr -- ^ The function to call
135 CmmActuals -- ^ Arguments of the call
137 | FinalCall -- ^ Same as 'CmmCallee'
138 -- followed by 'CmmGoto'
139 BlockId -- ^ Target of the 'CmmGoto'
140 -- (must be a 'ContinuationEntry')
141 CmmCallTarget -- ^ The function to call
142 CmmHintFormals -- ^ Results from call
143 -- (redundant with ContinuationEntry)
144 CmmActuals -- ^ Arguments to call
145 C_SRT -- ^ SRT for the continuation's info table
146 Bool -- ^ True <=> GC block so ignore stack size
148 | FinalSwitch -- ^ Same as a 'CmmSwitch'
149 CmmExpr -- ^ Scrutinee (zero based)
150 [Maybe BlockId] -- ^ Targets
152 -----------------------------------------------------------------------------
153 -- Operations for broken blocks
154 -----------------------------------------------------------------------------
156 -- Naively breaking at *every* CmmCall leads to sub-optimal code.
157 -- In particular, a CmmCall followed by a CmmBranch would result
158 -- in a continuation that has the single CmmBranch statement in it.
159 -- It would be better have the CmmCall directly return to the block
160 -- that the branch jumps to.
162 -- This requires the target of the branch to look like the parameter
163 -- format that the CmmCall is expecting. If other CmmCall/CmmBranch
164 -- sequences go to the same place they might not be expecting the
165 -- same format. So this transformation uses the following solution.
166 -- First the blocks are broken up but none of the blocks are marked
167 -- as continuations yet. This is the 'breakBlock' function.
168 -- Second, the blocks "vote" on what other blocks need to be continuations
169 -- and how they should be layed out. Plurality wins, but other selection
170 -- methods could be selected at a later time.
171 -- This is the 'selectContinuations' function.
172 -- Finally, the blocks are upgraded to 'ContEntry' continuations
173 -- based on the results with the 'makeContinuationEntries' function,
174 -- and the blocks that didn't get the format they wanted for their
175 -- targets get a small adaptor block created for them by
176 -- the 'adaptBlockToFormat' function.
180 [BlockId] -- ^ Any GC blocks that should be special
181 -> [[Unique]] -- ^ An infinite list of uniques
182 -- to create names of the new blocks with
183 -> CmmInfo -- ^ Info table for the procedure
184 -> CLabel -- ^ Name of the procedure
185 -> CmmFormals -- ^ Parameters of the procedure
186 -> [CmmBasicBlock] -- ^ Blocks of the procecure
187 -- (First block is the entry block)
190 breakProc gc_block_idents uniques info ident params blocks =
192 (adaptor_uniques : block_uniques) = uniques
194 broken_blocks :: ([(BlockId, ContFormat)], [BrokenBlock])
197 zipWith3 (breakBlock gc_block_idents)
200 (FunctionEntry info ident params :
202 in (concatMap fst new_blocks, concatMap snd new_blocks)
204 selected = selectContinuations (fst broken_blocks)
206 in map (makeContinuationEntries selected) $
208 zipWith (adaptBlockToFormat selected)
212 -----------------------------------------------------------------------------
213 -- | Takes a 'CmmBasicBlock' and breaks it up into a list of 'BrokenBlock'
214 -- by splitting on each 'CmmCall' in the 'CmmBasicBlock'.
217 [BlockId] -- ^ Any GC blocks that should be special
218 -> [Unique] -- ^ An infinite list of uniques
219 -- to create names of the new blocks with
220 -> CmmBasicBlock -- ^ Input block to break apart
221 -> BlockEntryInfo -- ^ Info for the first created 'BrokenBlock'
222 -> ([(BlockId, ContFormat)], [BrokenBlock])
223 breakBlock gc_block_idents uniques (BasicBlock ident stmts) entry =
224 breakBlock' uniques ident entry [] [] stmts
226 breakBlock' uniques current_id entry exits accum_stmts stmts =
228 [] -> panic "block doesn't end in jump, goto, return or switch"
230 -- Last statement. Make the 'BrokenBlock'
231 [CmmJump target arguments] ->
233 [BrokenBlock current_id entry accum_stmts
235 (FinalJump target arguments)])
236 [CmmReturn arguments] ->
238 [BrokenBlock current_id entry accum_stmts
240 (FinalReturn arguments)])
241 [CmmBranch target] ->
243 [BrokenBlock current_id entry accum_stmts
245 (FinalBranch target)])
246 [CmmSwitch expr targets] ->
248 [BrokenBlock current_id entry accum_stmts
249 (mapMaybe id targets ++ exits)
250 (FinalSwitch expr targets)])
252 -- These shouldn't happen in the middle of a block.
253 -- They would cause dead code.
254 (CmmJump _ _:_) -> panic "jump in middle of block"
255 (CmmReturn _:_) -> panic "return in middle of block"
256 (CmmBranch _:_) -> panic "branch in middle of block"
257 (CmmSwitch _ _:_) -> panic "switch in middle of block"
259 -- Detect this special case to remain an inverse of
260 -- 'cmmBlockFromBrokenBlock'
261 [CmmCall target results arguments (CmmSafe srt),
262 CmmBranch next_id] ->
263 ([cont_info], [block])
265 cont_info = (next_id,
266 ContFormat results srt
267 (ident `elem` gc_block_idents))
268 block = do_call current_id entry accum_stmts exits next_id
269 target results arguments srt
271 -- Break the block on safe calls (the main job of this function)
272 (CmmCall target results arguments (CmmSafe srt) : stmts) ->
273 (cont_info : cont_infos, block : blocks)
275 next_id = BlockId $ head uniques
276 block = do_call current_id entry accum_stmts exits next_id
277 target results arguments srt
279 cont_info = (next_id, -- Entry convention for the
280 -- continuation of the call
281 ContFormat results srt
282 (ident `elem` gc_block_idents))
284 -- Break up the part after the call
285 (cont_infos, blocks) = breakBlock' (tail uniques) next_id
286 ControlEntry [] [] stmts
288 -- Unsafe calls don't need a continuation
289 -- but they do need to be expanded
290 (CmmCall target results arguments CmmUnsafe : stmts) ->
291 breakBlock' remaining_uniques current_id entry exits
295 [CmmCall target results new_args CmmUnsafe] ++
299 (remaining_uniques, arg_stmts, new_args) =
300 loadArgsIntoTemps uniques arguments
301 (caller_save, caller_load) = callerSaveVolatileRegs (Just [])
303 -- Default case. Just keep accumulating statements
304 -- and branch targets.
306 breakBlock' uniques current_id entry
307 (cond_branch_target s++exits)
311 do_call current_id entry accum_stmts exits next_id
312 target results arguments srt =
313 BrokenBlock current_id entry accum_stmts (next_id:exits)
314 (FinalCall next_id target results arguments srt
315 (current_id `elem` gc_block_idents))
317 cond_branch_target (CmmCondBranch _ target) = [target]
318 cond_branch_target _ = []
320 -----------------------------------------------------------------------------
322 selectContinuations :: [(BlockId, ContFormat)] -> [(BlockId, ContFormat)]
323 selectContinuations needed_continuations = formats
325 formats = map select_format format_groups
326 format_groups = groupBy by_target needed_continuations
327 by_target x y = fst x == fst y
329 select_format formats = winner
331 winner = head $ head $ sortBy more_votes format_votes
332 format_votes = groupBy by_format formats
333 by_format x y = snd x == snd y
334 more_votes x y = compare (length y) (length x)
335 -- sort so the most votes goes *first*
336 -- (thus the order of x and y is reversed)
338 makeContinuationEntries formats
339 block@(BrokenBlock ident entry stmts targets exit) =
340 case lookup ident formats of
342 Just (ContFormat formals srt is_gc) ->
343 BrokenBlock ident (ContinuationEntry (map fst formals) srt is_gc)
346 adaptBlockToFormat :: [(BlockId, ContFormat)]
350 adaptBlockToFormat formats unique
351 block@(BrokenBlock ident entry stmts targets
352 exit@(FinalCall next target formals
353 actuals srt is_gc)) =
354 if format_formals == formals &&
356 format_is_gc == is_gc
357 then [block] -- Woohoo! This block got the continuation format it wanted
358 else [adaptor_block, revised_block]
359 -- This block didn't get the format it wanted for the
360 -- continuation, so we have to build an adaptor.
362 (ContFormat format_formals format_srt format_is_gc) =
363 maybe unknown_block id $ lookup next formats
364 unknown_block = panic "unknown block in adaptBlockToFormat"
366 revised_block = BrokenBlock ident entry stmts revised_targets revised_exit
367 revised_targets = adaptor_ident : delete next targets
368 revised_exit = FinalCall
369 adaptor_ident -- ^ The only part that changed
370 target formals actuals srt is_gc
372 adaptor_block = mk_adaptor_block adaptor_ident
373 (ContinuationEntry (map fst formals) srt is_gc)
375 adaptor_ident = BlockId unique
377 mk_adaptor_block :: BlockId -> BlockEntryInfo -> BlockId -> CmmHintFormals -> BrokenBlock
378 mk_adaptor_block ident entry next formals =
379 BrokenBlock ident entry [] [next] exit
382 (CmmLit (CmmLabel (mkReturnPtLabel (getUnique next))))
383 (map formal_to_actual format_formals)
385 formal_to_actual (reg, hint) = ((CmmReg (CmmLocal reg)), hint)
386 -- TODO: Check if NoHint is right. We're
387 -- jumping to a C-- function not a foreign one
388 -- so it might always be right.
389 adaptBlockToFormat _ _ block = [block]
391 -----------------------------------------------------------------------------
392 -- | Convert from a BrokenBlock back to an equivalent CmmBasicBlock
393 -- Needed by liveness analysis
394 cmmBlockFromBrokenBlock :: BrokenBlock -> CmmBasicBlock
395 cmmBlockFromBrokenBlock (BrokenBlock ident _ stmts _ exit) =
396 BasicBlock ident (stmts++exit_stmt)
400 FinalBranch target -> [CmmBranch target]
401 FinalReturn arguments -> [CmmReturn arguments]
402 FinalJump target arguments -> [CmmJump target arguments]
403 FinalSwitch expr targets -> [CmmSwitch expr targets]
404 FinalCall branch_target call_target results arguments srt _ ->
405 [CmmCall call_target results arguments (CmmSafe srt),
406 CmmBranch branch_target]
408 -----------------------------------------------------------------------------
409 -- | Build a mapping so we can lookup a 'BrokenBlock' by its 'BlockId'
410 blocksToBlockEnv :: [BrokenBlock] -> BlockEnv BrokenBlock
411 blocksToBlockEnv blocks = listToUFM $ map (\b -> (brokenBlockId b, b)) blocks