2 -- The above warning supression flag is a temporary kludge.
3 -- While working on this module you are encouraged to remove it and fix
4 -- any warnings in the module. See
5 -- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
8 module CmmBrokenBlock (
13 cmmBlockFromBrokenBlock,
18 makeContinuationEntries,
21 #include "HsVersions.h"
27 import MachOp (MachHint(..))
29 import CgUtils (callerSaveVolatileRegs)
39 -- This module takes a 'CmmBasicBlock' which might have 'CmmCall'
40 -- statements in it with 'CmmSafe' set and breaks it up at each such call.
41 -- It also collects information about the block for later use
42 -- by the CPS algorithm.
44 -----------------------------------------------------------------------------
46 -----------------------------------------------------------------------------
48 -- |Similar to a 'CmmBlock' with a little extra information
49 -- to help the CPS analysis.
52 brokenBlockId :: BlockId, -- ^ The block's label like a 'CmmBasicBlock'
53 brokenBlockEntry :: BlockEntryInfo,
54 -- ^ Ways this block can be entered
56 brokenBlockStmts :: [CmmStmt],
57 -- ^ Body like a CmmBasicBlock
58 -- (but without the last statement)
60 brokenBlockTargets :: [BlockId],
61 -- ^ Blocks that this block could
62 -- branch to either by conditional
63 -- branches or via the last statement
65 brokenBlockExit :: FinalStmt
66 -- ^ The final statement of the block
69 -- | How a block could be entered
70 -- See Note [An example of CPS conversion]
72 = FunctionEntry -- ^ Block is the beginning of a function
73 CmmInfo -- ^ Function header info
74 CLabel -- ^ The function name
75 CmmFormalsWithoutKinds -- ^ Aguments to function
76 -- Only the formal parameters are live
78 | ContinuationEntry -- ^ Return point of a function call
79 CmmFormalsWithoutKinds -- ^ return values (argument to continuation)
80 C_SRT -- ^ SRT for the continuation's info table
81 Bool -- ^ True <=> GC block so ignore stack size
82 -- Live variables, other than
83 -- the return values, are on the stack
85 | ControlEntry -- ^ Any other kind of block.
86 -- Only entered due to control flow.
88 -- TODO: Consider adding ProcPointEntry
89 -- no return values, but some live might end up as
90 -- params or possibly in the frame
92 {- Note [An example of CPS conversion]
94 This is NR's and SLPJ's guess about how things might work;
95 it may not be consistent with the actual code (particularly
96 in the matter of what's in parameters and what's on the stack).
101 L: if x>1 then y = g(y)
107 f(x,y) { // FunctionEntry
111 if x>1 then push x; push f1; jump g(y)
112 else x=x+1; jump f2(x, y)
115 f1(y) { // ContinuationEntry
116 pop x; jump f2(x, y);
119 f2(x, y) { // ProcPointEntry
125 data ContFormat = ContFormat
126 CmmFormals -- ^ return values (argument to continuation)
127 C_SRT -- ^ SRT for the continuation's info table
128 Bool -- ^ True <=> GC block so ignore stack size
131 -- | Final statement in a 'BlokenBlock'.
132 -- Constructors and arguments match those in 'Cmm',
133 -- but are restricted to branches, returns, jumps, calls and switches
135 = FinalBranch -- ^ Same as 'CmmBranch'
136 BlockId -- ^ Target must be a ControlEntry
138 | FinalReturn -- ^ Same as 'CmmReturn'
139 CmmActuals -- ^ Return values
141 | FinalJump -- ^ Same as 'CmmJump'
142 CmmExpr -- ^ The function to call
143 CmmActuals -- ^ Arguments of the call
145 | FinalCall -- ^ Same as 'CmmCallee'
146 -- followed by 'CmmGoto'
147 BlockId -- ^ Target of the 'CmmGoto'
148 -- (must be a 'ContinuationEntry')
149 CmmCallTarget -- ^ The function to call
150 CmmFormals -- ^ Results from call
151 -- (redundant with ContinuationEntry)
152 CmmActuals -- ^ Arguments to call
153 C_SRT -- ^ SRT for the continuation's info table
154 CmmReturnInfo -- ^ Does the function return?
155 Bool -- ^ True <=> GC block so ignore stack size
157 | FinalSwitch -- ^ Same as a 'CmmSwitch'
158 CmmExpr -- ^ Scrutinee (zero based)
159 [Maybe BlockId] -- ^ Targets
161 -----------------------------------------------------------------------------
162 -- Operations for broken blocks
163 -----------------------------------------------------------------------------
165 -- Naively breaking at *every* CmmCall leads to sub-optimal code.
166 -- In particular, a CmmCall followed by a CmmBranch would result
167 -- in a continuation that has the single CmmBranch statement in it.
168 -- It would be better have the CmmCall directly return to the block
169 -- that the branch jumps to.
171 -- This requires the target of the branch to look like the parameter
172 -- format that the CmmCall is expecting. If other CmmCall/CmmBranch
173 -- sequences go to the same place they might not be expecting the
174 -- same format. So this transformation uses the following solution.
175 -- First the blocks are broken up but none of the blocks are marked
176 -- as continuations yet. This is the 'breakBlock' function.
177 -- Second, the blocks "vote" on what other blocks need to be continuations
178 -- and how they should be layed out. Plurality wins, but other selection
179 -- methods could be selected at a later time.
180 -- This is the 'selectContinuations' function.
181 -- Finally, the blocks are upgraded to 'ContEntry' continuations
182 -- based on the results with the 'makeContinuationEntries' function,
183 -- and the blocks that didn't get the format they wanted for their
184 -- targets get a small adaptor block created for them by
185 -- the 'adaptBlockToFormat' function.
189 [BlockId] -- ^ Any GC blocks that should be special
190 -> [[Unique]] -- ^ An infinite list of uniques
191 -- to create names of the new blocks with
192 -> CmmInfo -- ^ Info table for the procedure
193 -> CLabel -- ^ Name of the procedure
194 -> CmmFormalsWithoutKinds -- ^ Parameters of the procedure
195 -> [CmmBasicBlock] -- ^ Blocks of the procecure
196 -- (First block is the entry block)
199 breakProc gc_block_idents uniques info ident params blocks =
201 (adaptor_uniques : block_uniques) = uniques
203 broken_blocks :: ([(BlockId, ContFormat)], [BrokenBlock])
206 zipWith3 (breakBlock gc_block_idents)
209 (FunctionEntry info ident params :
211 in (concatMap fst new_blocks, concatMap snd new_blocks)
213 selected = selectContinuations (fst broken_blocks)
215 in map (makeContinuationEntries selected) $
217 zipWith (adaptBlockToFormat selected)
221 -----------------------------------------------------------------------------
222 -- | Takes a 'CmmBasicBlock' and breaks it up into a list of 'BrokenBlock'
223 -- by splitting on each 'CmmCall' in the 'CmmBasicBlock'.
226 [BlockId] -- ^ Any GC blocks that should be special
227 -> [Unique] -- ^ An infinite list of uniques
228 -- to create names of the new blocks with
229 -> CmmBasicBlock -- ^ Input block to break apart
230 -> BlockEntryInfo -- ^ Info for the first created 'BrokenBlock'
231 -> ([(BlockId, ContFormat)], [BrokenBlock])
232 breakBlock gc_block_idents uniques (BasicBlock ident stmts) entry =
233 breakBlock' uniques ident entry [] [] stmts
235 breakBlock' uniques current_id entry exits accum_stmts stmts =
237 [] -> panic "block doesn't end in jump, goto, return or switch"
239 -- Last statement. Make the 'BrokenBlock'
240 [CmmJump target arguments] ->
242 [BrokenBlock current_id entry accum_stmts
244 (FinalJump target arguments)])
245 [CmmReturn arguments] ->
247 [BrokenBlock current_id entry accum_stmts
249 (FinalReturn arguments)])
250 [CmmBranch target] ->
252 [BrokenBlock current_id entry accum_stmts
254 (FinalBranch target)])
255 [CmmSwitch expr targets] ->
257 [BrokenBlock current_id entry accum_stmts
258 (mapMaybe id targets ++ exits)
259 (FinalSwitch expr targets)])
261 -- These shouldn't happen in the middle of a block.
262 -- They would cause dead code.
263 (CmmJump _ _:_) -> panic "jump in middle of block"
264 (CmmReturn _:_) -> panic "return in middle of block"
265 (CmmBranch _:_) -> panic "branch in middle of block"
266 (CmmSwitch _ _:_) -> panic "switch in middle of block"
268 -- Detect this special case to remain an inverse of
269 -- 'cmmBlockFromBrokenBlock'
270 [CmmCall target results arguments (CmmSafe srt) ret,
271 CmmBranch next_id] ->
272 ([cont_info], [block])
274 cont_info = (next_id,
275 ContFormat results srt
276 (ident `elem` gc_block_idents))
277 block = do_call current_id entry accum_stmts exits next_id
278 target results arguments srt ret
280 -- Break the block on safe calls (the main job of this function)
281 (CmmCall target results arguments (CmmSafe srt) ret : stmts) ->
282 (cont_info : cont_infos, block : blocks)
284 next_id = BlockId $ head uniques
285 block = do_call current_id entry accum_stmts exits next_id
286 target results arguments srt ret
288 cont_info = (next_id, -- Entry convention for the
289 -- continuation of the call
290 ContFormat results srt
291 (ident `elem` gc_block_idents))
293 -- Break up the part after the call
294 (cont_infos, blocks) = breakBlock' (tail uniques) next_id
295 ControlEntry [] [] stmts
297 -- Unsafe calls don't need a continuation
298 -- but they do need to be expanded
299 (CmmCall target results arguments CmmUnsafe ret : stmts) ->
300 breakBlock' remaining_uniques current_id entry exits
304 [CmmCall target results new_args CmmUnsafe ret] ++
308 (remaining_uniques, arg_stmts, new_args) =
309 loadArgsIntoTemps uniques arguments
310 (caller_save, caller_load) = callerSaveVolatileRegs (Just [])
312 -- Default case. Just keep accumulating statements
313 -- and branch targets.
315 breakBlock' uniques current_id entry
316 (cond_branch_target s++exits)
320 do_call current_id entry accum_stmts exits next_id
321 target results arguments srt ret =
322 BrokenBlock current_id entry accum_stmts (next_id:exits)
323 (FinalCall next_id target results arguments srt ret
324 (current_id `elem` gc_block_idents))
326 cond_branch_target (CmmCondBranch _ target) = [target]
327 cond_branch_target _ = []
329 -----------------------------------------------------------------------------
331 selectContinuations :: [(BlockId, ContFormat)] -> [(BlockId, ContFormat)]
332 selectContinuations needed_continuations = formats
334 formats = map select_format format_groups
335 format_groups = groupBy by_target needed_continuations
336 by_target x y = fst x == fst y
338 select_format formats = winner
340 winner = head $ head $ sortBy more_votes format_votes
341 format_votes = groupBy by_format formats
342 by_format x y = snd x == snd y
343 more_votes x y = compare (length y) (length x)
344 -- sort so the most votes goes *first*
345 -- (thus the order of x and y is reversed)
347 makeContinuationEntries formats
348 block@(BrokenBlock ident entry stmts targets exit) =
349 case lookup ident formats of
351 Just (ContFormat formals srt is_gc) ->
352 BrokenBlock ident (ContinuationEntry (map kindlessCmm formals) srt is_gc)
355 adaptBlockToFormat :: [(BlockId, ContFormat)]
359 adaptBlockToFormat formats unique
360 block@(BrokenBlock ident entry stmts targets
361 exit@(FinalCall next target formals
362 actuals srt ret is_gc)) =
363 if format_formals == formals &&
365 format_is_gc == is_gc
366 then [block] -- Woohoo! This block got the continuation format it wanted
367 else [adaptor_block, revised_block]
368 -- This block didn't get the format it wanted for the
369 -- continuation, so we have to build an adaptor.
371 (ContFormat format_formals format_srt format_is_gc) =
372 maybe unknown_block id $ lookup next formats
373 unknown_block = panic "unknown block in adaptBlockToFormat"
375 revised_block = BrokenBlock ident entry stmts revised_targets revised_exit
376 revised_targets = adaptor_ident : delete next targets
377 revised_exit = FinalCall
378 adaptor_ident -- ^ The only part that changed
379 target formals actuals srt ret is_gc
381 adaptor_block = mk_adaptor_block adaptor_ident
382 (ContinuationEntry (map kindlessCmm formals) srt is_gc)
384 adaptor_ident = BlockId unique
386 mk_adaptor_block :: BlockId -> BlockEntryInfo -> BlockId -> CmmFormals -> BrokenBlock
387 mk_adaptor_block ident entry next formals =
388 BrokenBlock ident entry [] [next] exit
391 (CmmLit (CmmLabel (mkReturnPtLabel (getUnique next))))
392 (map formal_to_actual format_formals)
394 formal_to_actual (CmmKinded reg hint)
395 = (CmmKinded (CmmReg (CmmLocal reg)) hint)
396 -- TODO: Check if NoHint is right. We're
397 -- jumping to a C-- function not a foreign one
398 -- so it might always be right.
399 adaptBlockToFormat _ _ block = [block]
401 -----------------------------------------------------------------------------
402 -- | Convert from a BrokenBlock back to an equivalent CmmBasicBlock
403 -- Needed by liveness analysis
404 cmmBlockFromBrokenBlock :: BrokenBlock -> CmmBasicBlock
405 cmmBlockFromBrokenBlock (BrokenBlock ident _ stmts _ exit) =
406 BasicBlock ident (stmts++exit_stmt)
410 FinalBranch target -> [CmmBranch target]
411 FinalReturn arguments -> [CmmReturn arguments]
412 FinalJump target arguments -> [CmmJump target arguments]
413 FinalSwitch expr targets -> [CmmSwitch expr targets]
414 FinalCall branch_target call_target results arguments srt ret _ ->
415 [CmmCall call_target results arguments (CmmSafe srt) ret,
416 CmmBranch branch_target]
418 -----------------------------------------------------------------------------
419 -- | Build a mapping so we can lookup a 'BrokenBlock' by its 'BlockId'
420 blocksToBlockEnv :: [BrokenBlock] -> BlockEnv BrokenBlock
421 blocksToBlockEnv blocks = listToUFM $ map (\b -> (brokenBlockId b, b)) blocks