2 module CmmBrokenBlock (
7 cmmBlockFromBrokenBlock,
12 makeContinuationEntries
15 #include "HsVersions.h"
22 import CgUtils (callerSaveVolatileRegs)
30 -- This module takes a 'CmmBasicBlock' which might have 'CmmCall'
31 -- statements in it with 'CmmSafe' set and breaks it up at each such call.
32 -- It also collects information about the block for later use
33 -- by the CPS algorithm.
35 -----------------------------------------------------------------------------
37 -----------------------------------------------------------------------------
39 -- |Similar to a 'CmmBlock' with a little extra information
40 -- to help the CPS analysis.
43 brokenBlockId :: BlockId, -- ^ The block's label like a 'CmmBasicBlock'
44 brokenBlockEntry :: BlockEntryInfo,
45 -- ^ Ways this block can be entered
47 brokenBlockStmts :: [CmmStmt],
48 -- ^ Body like a CmmBasicBlock
49 -- (but without the last statement)
51 brokenBlockTargets :: [BlockId],
52 -- ^ Blocks that this block could
53 -- branch to either by conditional
54 -- branches or via the last statement
56 brokenBlockExit :: FinalStmt
57 -- ^ The final statement of the block
60 -- | How a block could be entered
61 -- See Note [An example of CPS conversion]
63 = FunctionEntry CmmInfo CLabel CmmFormals
64 -- ^ Block is the beginning of a function, parameters are:
65 -- 1. Function header info
66 -- 2. The function name
67 -- 3. Aguments to function
68 -- Only the formal parameters are live
70 | ContinuationEntry CmmFormals C_SRT Bool
71 -- ^ Return point of a function call, parameters are:
72 -- 1. return values (argument to continuation)
73 -- 2. SRT for the continuation's info table
74 -- 3. True <=> GC block so ignore stack size
75 -- Live variables, other than
76 -- the return values, are on the stack
79 -- ^ Any other kind of block. Only entered due to control flow.
81 -- TODO: Consider adding ProcPointEntry
82 -- no return values, but some live might end up as
83 -- params or possibly in the frame
85 {- Note [An example of CPS conversion]
87 This is NR's and SLPJ's guess about how things might work;
88 it may not be consistent with the actual code (particularly
89 in the matter of what's in parameters and what's on the stack).
94 L: if x>1 then y = g(y)
100 f(x,y) { // FunctionEntry
104 if x>1 then push x; push f1; jump g(y)
105 else x=x+1; jump f2(x, y)
108 f1(y) { // ContinuationEntry
109 pop x; jump f2(x, y);
112 f2(x, y) { // ProcPointEntry
118 data ContFormat = ContFormat HintedCmmFormals C_SRT Bool
120 -- 1. return values (argument to continuation)
121 -- 2. SRT for the continuation's info table
122 -- 3. True <=> GC block so ignore stack size
125 -- | Final statement in a 'BlokenBlock'.
126 -- Constructors and arguments match those in 'Cmm',
127 -- but are restricted to branches, returns, jumps, calls and switches
129 = FinalBranch BlockId
130 -- ^ Same as 'CmmBranch'. Target must be a ControlEntry
132 | FinalReturn HintedCmmActuals
133 -- ^ Same as 'CmmReturn'. Parameter is the return values.
135 | FinalJump CmmExpr HintedCmmActuals
136 -- ^ Same as 'CmmJump'. Parameters:
137 -- 1. The function to call,
138 -- 2. Arguments of the call
140 | FinalCall BlockId CmmCallTarget HintedCmmFormals HintedCmmActuals
141 C_SRT CmmReturnInfo Bool
142 -- ^ Same as 'CmmCallee' followed by 'CmmGoto'. Parameters:
143 -- 1. Target of the 'CmmGoto' (must be a 'ContinuationEntry')
144 -- 2. The function to call
145 -- 3. Results from call (redundant with ContinuationEntry)
146 -- 4. Arguments to call
147 -- 5. SRT for the continuation's info table
148 -- 6. Does the function return?
149 -- 7. True <=> GC block so ignore stack size
151 | FinalSwitch CmmExpr [Maybe BlockId]
152 -- ^ Same as a 'CmmSwitch'. Paremeters:
153 -- 1. Scrutinee (zero based)
156 -----------------------------------------------------------------------------
157 -- Operations for broken blocks
158 -----------------------------------------------------------------------------
160 -- Naively breaking at *every* CmmCall leads to sub-optimal code.
161 -- In particular, a CmmCall followed by a CmmBranch would result
162 -- in a continuation that has the single CmmBranch statement in it.
163 -- It would be better have the CmmCall directly return to the block
164 -- that the branch jumps to.
166 -- This requires the target of the branch to look like the parameter
167 -- format that the CmmCall is expecting. If other CmmCall/CmmBranch
168 -- sequences go to the same place they might not be expecting the
169 -- same format. So this transformation uses the following solution.
170 -- First the blocks are broken up but none of the blocks are marked
171 -- as continuations yet. This is the 'breakBlock' function.
172 -- Second, the blocks "vote" on what other blocks need to be continuations
173 -- and how they should be layed out. Plurality wins, but other selection
174 -- methods could be selected at a later time.
175 -- This is the 'selectContinuations' function.
176 -- Finally, the blocks are upgraded to 'ContEntry' continuations
177 -- based on the results with the 'makeContinuationEntries' function,
178 -- and the blocks that didn't get the format they wanted for their
179 -- targets get a small adaptor block created for them by
180 -- the 'adaptBlockToFormat' function.
184 [BlockId] -- ^ Any GC blocks that should be special
185 -> [[Unique]] -- ^ An infinite list of uniques
186 -- to create names of the new blocks with
187 -> CmmInfo -- ^ Info table for the procedure
188 -> CLabel -- ^ Name of the procedure
189 -> CmmFormals -- ^ Parameters of the procedure
190 -> [CmmBasicBlock] -- ^ Blocks of the procecure
191 -- (First block is the entry block)
194 breakProc gc_block_idents uniques info ident params blocks =
196 (adaptor_uniques : block_uniques) = uniques
198 broken_blocks :: ([(BlockId, ContFormat)], [BrokenBlock])
201 zipWith3 (breakBlock gc_block_idents)
204 (FunctionEntry info ident params :
206 in (concatMap fst new_blocks, concatMap snd new_blocks)
208 selected = selectContinuations (fst broken_blocks)
210 in map (makeContinuationEntries selected) $
212 zipWith (adaptBlockToFormat selected)
216 -----------------------------------------------------------------------------
217 -- | Takes a 'CmmBasicBlock' and breaks it up into a list of 'BrokenBlock'
218 -- by splitting on each 'CmmCall' in the 'CmmBasicBlock'.
221 [BlockId] -- ^ Any GC blocks that should be special
222 -> [Unique] -- ^ An infinite list of uniques
223 -- to create names of the new blocks with
224 -> CmmBasicBlock -- ^ Input block to break apart
225 -> BlockEntryInfo -- ^ Info for the first created 'BrokenBlock'
226 -> ([(BlockId, ContFormat)], [BrokenBlock])
227 breakBlock gc_block_idents uniques (BasicBlock ident stmts) entry =
228 breakBlock' uniques ident entry [] [] stmts
230 breakBlock' uniques current_id entry exits accum_stmts stmts =
232 [] -> panic "block doesn't end in jump, goto, return or switch"
234 -- Last statement. Make the 'BrokenBlock'
235 [CmmJump target arguments] ->
237 [BrokenBlock current_id entry accum_stmts
239 (FinalJump target arguments)])
240 [CmmReturn arguments] ->
242 [BrokenBlock current_id entry accum_stmts
244 (FinalReturn arguments)])
245 [CmmBranch target] ->
247 [BrokenBlock current_id entry accum_stmts
249 (FinalBranch target)])
250 [CmmSwitch expr targets] ->
252 [BrokenBlock current_id entry accum_stmts
253 (mapMaybe id targets ++ exits)
254 (FinalSwitch expr targets)])
256 -- These shouldn't happen in the middle of a block.
257 -- They would cause dead code.
258 (CmmJump _ _:_) -> panic "jump in middle of block"
259 (CmmReturn _:_) -> panic "return in middle of block"
260 (CmmBranch _:_) -> panic "branch in middle of block"
261 (CmmSwitch _ _:_) -> panic "switch in middle of block"
263 -- Detect this special case to remain an inverse of
264 -- 'cmmBlockFromBrokenBlock'
265 [CmmCall target results arguments (CmmSafe srt) ret,
266 CmmBranch next_id] ->
267 ([cont_info], [block])
269 cont_info = (next_id,
270 ContFormat results srt
271 (ident `elem` gc_block_idents))
272 block = do_call current_id entry accum_stmts exits next_id
273 target results arguments srt ret
275 -- Break the block on safe calls (the main job of this function)
276 (CmmCall target results arguments (CmmSafe srt) ret : stmts) ->
277 (cont_info : cont_infos, block : blocks)
279 next_id = BlockId $ head uniques
280 block = do_call current_id entry accum_stmts exits next_id
281 target results arguments srt ret
283 cont_info = (next_id, -- Entry convention for the
284 -- continuation of the call
285 ContFormat results srt
286 (ident `elem` gc_block_idents))
288 -- Break up the part after the call
289 (cont_infos, blocks) = breakBlock' (tail uniques) next_id
290 ControlEntry [] [] stmts
292 -- Unsafe calls don't need a continuation
293 -- but they do need to be expanded
294 (CmmCall target results arguments CmmUnsafe ret : stmts) ->
295 breakBlock' remaining_uniques current_id entry exits
299 [CmmCall target results new_args CmmUnsafe ret] ++
303 (remaining_uniques, arg_stmts, new_args) =
304 loadArgsIntoTemps uniques arguments
305 (caller_save, caller_load) = callerSaveVolatileRegs (Just [])
307 -- Default case. Just keep accumulating statements
308 -- and branch targets.
310 breakBlock' uniques current_id entry
311 (cond_branch_target s++exits)
315 do_call current_id entry accum_stmts exits next_id
316 target results arguments srt ret =
317 BrokenBlock current_id entry accum_stmts (next_id:exits)
318 (FinalCall next_id target results arguments srt ret
319 (current_id `elem` gc_block_idents))
321 cond_branch_target (CmmCondBranch _ target) = [target]
322 cond_branch_target _ = []
324 -----------------------------------------------------------------------------
326 selectContinuations :: [(BlockId, ContFormat)] -> [(BlockId, ContFormat)]
327 selectContinuations needed_continuations = formats
329 formats = map select_format format_groups
330 format_groups = groupBy by_target needed_continuations
331 by_target x y = fst x == fst y
333 select_format formats = winner
335 winner = head $ head $ sortBy more_votes format_votes
336 format_votes = groupBy by_format formats
337 by_format x y = snd x == snd y
338 more_votes x y = compare (length y) (length x)
339 -- sort so the most votes goes *first*
340 -- (thus the order of x and y is reversed)
342 makeContinuationEntries :: [(BlockId, ContFormat)]
343 -> BrokenBlock -> BrokenBlock
344 makeContinuationEntries formats
345 block@(BrokenBlock ident _entry stmts targets exit) =
346 case lookup ident formats of
348 Just (ContFormat formals srt is_gc) ->
349 BrokenBlock ident (ContinuationEntry (map hintlessCmm formals) srt is_gc)
352 adaptBlockToFormat :: [(BlockId, ContFormat)]
356 adaptBlockToFormat formats unique
357 block@(BrokenBlock ident entry stmts targets
358 (FinalCall next target formals
359 actuals srt ret is_gc)) =
360 if format_formals == formals &&
362 format_is_gc == is_gc
363 then [block] -- Woohoo! This block got the continuation format it wanted
364 else [adaptor_block, revised_block]
365 -- This block didn't get the format it wanted for the
366 -- continuation, so we have to build an adaptor.
368 (ContFormat format_formals format_srt format_is_gc) =
369 maybe unknown_block id $ lookup next formats
370 unknown_block = panic "unknown block in adaptBlockToFormat"
372 revised_block = BrokenBlock ident entry stmts revised_targets revised_exit
373 revised_targets = adaptor_ident : delete next targets
374 revised_exit = FinalCall
375 adaptor_ident -- The only part that changed
376 target formals actuals srt ret is_gc
378 adaptor_block = mk_adaptor_block adaptor_ident
379 (ContinuationEntry (map hintlessCmm formals) srt is_gc) next
380 adaptor_ident = BlockId unique
382 mk_adaptor_block :: BlockId -> BlockEntryInfo -> BlockId -> BrokenBlock
383 mk_adaptor_block ident entry next =
384 BrokenBlock ident entry [] [next] exit
387 (CmmLit (CmmLabel (mkReturnPtLabel (getUnique next))))
388 (map formal_to_actual format_formals)
390 formal_to_actual (CmmHinted reg hint)
391 = (CmmHinted (CmmReg (CmmLocal reg)) hint)
392 -- TODO: Check if NoHint is right. We're
393 -- jumping to a C-- function not a foreign one
394 -- so it might always be right.
395 adaptBlockToFormat _ _ block = [block]
397 -----------------------------------------------------------------------------
398 -- | Convert from a BrokenBlock back to an equivalent CmmBasicBlock
399 -- Needed by liveness analysis
400 cmmBlockFromBrokenBlock :: BrokenBlock -> CmmBasicBlock
401 cmmBlockFromBrokenBlock (BrokenBlock ident _ stmts _ exit) =
402 BasicBlock ident (stmts++exit_stmt)
406 FinalBranch target -> [CmmBranch target]
407 FinalReturn arguments -> [CmmReturn arguments]
408 FinalJump target arguments -> [CmmJump target arguments]
409 FinalSwitch expr targets -> [CmmSwitch expr targets]
410 FinalCall branch_target call_target results arguments srt ret _ ->
411 [CmmCall call_target results arguments (CmmSafe srt) ret,
412 CmmBranch branch_target]
414 -----------------------------------------------------------------------------
415 -- | Build a mapping so we can lookup a 'BrokenBlock' by its 'BlockId'
416 blocksToBlockEnv :: [BrokenBlock] -> BlockEnv BrokenBlock
417 blocksToBlockEnv blocks = mkBlockEnv $ map (\b -> (brokenBlockId b, b)) blocks