- main_block = BasicBlock ident (stmts ++ postfix_stmts)
- prefix_id = BlockId prefix_unique
- gc_prefix = case entry of
- FunctionEntry _ _ _ -> gc_stmts
- ControlEntry -> []
- ContinuationEntry _ _ _ -> []
- param_prefix = if is_entry
- then param_stmts
- else []
+ -- If the target of a switch, branch or cond branch becomes a proc point
+ -- then we have to make a new block what will then *jump* to the original target.
+ proc_point_fix unique (CmmCondBranch test target)
+ = (CmmCondBranch test new_target, new_blocks)
+ where (new_target, new_blocks) = block_for_branch (head unique) target
+ proc_point_fix unique (CmmSwitch test targets)
+ = (CmmSwitch test new_targets, concat new_blocks)
+ where (new_targets, new_blocks) =
+ unzip $ zipWith block_for_branch' unique targets
+ proc_point_fix unique (CmmBranch target)
+ = (CmmBranch new_target, new_blocks)
+ where (new_target, new_blocks) = block_for_branch (head unique) target
+ proc_point_fix _ other = (other, [])
+
+ (fixed_main_stmts, new_blocks) = unzip $ zipWith proc_point_fix new_block_uniques main_stmts
+ main_stmts =
+ case entry of
+ FunctionEntry _ _ _ ->
+ -- Ugh, the statements for an update frame must come
+ -- *after* the GC check that was added at the beginning
+ -- of the CPS pass. So we have do edit the statements
+ -- a bit. This depends on the knowledge that the
+ -- statements in the first block are only the GC check.
+ -- That's fragile but it works for now.
+ gc_stmts ++ stmts ++ update_stmts ++ postfix_stmts
+ ControlEntry -> stmts ++ postfix_stmts
+ ContinuationEntry _ _ _ -> stmts ++ postfix_stmts