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 CmmInfo CLabel CmmFormalsWithoutKinds
73 -- ^ Block is the beginning of a function, parameters are:
74 -- 1. Function header info
75 -- 2. The function name
76 -- 3. Aguments to function
77 -- Only the formal parameters are live
79 | ContinuationEntry CmmFormalsWithoutKinds C_SRT Bool
80 -- ^ Return point of a function call, parameters are:
81 -- 1. return values (argument to continuation)
82 -- 2. SRT for the continuation's info table
83 -- 3. True <=> GC block so ignore stack size
84 -- Live variables, other than
85 -- the return values, are on the stack
88 -- ^ Any other kind of block. Only entered due to control flow.
90 -- TODO: Consider adding ProcPointEntry
91 -- no return values, but some live might end up as
92 -- params or possibly in the frame
94 {- Note [An example of CPS conversion]
96 This is NR's and SLPJ's guess about how things might work;
97 it may not be consistent with the actual code (particularly
98 in the matter of what's in parameters and what's on the stack).
103 L: if x>1 then y = g(y)
109 f(x,y) { // FunctionEntry
113 if x>1 then push x; push f1; jump g(y)
114 else x=x+1; jump f2(x, y)
117 f1(y) { // ContinuationEntry
118 pop x; jump f2(x, y);
121 f2(x, y) { // ProcPointEntry
127 data ContFormat = ContFormat CmmFormals C_SRT Bool
129 -- 1. return values (argument to continuation)
130 -- 2. SRT for the continuation's info table
131 -- 3. True <=> GC block so ignore stack size
134 -- | Final statement in a 'BlokenBlock'.
135 -- Constructors and arguments match those in 'Cmm',
136 -- but are restricted to branches, returns, jumps, calls and switches
138 = FinalBranch BlockId
139 -- ^ Same as 'CmmBranch'. Target must be a ControlEntry
141 | FinalReturn CmmActuals
142 -- ^ Same as 'CmmReturn'. Parameter is the return values.
144 | FinalJump CmmExpr CmmActuals
145 -- ^ Same as 'CmmJump'. Parameters:
146 -- 1. The function to call,
147 -- 2. Arguments of the call
149 | FinalCall BlockId CmmCallTarget CmmFormals CmmActuals
150 C_SRT CmmReturnInfo Bool
151 -- ^ Same as 'CmmCallee' followed by 'CmmGoto'. Parameters:
152 -- 1. Target of the 'CmmGoto' (must be a 'ContinuationEntry')
153 -- 2. The function to call
154 -- 3. Results from call (redundant with ContinuationEntry)
155 -- 4. Arguments to call
156 -- 5. SRT for the continuation's info table
157 -- 6. Does the function return?
158 -- 7. True <=> GC block so ignore stack size
160 | FinalSwitch CmmExpr [Maybe BlockId]
161 -- ^ Same as a 'CmmSwitch'. Paremeters:
162 -- 1. Scrutinee (zero based)
165 -----------------------------------------------------------------------------
166 -- Operations for broken blocks
167 -----------------------------------------------------------------------------
169 -- Naively breaking at *every* CmmCall leads to sub-optimal code.
170 -- In particular, a CmmCall followed by a CmmBranch would result
171 -- in a continuation that has the single CmmBranch statement in it.
172 -- It would be better have the CmmCall directly return to the block
173 -- that the branch jumps to.
175 -- This requires the target of the branch to look like the parameter
176 -- format that the CmmCall is expecting. If other CmmCall/CmmBranch
177 -- sequences go to the same place they might not be expecting the
178 -- same format. So this transformation uses the following solution.
179 -- First the blocks are broken up but none of the blocks are marked
180 -- as continuations yet. This is the 'breakBlock' function.
181 -- Second, the blocks "vote" on what other blocks need to be continuations
182 -- and how they should be layed out. Plurality wins, but other selection
183 -- methods could be selected at a later time.
184 -- This is the 'selectContinuations' function.
185 -- Finally, the blocks are upgraded to 'ContEntry' continuations
186 -- based on the results with the 'makeContinuationEntries' function,
187 -- and the blocks that didn't get the format they wanted for their
188 -- targets get a small adaptor block created for them by
189 -- the 'adaptBlockToFormat' function.
193 [BlockId] -- ^ Any GC blocks that should be special
194 -> [[Unique]] -- ^ An infinite list of uniques
195 -- to create names of the new blocks with
196 -> CmmInfo -- ^ Info table for the procedure
197 -> CLabel -- ^ Name of the procedure
198 -> CmmFormalsWithoutKinds -- ^ Parameters of the procedure
199 -> [CmmBasicBlock] -- ^ Blocks of the procecure
200 -- (First block is the entry block)
203 breakProc gc_block_idents uniques info ident params blocks =
205 (adaptor_uniques : block_uniques) = uniques
207 broken_blocks :: ([(BlockId, ContFormat)], [BrokenBlock])
210 zipWith3 (breakBlock gc_block_idents)
213 (FunctionEntry info ident params :
215 in (concatMap fst new_blocks, concatMap snd new_blocks)
217 selected = selectContinuations (fst broken_blocks)
219 in map (makeContinuationEntries selected) $
221 zipWith (adaptBlockToFormat selected)
225 -----------------------------------------------------------------------------
226 -- | Takes a 'CmmBasicBlock' and breaks it up into a list of 'BrokenBlock'
227 -- by splitting on each 'CmmCall' in the 'CmmBasicBlock'.
230 [BlockId] -- ^ Any GC blocks that should be special
231 -> [Unique] -- ^ An infinite list of uniques
232 -- to create names of the new blocks with
233 -> CmmBasicBlock -- ^ Input block to break apart
234 -> BlockEntryInfo -- ^ Info for the first created 'BrokenBlock'
235 -> ([(BlockId, ContFormat)], [BrokenBlock])
236 breakBlock gc_block_idents uniques (BasicBlock ident stmts) entry =
237 breakBlock' uniques ident entry [] [] stmts
239 breakBlock' uniques current_id entry exits accum_stmts stmts =
241 [] -> panic "block doesn't end in jump, goto, return or switch"
243 -- Last statement. Make the 'BrokenBlock'
244 [CmmJump target arguments] ->
246 [BrokenBlock current_id entry accum_stmts
248 (FinalJump target arguments)])
249 [CmmReturn arguments] ->
251 [BrokenBlock current_id entry accum_stmts
253 (FinalReturn arguments)])
254 [CmmBranch target] ->
256 [BrokenBlock current_id entry accum_stmts
258 (FinalBranch target)])
259 [CmmSwitch expr targets] ->
261 [BrokenBlock current_id entry accum_stmts
262 (mapMaybe id targets ++ exits)
263 (FinalSwitch expr targets)])
265 -- These shouldn't happen in the middle of a block.
266 -- They would cause dead code.
267 (CmmJump _ _:_) -> panic "jump in middle of block"
268 (CmmReturn _:_) -> panic "return in middle of block"
269 (CmmBranch _:_) -> panic "branch in middle of block"
270 (CmmSwitch _ _:_) -> panic "switch in middle of block"
272 -- Detect this special case to remain an inverse of
273 -- 'cmmBlockFromBrokenBlock'
274 [CmmCall target results arguments (CmmSafe srt) ret,
275 CmmBranch next_id] ->
276 ([cont_info], [block])
278 cont_info = (next_id,
279 ContFormat results srt
280 (ident `elem` gc_block_idents))
281 block = do_call current_id entry accum_stmts exits next_id
282 target results arguments srt ret
284 -- Break the block on safe calls (the main job of this function)
285 (CmmCall target results arguments (CmmSafe srt) ret : stmts) ->
286 (cont_info : cont_infos, block : blocks)
288 next_id = BlockId $ head uniques
289 block = do_call current_id entry accum_stmts exits next_id
290 target results arguments srt ret
292 cont_info = (next_id, -- Entry convention for the
293 -- continuation of the call
294 ContFormat results srt
295 (ident `elem` gc_block_idents))
297 -- Break up the part after the call
298 (cont_infos, blocks) = breakBlock' (tail uniques) next_id
299 ControlEntry [] [] stmts
301 -- Unsafe calls don't need a continuation
302 -- but they do need to be expanded
303 (CmmCall target results arguments CmmUnsafe ret : stmts) ->
304 breakBlock' remaining_uniques current_id entry exits
308 [CmmCall target results new_args CmmUnsafe ret] ++
312 (remaining_uniques, arg_stmts, new_args) =
313 loadArgsIntoTemps uniques arguments
314 (caller_save, caller_load) = callerSaveVolatileRegs (Just [])
316 -- Default case. Just keep accumulating statements
317 -- and branch targets.
319 breakBlock' uniques current_id entry
320 (cond_branch_target s++exits)
324 do_call current_id entry accum_stmts exits next_id
325 target results arguments srt ret =
326 BrokenBlock current_id entry accum_stmts (next_id:exits)
327 (FinalCall next_id target results arguments srt ret
328 (current_id `elem` gc_block_idents))
330 cond_branch_target (CmmCondBranch _ target) = [target]
331 cond_branch_target _ = []
333 -----------------------------------------------------------------------------
335 selectContinuations :: [(BlockId, ContFormat)] -> [(BlockId, ContFormat)]
336 selectContinuations needed_continuations = formats
338 formats = map select_format format_groups
339 format_groups = groupBy by_target needed_continuations
340 by_target x y = fst x == fst y
342 select_format formats = winner
344 winner = head $ head $ sortBy more_votes format_votes
345 format_votes = groupBy by_format formats
346 by_format x y = snd x == snd y
347 more_votes x y = compare (length y) (length x)
348 -- sort so the most votes goes *first*
349 -- (thus the order of x and y is reversed)
351 makeContinuationEntries formats
352 block@(BrokenBlock ident entry stmts targets exit) =
353 case lookup ident formats of
355 Just (ContFormat formals srt is_gc) ->
356 BrokenBlock ident (ContinuationEntry (map kindlessCmm formals) srt is_gc)
359 adaptBlockToFormat :: [(BlockId, ContFormat)]
363 adaptBlockToFormat formats unique
364 block@(BrokenBlock ident entry stmts targets
365 exit@(FinalCall next target formals
366 actuals srt ret is_gc)) =
367 if format_formals == formals &&
369 format_is_gc == is_gc
370 then [block] -- Woohoo! This block got the continuation format it wanted
371 else [adaptor_block, revised_block]
372 -- This block didn't get the format it wanted for the
373 -- continuation, so we have to build an adaptor.
375 (ContFormat format_formals format_srt format_is_gc) =
376 maybe unknown_block id $ lookup next formats
377 unknown_block = panic "unknown block in adaptBlockToFormat"
379 revised_block = BrokenBlock ident entry stmts revised_targets revised_exit
380 revised_targets = adaptor_ident : delete next targets
381 revised_exit = FinalCall
382 adaptor_ident -- The only part that changed
383 target formals actuals srt ret is_gc
385 adaptor_block = mk_adaptor_block adaptor_ident
386 (ContinuationEntry (map kindlessCmm formals) srt is_gc)
388 adaptor_ident = BlockId unique
390 mk_adaptor_block :: BlockId -> BlockEntryInfo -> BlockId -> CmmFormals -> BrokenBlock
391 mk_adaptor_block ident entry next formals =
392 BrokenBlock ident entry [] [next] exit
395 (CmmLit (CmmLabel (mkReturnPtLabel (getUnique next))))
396 (map formal_to_actual format_formals)
398 formal_to_actual (CmmKinded reg hint)
399 = (CmmKinded (CmmReg (CmmLocal reg)) hint)
400 -- TODO: Check if NoHint is right. We're
401 -- jumping to a C-- function not a foreign one
402 -- so it might always be right.
403 adaptBlockToFormat _ _ block = [block]
405 -----------------------------------------------------------------------------
406 -- | Convert from a BrokenBlock back to an equivalent CmmBasicBlock
407 -- Needed by liveness analysis
408 cmmBlockFromBrokenBlock :: BrokenBlock -> CmmBasicBlock
409 cmmBlockFromBrokenBlock (BrokenBlock ident _ stmts _ exit) =
410 BasicBlock ident (stmts++exit_stmt)
414 FinalBranch target -> [CmmBranch target]
415 FinalReturn arguments -> [CmmReturn arguments]
416 FinalJump target arguments -> [CmmJump target arguments]
417 FinalSwitch expr targets -> [CmmSwitch expr targets]
418 FinalCall branch_target call_target results arguments srt ret _ ->
419 [CmmCall call_target results arguments (CmmSafe srt) ret,
420 CmmBranch branch_target]
422 -----------------------------------------------------------------------------
423 -- | Build a mapping so we can lookup a 'BrokenBlock' by its 'BlockId'
424 blocksToBlockEnv :: [BrokenBlock] -> BlockEnv BrokenBlock
425 blocksToBlockEnv blocks = listToUFM $ map (\b -> (brokenBlockId b, b)) blocks