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 CmmReturnInfo -- ^ Does the function return?
147 Bool -- ^ True <=> GC block so ignore stack size
149 | FinalSwitch -- ^ Same as a 'CmmSwitch'
150 CmmExpr -- ^ Scrutinee (zero based)
151 [Maybe BlockId] -- ^ Targets
153 -----------------------------------------------------------------------------
154 -- Operations for broken blocks
155 -----------------------------------------------------------------------------
157 -- Naively breaking at *every* CmmCall leads to sub-optimal code.
158 -- In particular, a CmmCall followed by a CmmBranch would result
159 -- in a continuation that has the single CmmBranch statement in it.
160 -- It would be better have the CmmCall directly return to the block
161 -- that the branch jumps to.
163 -- This requires the target of the branch to look like the parameter
164 -- format that the CmmCall is expecting. If other CmmCall/CmmBranch
165 -- sequences go to the same place they might not be expecting the
166 -- same format. So this transformation uses the following solution.
167 -- First the blocks are broken up but none of the blocks are marked
168 -- as continuations yet. This is the 'breakBlock' function.
169 -- Second, the blocks "vote" on what other blocks need to be continuations
170 -- and how they should be layed out. Plurality wins, but other selection
171 -- methods could be selected at a later time.
172 -- This is the 'selectContinuations' function.
173 -- Finally, the blocks are upgraded to 'ContEntry' continuations
174 -- based on the results with the 'makeContinuationEntries' function,
175 -- and the blocks that didn't get the format they wanted for their
176 -- targets get a small adaptor block created for them by
177 -- the 'adaptBlockToFormat' function.
181 [BlockId] -- ^ Any GC blocks that should be special
182 -> [[Unique]] -- ^ An infinite list of uniques
183 -- to create names of the new blocks with
184 -> CmmInfo -- ^ Info table for the procedure
185 -> CLabel -- ^ Name of the procedure
186 -> CmmFormals -- ^ Parameters of the procedure
187 -> [CmmBasicBlock] -- ^ Blocks of the procecure
188 -- (First block is the entry block)
191 breakProc gc_block_idents uniques info ident params blocks =
193 (adaptor_uniques : block_uniques) = uniques
195 broken_blocks :: ([(BlockId, ContFormat)], [BrokenBlock])
198 zipWith3 (breakBlock gc_block_idents)
201 (FunctionEntry info ident params :
203 in (concatMap fst new_blocks, concatMap snd new_blocks)
205 selected = selectContinuations (fst broken_blocks)
207 in map (makeContinuationEntries selected) $
209 zipWith (adaptBlockToFormat selected)
213 -----------------------------------------------------------------------------
214 -- | Takes a 'CmmBasicBlock' and breaks it up into a list of 'BrokenBlock'
215 -- by splitting on each 'CmmCall' in the 'CmmBasicBlock'.
218 [BlockId] -- ^ Any GC blocks that should be special
219 -> [Unique] -- ^ An infinite list of uniques
220 -- to create names of the new blocks with
221 -> CmmBasicBlock -- ^ Input block to break apart
222 -> BlockEntryInfo -- ^ Info for the first created 'BrokenBlock'
223 -> ([(BlockId, ContFormat)], [BrokenBlock])
224 breakBlock gc_block_idents uniques (BasicBlock ident stmts) entry =
225 breakBlock' uniques ident entry [] [] stmts
227 breakBlock' uniques current_id entry exits accum_stmts stmts =
229 [] -> panic "block doesn't end in jump, goto, return or switch"
231 -- Last statement. Make the 'BrokenBlock'
232 [CmmJump target arguments] ->
234 [BrokenBlock current_id entry accum_stmts
236 (FinalJump target arguments)])
237 [CmmReturn arguments] ->
239 [BrokenBlock current_id entry accum_stmts
241 (FinalReturn arguments)])
242 [CmmBranch target] ->
244 [BrokenBlock current_id entry accum_stmts
246 (FinalBranch target)])
247 [CmmSwitch expr targets] ->
249 [BrokenBlock current_id entry accum_stmts
250 (mapMaybe id targets ++ exits)
251 (FinalSwitch expr targets)])
253 -- These shouldn't happen in the middle of a block.
254 -- They would cause dead code.
255 (CmmJump _ _:_) -> panic "jump in middle of block"
256 (CmmReturn _:_) -> panic "return in middle of block"
257 (CmmBranch _:_) -> panic "branch in middle of block"
258 (CmmSwitch _ _:_) -> panic "switch in middle of block"
260 -- Detect this special case to remain an inverse of
261 -- 'cmmBlockFromBrokenBlock'
262 [CmmCall target results arguments (CmmSafe srt) ret,
263 CmmBranch next_id] ->
264 ([cont_info], [block])
266 cont_info = (next_id,
267 ContFormat results srt
268 (ident `elem` gc_block_idents))
269 block = do_call current_id entry accum_stmts exits next_id
270 target results arguments srt ret
272 -- Break the block on safe calls (the main job of this function)
273 (CmmCall target results arguments (CmmSafe srt) ret : stmts) ->
274 (cont_info : cont_infos, block : blocks)
276 next_id = BlockId $ head uniques
277 block = do_call current_id entry accum_stmts exits next_id
278 target results arguments srt ret
280 cont_info = (next_id, -- Entry convention for the
281 -- continuation of the call
282 ContFormat results srt
283 (ident `elem` gc_block_idents))
285 -- Break up the part after the call
286 (cont_infos, blocks) = breakBlock' (tail uniques) next_id
287 ControlEntry [] [] stmts
289 -- Unsafe calls don't need a continuation
290 -- but they do need to be expanded
291 (CmmCall target results arguments CmmUnsafe ret : stmts) ->
292 breakBlock' remaining_uniques current_id entry exits
296 [CmmCall target results new_args CmmUnsafe ret] ++
300 (remaining_uniques, arg_stmts, new_args) =
301 loadArgsIntoTemps uniques arguments
302 (caller_save, caller_load) = callerSaveVolatileRegs (Just [])
304 -- Default case. Just keep accumulating statements
305 -- and branch targets.
307 breakBlock' uniques current_id entry
308 (cond_branch_target s++exits)
312 do_call current_id entry accum_stmts exits next_id
313 target results arguments srt ret =
314 BrokenBlock current_id entry accum_stmts (next_id:exits)
315 (FinalCall next_id target results arguments srt ret
316 (current_id `elem` gc_block_idents))
318 cond_branch_target (CmmCondBranch _ target) = [target]
319 cond_branch_target _ = []
321 -----------------------------------------------------------------------------
323 selectContinuations :: [(BlockId, ContFormat)] -> [(BlockId, ContFormat)]
324 selectContinuations needed_continuations = formats
326 formats = map select_format format_groups
327 format_groups = groupBy by_target needed_continuations
328 by_target x y = fst x == fst y
330 select_format formats = winner
332 winner = head $ head $ sortBy more_votes format_votes
333 format_votes = groupBy by_format formats
334 by_format x y = snd x == snd y
335 more_votes x y = compare (length y) (length x)
336 -- sort so the most votes goes *first*
337 -- (thus the order of x and y is reversed)
339 makeContinuationEntries formats
340 block@(BrokenBlock ident entry stmts targets exit) =
341 case lookup ident formats of
343 Just (ContFormat formals srt is_gc) ->
344 BrokenBlock ident (ContinuationEntry (map fst formals) srt is_gc)
347 adaptBlockToFormat :: [(BlockId, ContFormat)]
351 adaptBlockToFormat formats unique
352 block@(BrokenBlock ident entry stmts targets
353 exit@(FinalCall next target formals
354 actuals srt ret is_gc)) =
355 if format_formals == formals &&
357 format_is_gc == is_gc
358 then [block] -- Woohoo! This block got the continuation format it wanted
359 else [adaptor_block, revised_block]
360 -- This block didn't get the format it wanted for the
361 -- continuation, so we have to build an adaptor.
363 (ContFormat format_formals format_srt format_is_gc) =
364 maybe unknown_block id $ lookup next formats
365 unknown_block = panic "unknown block in adaptBlockToFormat"
367 revised_block = BrokenBlock ident entry stmts revised_targets revised_exit
368 revised_targets = adaptor_ident : delete next targets
369 revised_exit = FinalCall
370 adaptor_ident -- ^ The only part that changed
371 target formals actuals srt ret is_gc
373 adaptor_block = mk_adaptor_block adaptor_ident
374 (ContinuationEntry (map fst formals) srt is_gc)
376 adaptor_ident = BlockId unique
378 mk_adaptor_block :: BlockId -> BlockEntryInfo -> BlockId -> CmmHintFormals -> BrokenBlock
379 mk_adaptor_block ident entry next formals =
380 BrokenBlock ident entry [] [next] exit
383 (CmmLit (CmmLabel (mkReturnPtLabel (getUnique next))))
384 (map formal_to_actual format_formals)
386 formal_to_actual (reg, hint) = ((CmmReg (CmmLocal reg)), hint)
387 -- TODO: Check if NoHint is right. We're
388 -- jumping to a C-- function not a foreign one
389 -- so it might always be right.
390 adaptBlockToFormat _ _ block = [block]
392 -----------------------------------------------------------------------------
393 -- | Convert from a BrokenBlock back to an equivalent CmmBasicBlock
394 -- Needed by liveness analysis
395 cmmBlockFromBrokenBlock :: BrokenBlock -> CmmBasicBlock
396 cmmBlockFromBrokenBlock (BrokenBlock ident _ stmts _ exit) =
397 BasicBlock ident (stmts++exit_stmt)
401 FinalBranch target -> [CmmBranch target]
402 FinalReturn arguments -> [CmmReturn arguments]
403 FinalJump target arguments -> [CmmJump target arguments]
404 FinalSwitch expr targets -> [CmmSwitch expr targets]
405 FinalCall branch_target call_target results arguments srt ret _ ->
406 [CmmCall call_target results arguments (CmmSafe srt) ret,
407 CmmBranch branch_target]
409 -----------------------------------------------------------------------------
410 -- | Build a mapping so we can lookup a 'BrokenBlock' by its 'BlockId'
411 blocksToBlockEnv :: [BrokenBlock] -> BlockEnv BrokenBlock
412 blocksToBlockEnv blocks = listToUFM $ map (\b -> (brokenBlockId b, b)) blocks