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
63 = FunctionEntry -- ^ Block is the beginning of a function
64 CmmInfo -- ^ Function header info
65 CLabel -- ^ The function name
66 CmmFormals -- ^ Aguments to function
68 | ContinuationEntry -- ^ Return point of a function call
69 CmmFormals -- ^ return values (argument to continuation)
70 C_SRT -- ^ SRT for the continuation's info table
71 Bool -- ^ True <=> GC block so ignore stack size
73 | ControlEntry -- ^ Any other kind of block.
74 -- Only entered due to control flow.
76 -- TODO: Consider adding ProcPointEntry
77 -- no return values, but some live might end up as
78 -- params or possibly in the frame
80 data ContFormat = ContFormat
81 CmmHintFormals -- ^ return values (argument to continuation)
82 C_SRT -- ^ SRT for the continuation's info table
83 Bool -- ^ True <=> GC block so ignore stack size
86 -- | Final statement in a 'BlokenBlock'.
87 -- Constructors and arguments match those in 'Cmm',
88 -- but are restricted to branches, returns, jumps, calls and switches
90 = FinalBranch -- ^ Same as 'CmmBranch'
91 BlockId -- ^ Target must be a ControlEntry
93 | FinalReturn -- ^ Same as 'CmmReturn'
94 CmmActuals -- ^ Return values
96 | FinalJump -- ^ Same as 'CmmJump'
97 CmmExpr -- ^ The function to call
98 CmmActuals -- ^ Arguments of the call
100 | FinalCall -- ^ Same as 'CmmForeignCall'
101 -- followed by 'CmmGoto'
102 BlockId -- ^ Target of the 'CmmGoto'
103 -- (must be a 'ContinuationEntry')
104 CmmCallTarget -- ^ The function to call
105 CmmHintFormals -- ^ Results from call
106 -- (redundant with ContinuationEntry)
107 CmmActuals -- ^ Arguments to call
108 C_SRT -- ^ SRT for the continuation's info table
109 Bool -- ^ True <=> GC block so ignore stack size
111 | FinalSwitch -- ^ Same as a 'CmmSwitch'
112 CmmExpr -- ^ Scrutinee (zero based)
113 [Maybe BlockId] -- ^ Targets
115 -----------------------------------------------------------------------------
116 -- Operations for broken blocks
117 -----------------------------------------------------------------------------
119 -- Naively breaking at *every* CmmCall leads to sub-optimal code.
120 -- In particular, a CmmCall followed by a CmmBranch would result
121 -- in a continuation that has the single CmmBranch statement in it.
122 -- It would be better have the CmmCall directly return to the block
123 -- that the branch jumps to.
125 -- This requires the target of the branch to look like the parameter
126 -- format that the CmmCall is expecting. If other CmmCall/CmmBranch
127 -- sequences go to the same place they might not be expecting the
128 -- same format. So this transformation uses the following solution.
129 -- First the blocks are broken up but none of the blocks are marked
130 -- as continuations yet. This is the 'breakBlock' function.
131 -- Second, the blocks "vote" on what other blocks need to be continuations
132 -- and how they should be layed out. Plurality wins, but other selection
133 -- methods could be selected at a later time.
134 -- This is the 'selectContinuations' function.
135 -- Finally, the blocks are upgraded to 'ContEntry' continuations
136 -- based on the results with the 'makeContinuationEntries' function,
137 -- and the blocks that didn't get the format they wanted for their
138 -- targets get a small adaptor block created for them by
139 -- the 'adaptBlockToFormat' function.
143 [BlockId] -- ^ Any GC blocks that should be special
144 -> [[Unique]] -- ^ An infinite list of uniques
145 -- to create names of the new blocks with
146 -> CmmInfo -- ^ Info table for the procedure
147 -> CLabel -- ^ Name of the procedure
148 -> CmmFormals -- ^ Parameters of the procedure
149 -> [CmmBasicBlock] -- ^ Blocks of the procecure
150 -- (First block is the entry block)
153 breakProc gc_block_idents uniques info ident params blocks =
155 (adaptor_uniques : block_uniques) = uniques
157 broken_blocks :: ([(BlockId, ContFormat)], [BrokenBlock])
160 zipWith3 (breakBlock gc_block_idents)
163 (FunctionEntry info ident params :
165 in (concatMap fst new_blocks, concatMap snd new_blocks)
167 selected = selectContinuations (fst broken_blocks)
169 in map (makeContinuationEntries selected) $
171 zipWith (adaptBlockToFormat selected)
175 -----------------------------------------------------------------------------
176 -- | Takes a 'CmmBasicBlock' and breaks it up into a list of 'BrokenBlock'
177 -- by splitting on each 'CmmCall' in the 'CmmBasicBlock'.
180 [BlockId] -- ^ Any GC blocks that should be special
181 -> [Unique] -- ^ An infinite list of uniques
182 -- to create names of the new blocks with
183 -> CmmBasicBlock -- ^ Input block to break apart
184 -> BlockEntryInfo -- ^ Info for the first created 'BrokenBlock'
185 -> ([(BlockId, ContFormat)], [BrokenBlock])
186 breakBlock gc_block_idents uniques (BasicBlock ident stmts) entry =
187 breakBlock' uniques ident entry [] [] stmts
189 breakBlock' uniques current_id entry exits accum_stmts stmts =
191 [] -> panic "block doesn't end in jump, goto, return or switch"
193 -- Last statement. Make the 'BrokenBlock'
194 [CmmJump target arguments] ->
196 [BrokenBlock current_id entry accum_stmts
198 (FinalJump target arguments)])
199 [CmmReturn arguments] ->
201 [BrokenBlock current_id entry accum_stmts
203 (FinalReturn arguments)])
204 [CmmBranch target] ->
206 [BrokenBlock current_id entry accum_stmts
208 (FinalBranch target)])
209 [CmmSwitch expr targets] ->
211 [BrokenBlock current_id entry accum_stmts
212 (mapMaybe id targets ++ exits)
213 (FinalSwitch expr targets)])
215 -- These shouldn't happen in the middle of a block.
216 -- They would cause dead code.
217 (CmmJump _ _:_) -> panic "jump in middle of block"
218 (CmmReturn _:_) -> panic "return in middle of block"
219 (CmmBranch _:_) -> panic "branch in middle of block"
220 (CmmSwitch _ _:_) -> panic "switch in middle of block"
222 -- Detect this special case to remain an inverse of
223 -- 'cmmBlockFromBrokenBlock'
224 [CmmCall target results arguments (CmmSafe srt),
225 CmmBranch next_id] ->
226 ([cont_info], [block])
228 cont_info = (next_id,
229 ContFormat results srt
230 (ident `elem` gc_block_idents))
231 block = do_call current_id entry accum_stmts exits next_id
232 target results arguments srt
234 -- Break the block on safe calls (the main job of this function)
235 (CmmCall target results arguments (CmmSafe srt) : stmts) ->
236 (cont_info : cont_infos, block : blocks)
238 next_id = BlockId $ head uniques
239 block = do_call current_id entry accum_stmts exits next_id
240 target results arguments srt
241 cont_info = (next_id,
242 ContFormat results srt
243 (ident `elem` gc_block_idents))
244 (cont_infos, blocks) = breakBlock' (tail uniques) next_id
245 ControlEntry [] [] stmts
247 -- Unsafe calls don't need a continuation
248 -- but they do need to be expanded
249 (CmmCall target results arguments CmmUnsafe : stmts) ->
250 breakBlock' remaining_uniques current_id entry exits
254 [CmmCall target results new_args CmmUnsafe] ++
258 (remaining_uniques, arg_stmts, new_args) =
259 loadArgsIntoTemps uniques arguments
260 (caller_save, caller_load) = callerSaveVolatileRegs (Just [])
262 -- Default case. Just keep accumulating statements
263 -- and branch targets.
265 breakBlock' uniques current_id entry
266 (cond_branch_target s++exits)
270 do_call current_id entry accum_stmts exits next_id
271 target results arguments srt =
272 BrokenBlock current_id entry accum_stmts (next_id:exits)
273 (FinalCall next_id target results arguments srt
274 (current_id `elem` gc_block_idents))
276 cond_branch_target (CmmCondBranch _ target) = [target]
277 cond_branch_target _ = []
279 -----------------------------------------------------------------------------
281 selectContinuations :: [(BlockId, ContFormat)] -> [(BlockId, ContFormat)]
282 selectContinuations needed_continuations = formats
284 formats = map select_format format_groups
285 format_groups = groupBy by_target needed_continuations
286 by_target x y = fst x == fst y
288 select_format formats = winner
290 winner = head $ head $ sortBy more_votes format_votes
291 format_votes = groupBy by_format formats
292 by_format x y = snd x == snd y
293 more_votes x y = compare (length y) (length x)
294 -- sort so the most votes goes *first*
295 -- (thus the order of x and y is reversed)
297 makeContinuationEntries formats
298 block@(BrokenBlock ident entry stmts targets exit) =
299 case lookup ident formats of
301 Just (ContFormat formals srt is_gc) ->
302 BrokenBlock ident (ContinuationEntry (map fst formals) srt is_gc)
305 adaptBlockToFormat :: [(BlockId, ContFormat)]
309 adaptBlockToFormat formats unique
310 block@(BrokenBlock ident entry stmts targets
311 exit@(FinalCall next target formals
312 actuals srt is_gc)) =
313 if format_formals == formals &&
315 format_is_gc == is_gc
316 then [block] -- Woohoo! This block got the continuation format it wanted
317 else [adaptor_block, revised_block]
318 -- This block didn't get the format it wanted for the
319 -- continuation, so we have to build an adaptor.
321 (ContFormat format_formals format_srt format_is_gc) =
322 maybe unknown_block id $ lookup next formats
323 unknown_block = panic "unknown block in adaptBlockToFormat"
325 revised_block = BrokenBlock ident entry stmts revised_targets revised_exit
326 revised_targets = adaptor_ident : delete next targets
327 revised_exit = FinalCall
328 adaptor_ident -- ^ The only part that changed
329 target formals actuals srt is_gc
331 adaptor_block = mk_adaptor_block adaptor_ident
332 (ContinuationEntry (map fst formals) srt is_gc)
334 adaptor_ident = BlockId unique
336 mk_adaptor_block :: BlockId -> BlockEntryInfo -> BlockId -> CmmHintFormals -> BrokenBlock
337 mk_adaptor_block ident entry next formals =
338 BrokenBlock ident entry [] [next] exit
341 (CmmLit (CmmLabel (mkReturnPtLabel (getUnique next))))
342 (map formal_to_actual format_formals)
344 formal_to_actual (reg, hint) = ((CmmReg (CmmLocal reg)), hint)
345 -- TODO: Check if NoHint is right. We're
346 -- jumping to a C-- function not a foreign one
347 -- so it might always be right.
348 adaptBlockToFormat _ _ block = [block]
350 -----------------------------------------------------------------------------
351 -- | Convert from a BrokenBlock back to an equivalent CmmBasicBlock
352 -- Needed by liveness analysis
353 cmmBlockFromBrokenBlock :: BrokenBlock -> CmmBasicBlock
354 cmmBlockFromBrokenBlock (BrokenBlock ident _ stmts _ exit) =
355 BasicBlock ident (stmts++exit_stmt)
359 FinalBranch target -> [CmmBranch target]
360 FinalReturn arguments -> [CmmReturn arguments]
361 FinalJump target arguments -> [CmmJump target arguments]
362 FinalSwitch expr targets -> [CmmSwitch expr targets]
363 FinalCall branch_target call_target results arguments srt _ ->
364 [CmmCall call_target results arguments (CmmSafe srt),
365 CmmBranch branch_target]
367 -----------------------------------------------------------------------------
368 -- | Build a mapping so we can lookup a 'BrokenBlock' by its 'BlockId'
369 blocksToBlockEnv :: [BrokenBlock] -> BlockEnv BrokenBlock
370 blocksToBlockEnv blocks = listToUFM $ map (\b -> (brokenBlockId b, b)) blocks