Commit be0113bd authored by Michael D. Adams's avatar Michael D. Adams
Browse files

Fixed conditional branches to proc points

These could occur due to GC checks.
parent ff128a16
......@@ -113,7 +113,7 @@ cpsProc uniqSupply (CmmProc info ident params blocks) = cps_procs
uniques = map uniqsFromSupply $ listSplitUniqSupply uniqSupply1
(stack_check_block_unique:stack_use_unique:adaptor_uniques) :
block_uniques = uniques
proc_uniques = map (map uniqsFromSupply . listSplitUniqSupply) $ listSplitUniqSupply uniqSupply2
proc_uniques = map (map (map uniqsFromSupply . listSplitUniqSupply) . listSplitUniqSupply) $ listSplitUniqSupply uniqSupply2
stack_use = CmmLocal (LocalReg stack_use_unique (cmmRegRep spReg) KindPtr)
stack_check_block_id = BlockId stack_check_block_unique
......
......@@ -25,6 +25,7 @@ import Constants
import StaticFlags
import Unique
import Maybe
import List
import Panic
......@@ -81,7 +82,7 @@ data ContinuationFormat
-----------------------------------------------------------------------------
continuationToProc :: (WordOff, WordOff, [(CLabel, ContinuationFormat)])
-> CmmReg
-> [[Unique]]
-> [[[Unique]]]
-> Continuation CmmInfo
-> CmmTop
continuationToProc (max_stack, update_frame_size, formats) stack_use uniques
......@@ -108,17 +109,12 @@ continuationToProc (max_stack, update_frame_size, formats) stack_use uniques
adjust_sp_reg (curr_stack - update_frame_size)
CmmInfo _ Nothing _ -> []
-- At present neither the Cmm parser nor the code generator
-- produce code that will allow the target of a CmmCondBranch
-- or a CmmSwitch to become a continuation or a proc-point.
-- If future revisions, might allow these to happen
-- then special care will have to be take to allow for that case.
continuationToProc' :: [Unique]
continuationToProc' :: [[Unique]]
-> BrokenBlock
-> Bool
-> [CmmBasicBlock]
continuationToProc' uniques (BrokenBlock ident entry stmts _ exit) is_entry =
prefix_blocks ++ [main_block]
prefix_blocks ++ [BasicBlock ident fixed_main_stmts] ++ concat new_blocks
where
prefix_blocks =
if is_entry
......@@ -127,10 +123,16 @@ continuationToProc (max_stack, update_frame_size, formats) stack_use uniques
(param_stmts ++ [CmmBranch ident])]
else []
prefix_unique : call_uniques = uniques
(prefix_unique : call_uniques) : new_block_uniques = uniques
toCLabel = mkReturnPtLabel . getUnique
block_for_branch :: Unique -> BlockId -> (BlockId, [CmmBasicBlock])
block_for_branch unique next
-- branches to the current function don't have to jump
| (mkReturnPtLabel $ getUnique next) == label
= (next, [])
-- branches to any other function have to jump
| (Just cont_format) <- lookup (toCLabel next) formats
= let
new_next = BlockId unique
......@@ -142,15 +144,34 @@ continuationToProc (max_stack, update_frame_size, formats) stack_use uniques
tail_call (curr_stack - cont_stack)
(CmmLit $ CmmLabel $ toCLabel next)
arguments])
-- branches to blocks in the current function don't have to jump
| otherwise
= (next, [])
-- Wrapper for block_for_branch for when the target
-- is inside a 'Maybe'.
block_for_branch' :: Unique -> Maybe BlockId -> (Maybe BlockId, [CmmBasicBlock])
block_for_branch' _ Nothing = (Nothing, [])
block_for_branch' unique (Just next) = (Just new_next, new_blocks)
where (new_next, new_blocks) = block_for_branch unique next
main_block =
-- 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
......@@ -159,28 +180,21 @@ continuationToProc (max_stack, update_frame_size, formats) stack_use uniques
-- 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.
BasicBlock ident (gc_stmts ++ stmts ++ update_stmts ++ postfix_stmts)
ControlEntry -> BasicBlock ident (stmts ++ postfix_stmts)
ContinuationEntry _ _ _ -> BasicBlock ident (stmts ++ postfix_stmts)
gc_stmts ++ stmts ++ update_stmts ++ postfix_stmts
ControlEntry -> stmts ++ postfix_stmts
ContinuationEntry _ _ _ -> stmts ++ postfix_stmts
postfix_stmts = case exit of
FinalBranch next ->
if (mkReturnPtLabel $ getUnique next) == label
then [CmmBranch next]
else case lookup (mkReturnPtLabel $ getUnique next) formats of
Nothing -> [CmmBranch next]
Just cont_format ->
pack_continuation True curr_format cont_format ++
tail_call (curr_stack - cont_stack)
(CmmLit $ CmmLabel $ mkReturnPtLabel $ getUnique next)
arguments
where
cont_stack = continuation_frame_size cont_format
arguments = map formal_to_actual (continuation_formals cont_format)
-- Branches and switches may get modified by proc_point_fix
FinalBranch next -> [CmmBranch next]
FinalSwitch expr targets -> [CmmSwitch expr targets]
-- A return is a tail call to the stack top
FinalReturn arguments ->
tail_call curr_stack
(entryCode (CmmLoad (CmmReg spReg) wordRep))
arguments
-- A tail call
FinalJump target arguments ->
tail_call curr_stack target arguments
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment