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"
26 import MachOp (MachHint(..))
28 import CgUtils (callerSaveVolatileRegs)
38 -- This module takes a 'CmmBasicBlock' which might have 'CmmCall'
39 -- statements in it with 'CmmSafe' set and breaks it up at each such call.
40 -- It also collects information about the block for later use
41 -- by the CPS algorithm.
43 -----------------------------------------------------------------------------
45 -----------------------------------------------------------------------------
47 -- |Similar to a 'CmmBlock' with a little extra information
48 -- to help the CPS analysis.
51 brokenBlockId :: BlockId, -- ^ The block's label like a 'CmmBasicBlock'
52 brokenBlockEntry :: BlockEntryInfo,
53 -- ^ Ways this block can be entered
55 brokenBlockStmts :: [CmmStmt],
56 -- ^ Body like a CmmBasicBlock
57 -- (but without the last statement)
59 brokenBlockTargets :: [BlockId],
60 -- ^ Blocks that this block could
61 -- branch to either by conditional
62 -- branches or via the last statement
64 brokenBlockExit :: FinalStmt
65 -- ^ The final statement of the block
68 -- | How a block could be entered
69 -- See Note [An example of CPS conversion]
71 = FunctionEntry -- ^ Block is the beginning of a function
72 CmmInfo -- ^ Function header info
73 CLabel -- ^ The function name
74 CmmFormalsWithoutKinds -- ^ Aguments to function
75 -- Only the formal parameters are live
77 | ContinuationEntry -- ^ Return point of a function call
78 CmmFormalsWithoutKinds -- ^ return values (argument to continuation)
79 C_SRT -- ^ SRT for the continuation's info table
80 Bool -- ^ True <=> GC block so ignore stack size
81 -- Live variables, other than
82 -- the return values, are on the stack
84 | ControlEntry -- ^ Any other kind of block.
85 -- Only entered due to control flow.
87 -- TODO: Consider adding ProcPointEntry
88 -- no return values, but some live might end up as
89 -- params or possibly in the frame
91 {- Note [An example of CPS conversion]
93 This is NR's and SLPJ's guess about how things might work;
94 it may not be consistent with the actual code (particularly
95 in the matter of what's in parameters and what's on the stack).
100 L: if x>1 then y = g(y)
106 f(x,y) { // FunctionEntry
110 if x>1 then push x; push f1; jump g(y)
111 else x=x+1; jump f2(x, y)
114 f1(y) { // ContinuationEntry
115 pop x; jump f2(x, y);
118 f2(x, y) { // ProcPointEntry
124 data ContFormat = ContFormat
125 CmmFormals -- ^ return values (argument to continuation)
126 C_SRT -- ^ SRT for the continuation's info table
127 Bool -- ^ True <=> GC block so ignore stack size
130 -- | Final statement in a 'BlokenBlock'.
131 -- Constructors and arguments match those in 'Cmm',
132 -- but are restricted to branches, returns, jumps, calls and switches
134 = FinalBranch -- ^ Same as 'CmmBranch'
135 BlockId -- ^ Target must be a ControlEntry
137 | FinalReturn -- ^ Same as 'CmmReturn'
138 CmmActuals -- ^ Return values
140 | FinalJump -- ^ Same as 'CmmJump'
141 CmmExpr -- ^ The function to call
142 CmmActuals -- ^ Arguments of the call
144 | FinalCall -- ^ Same as 'CmmCallee'
145 -- followed by 'CmmGoto'
146 BlockId -- ^ Target of the 'CmmGoto'
147 -- (must be a 'ContinuationEntry')
148 CmmCallTarget -- ^ The function to call
149 CmmFormals -- ^ Results from call
150 -- (redundant with ContinuationEntry)
151 CmmActuals -- ^ Arguments to call
152 C_SRT -- ^ SRT for the continuation's info table
153 CmmReturnInfo -- ^ Does the function return?
154 Bool -- ^ True <=> GC block so ignore stack size
156 | FinalSwitch -- ^ Same as a 'CmmSwitch'
157 CmmExpr -- ^ Scrutinee (zero based)
158 [Maybe BlockId] -- ^ Targets
160 -----------------------------------------------------------------------------
161 -- Operations for broken blocks
162 -----------------------------------------------------------------------------
164 -- Naively breaking at *every* CmmCall leads to sub-optimal code.
165 -- In particular, a CmmCall followed by a CmmBranch would result
166 -- in a continuation that has the single CmmBranch statement in it.
167 -- It would be better have the CmmCall directly return to the block
168 -- that the branch jumps to.
170 -- This requires the target of the branch to look like the parameter
171 -- format that the CmmCall is expecting. If other CmmCall/CmmBranch
172 -- sequences go to the same place they might not be expecting the
173 -- same format. So this transformation uses the following solution.
174 -- First the blocks are broken up but none of the blocks are marked
175 -- as continuations yet. This is the 'breakBlock' function.
176 -- Second, the blocks "vote" on what other blocks need to be continuations
177 -- and how they should be layed out. Plurality wins, but other selection
178 -- methods could be selected at a later time.
179 -- This is the 'selectContinuations' function.
180 -- Finally, the blocks are upgraded to 'ContEntry' continuations
181 -- based on the results with the 'makeContinuationEntries' function,
182 -- and the blocks that didn't get the format they wanted for their
183 -- targets get a small adaptor block created for them by
184 -- the 'adaptBlockToFormat' function.
188 [BlockId] -- ^ Any GC blocks that should be special
189 -> [[Unique]] -- ^ An infinite list of uniques
190 -- to create names of the new blocks with
191 -> CmmInfo -- ^ Info table for the procedure
192 -> CLabel -- ^ Name of the procedure
193 -> CmmFormalsWithoutKinds -- ^ Parameters of the procedure
194 -> [CmmBasicBlock] -- ^ Blocks of the procecure
195 -- (First block is the entry block)
198 breakProc gc_block_idents uniques info ident params blocks =
200 (adaptor_uniques : block_uniques) = uniques
202 broken_blocks :: ([(BlockId, ContFormat)], [BrokenBlock])
205 zipWith3 (breakBlock gc_block_idents)
208 (FunctionEntry info ident params :
210 in (concatMap fst new_blocks, concatMap snd new_blocks)
212 selected = selectContinuations (fst broken_blocks)
214 in map (makeContinuationEntries selected) $
216 zipWith (adaptBlockToFormat selected)
220 -----------------------------------------------------------------------------
221 -- | Takes a 'CmmBasicBlock' and breaks it up into a list of 'BrokenBlock'
222 -- by splitting on each 'CmmCall' in the 'CmmBasicBlock'.
225 [BlockId] -- ^ Any GC blocks that should be special
226 -> [Unique] -- ^ An infinite list of uniques
227 -- to create names of the new blocks with
228 -> CmmBasicBlock -- ^ Input block to break apart
229 -> BlockEntryInfo -- ^ Info for the first created 'BrokenBlock'
230 -> ([(BlockId, ContFormat)], [BrokenBlock])
231 breakBlock gc_block_idents uniques (BasicBlock ident stmts) entry =
232 breakBlock' uniques ident entry [] [] stmts
234 breakBlock' uniques current_id entry exits accum_stmts stmts =
236 [] -> panic "block doesn't end in jump, goto, return or switch"
238 -- Last statement. Make the 'BrokenBlock'
239 [CmmJump target arguments] ->
241 [BrokenBlock current_id entry accum_stmts
243 (FinalJump target arguments)])
244 [CmmReturn arguments] ->
246 [BrokenBlock current_id entry accum_stmts
248 (FinalReturn arguments)])
249 [CmmBranch target] ->
251 [BrokenBlock current_id entry accum_stmts
253 (FinalBranch target)])
254 [CmmSwitch expr targets] ->
256 [BrokenBlock current_id entry accum_stmts
257 (mapMaybe id targets ++ exits)
258 (FinalSwitch expr targets)])
260 -- These shouldn't happen in the middle of a block.
261 -- They would cause dead code.
262 (CmmJump _ _:_) -> panic "jump in middle of block"
263 (CmmReturn _:_) -> panic "return in middle of block"
264 (CmmBranch _:_) -> panic "branch in middle of block"
265 (CmmSwitch _ _:_) -> panic "switch in middle of block"
267 -- Detect this special case to remain an inverse of
268 -- 'cmmBlockFromBrokenBlock'
269 [CmmCall target results arguments (CmmSafe srt) ret,
270 CmmBranch next_id] ->
271 ([cont_info], [block])
273 cont_info = (next_id,
274 ContFormat results srt
275 (ident `elem` gc_block_idents))
276 block = do_call current_id entry accum_stmts exits next_id
277 target results arguments srt ret
279 -- Break the block on safe calls (the main job of this function)
280 (CmmCall target results arguments (CmmSafe srt) ret : stmts) ->
281 (cont_info : cont_infos, block : blocks)
283 next_id = BlockId $ head uniques
284 block = do_call current_id entry accum_stmts exits next_id
285 target results arguments srt ret
287 cont_info = (next_id, -- Entry convention for the
288 -- continuation of the call
289 ContFormat results srt
290 (ident `elem` gc_block_idents))
292 -- Break up the part after the call
293 (cont_infos, blocks) = breakBlock' (tail uniques) next_id
294 ControlEntry [] [] stmts
296 -- Unsafe calls don't need a continuation
297 -- but they do need to be expanded
298 (CmmCall target results arguments CmmUnsafe ret : stmts) ->
299 breakBlock' remaining_uniques current_id entry exits
303 [CmmCall target results new_args CmmUnsafe ret] ++
307 (remaining_uniques, arg_stmts, new_args) =
308 loadArgsIntoTemps uniques arguments
309 (caller_save, caller_load) = callerSaveVolatileRegs (Just [])
311 -- Default case. Just keep accumulating statements
312 -- and branch targets.
314 breakBlock' uniques current_id entry
315 (cond_branch_target s++exits)
319 do_call current_id entry accum_stmts exits next_id
320 target results arguments srt ret =
321 BrokenBlock current_id entry accum_stmts (next_id:exits)
322 (FinalCall next_id target results arguments srt ret
323 (current_id `elem` gc_block_idents))
325 cond_branch_target (CmmCondBranch _ target) = [target]
326 cond_branch_target _ = []
328 -----------------------------------------------------------------------------
330 selectContinuations :: [(BlockId, ContFormat)] -> [(BlockId, ContFormat)]
331 selectContinuations needed_continuations = formats
333 formats = map select_format format_groups
334 format_groups = groupBy by_target needed_continuations
335 by_target x y = fst x == fst y
337 select_format formats = winner
339 winner = head $ head $ sortBy more_votes format_votes
340 format_votes = groupBy by_format formats
341 by_format x y = snd x == snd y
342 more_votes x y = compare (length y) (length x)
343 -- sort so the most votes goes *first*
344 -- (thus the order of x and y is reversed)
346 makeContinuationEntries formats
347 block@(BrokenBlock ident entry stmts targets exit) =
348 case lookup ident formats of
350 Just (ContFormat formals srt is_gc) ->
351 BrokenBlock ident (ContinuationEntry (map fst formals) srt is_gc)
354 adaptBlockToFormat :: [(BlockId, ContFormat)]
358 adaptBlockToFormat formats unique
359 block@(BrokenBlock ident entry stmts targets
360 exit@(FinalCall next target formals
361 actuals srt ret is_gc)) =
362 if format_formals == formals &&
364 format_is_gc == is_gc
365 then [block] -- Woohoo! This block got the continuation format it wanted
366 else [adaptor_block, revised_block]
367 -- This block didn't get the format it wanted for the
368 -- continuation, so we have to build an adaptor.
370 (ContFormat format_formals format_srt format_is_gc) =
371 maybe unknown_block id $ lookup next formats
372 unknown_block = panic "unknown block in adaptBlockToFormat"
374 revised_block = BrokenBlock ident entry stmts revised_targets revised_exit
375 revised_targets = adaptor_ident : delete next targets
376 revised_exit = FinalCall
377 adaptor_ident -- ^ The only part that changed
378 target formals actuals srt ret is_gc
380 adaptor_block = mk_adaptor_block adaptor_ident
381 (ContinuationEntry (map fst formals) srt is_gc)
383 adaptor_ident = BlockId unique
385 mk_adaptor_block :: BlockId -> BlockEntryInfo -> BlockId -> CmmFormals -> BrokenBlock
386 mk_adaptor_block ident entry next formals =
387 BrokenBlock ident entry [] [next] exit
390 (CmmLit (CmmLabel (mkReturnPtLabel (getUnique next))))
391 (map formal_to_actual format_formals)
393 formal_to_actual (reg, hint) = ((CmmReg (CmmLocal reg)), hint)
394 -- TODO: Check if NoHint is right. We're
395 -- jumping to a C-- function not a foreign one
396 -- so it might always be right.
397 adaptBlockToFormat _ _ block = [block]
399 -----------------------------------------------------------------------------
400 -- | Convert from a BrokenBlock back to an equivalent CmmBasicBlock
401 -- Needed by liveness analysis
402 cmmBlockFromBrokenBlock :: BrokenBlock -> CmmBasicBlock
403 cmmBlockFromBrokenBlock (BrokenBlock ident _ stmts _ exit) =
404 BasicBlock ident (stmts++exit_stmt)
408 FinalBranch target -> [CmmBranch target]
409 FinalReturn arguments -> [CmmReturn arguments]
410 FinalJump target arguments -> [CmmJump target arguments]
411 FinalSwitch expr targets -> [CmmSwitch expr targets]
412 FinalCall branch_target call_target results arguments srt ret _ ->
413 [CmmCall call_target results arguments (CmmSafe srt) ret,
414 CmmBranch branch_target]
416 -----------------------------------------------------------------------------
417 -- | Build a mapping so we can lookup a 'BrokenBlock' by its 'BlockId'
418 blocksToBlockEnv :: [BrokenBlock] -> BlockEnv BrokenBlock
419 blocksToBlockEnv blocks = listToUFM $ map (\b -> (brokenBlockId b, b)) blocks