Skip to content
Snippets Groups Projects
Commit aae28e68 authored by Simon Marlow's avatar Simon Marlow
Browse files

[project @ 1999-06-28 10:04:18 by simonmar]

Jump to the join point when returning a new constructor to a bind
default.  Fixes:  recent panic in mkStaticAlgReturnCode.
parent a33ecb97
No related branches found
No related tags found
No related merge requests found
...@@ -290,7 +290,7 @@ cgReturnDataCon con amodes all_zero_size_args ...@@ -290,7 +290,7 @@ cgReturnDataCon con amodes all_zero_size_args
case sequel of case sequel of
CaseAlts _ (Just (alts, Just (Nothing, (_,deflt_lbl)))) CaseAlts _ (Just (alts, Just (maybe_deflt, (_,deflt_lbl))))
| not (dataConTag con `is_elem` map fst alts) | not (dataConTag con `is_elem` map fst alts)
-> ->
-- Special case! We're returning a constructor to the default case -- Special case! We're returning a constructor to the default case
...@@ -304,7 +304,9 @@ cgReturnDataCon con amodes all_zero_size_args ...@@ -304,7 +304,9 @@ cgReturnDataCon con amodes all_zero_size_args
-- if the default is a non-bind-default (ie does not use y), -- if the default is a non-bind-default (ie does not use y),
-- then we should simply jump to the default join point; -- then we should simply jump to the default join point;
performReturn AbsCNop {- No reg assts -} jump_to_join_point case maybe_deflt of
Nothing -> performReturn AbsCNop {- No reg assts -} jump_to_join_point
Just _ -> build_it_then jump_to_join_point
where where
is_elem = isIn "cgReturnDataCon" is_elem = isIn "cgReturnDataCon"
jump_to_join_point sequel = absC (CJump (CLbl deflt_lbl CodePtrRep)) jump_to_join_point sequel = absC (CJump (CLbl deflt_lbl CodePtrRep))
...@@ -372,30 +374,33 @@ cgReturnDataCon con amodes all_zero_size_args ...@@ -372,30 +374,33 @@ cgReturnDataCon con amodes all_zero_size_args
False {-node doesn't point-} False {-node doesn't point-}
| otherwise -> | otherwise ->
-- BUILD THE OBJECT IN THE HEAP build_it_then (mkStaticAlgReturnCode con)
-- The first "con" says that the name bound to this
-- closure is "con", which is a bit of a fudge, but it only
-- affects profiling
-- This Id is also used to get a unique for a
-- temporary variable, if the closure is a CHARLIKE.
-- funilly enough, this makes the unique always come
-- out as '54' :-)
buildDynCon (mkDataConId con) currentCCS
con amodes all_zero_size_args
`thenFC` \ idinfo ->
idInfoToAmode PtrRep idinfo `thenFC` \ amode ->
-- RETURN
profCtrC SLIT("TICK_RET_NEW") [mkIntCLit (length amodes)] `thenC`
-- could use doTailCall here.
performReturn (move_to_reg amode node)
(mkStaticAlgReturnCode con)
where where
con_name = dataConName con con_name = dataConName con
move_to_reg :: CAddrMode -> MagicId -> AbstractC move_to_reg :: CAddrMode -> MagicId -> AbstractC
move_to_reg src_amode dest_reg = CAssign (CReg dest_reg) src_amode move_to_reg src_amode dest_reg = CAssign (CReg dest_reg) src_amode
build_it_then return =
-- BUILD THE OBJECT IN THE HEAP
-- The first "con" says that the name bound to this
-- closure is "con", which is a bit of a fudge, but it only
-- affects profiling
-- This Id is also used to get a unique for a
-- temporary variable, if the closure is a CHARLIKE.
-- funilly enough, this makes the unique always come
-- out as '54' :-)
buildDynCon (mkDataConId con) currentCCS
con amodes all_zero_size_args
`thenFC` \ idinfo ->
idInfoToAmode PtrRep idinfo `thenFC` \ amode ->
-- RETURN
profCtrC SLIT("TICK_RET_NEW") [mkIntCLit (length amodes)] `thenC`
-- could use doTailCall here.
performReturn (move_to_reg amode node) return
\end{code} \end{code}
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment