-%************************************************************************
-%* *
-\subsection[CgCase-return-vec]{Building a return vector}
-%* *
-%************************************************************************
-
-Build a return vector, and return a suitable label addressing
-mode for it.
-
-\begin{code}
-mkReturnVector :: Unique
- -> [(ConTag, AbstractC)] -- Branch codes
- -> AbstractC -- Default case
- -> SRT -- continuation's SRT
- -> Liveness -- stack liveness
- -> CtrlReturnConvention
- -> FCode CAddrMode
-
-mkReturnVector uniq tagged_alt_absCs deflt_absC srt liveness ret_conv
- = getSRTInfo srt `thenFC` \ srt_info ->
- let
- (return_vec_amode, vtbl_body) = case ret_conv of {
-
- -- might be a polymorphic case...
- UnvectoredReturn 0 ->
- ASSERT(null tagged_alt_absCs)
- (CLbl ret_label RetRep,
- absC (CRetDirect uniq deflt_absC srt_info liveness));
-
- UnvectoredReturn n ->
- -- find the tag explicitly rather than using tag_reg for now.
- -- on architectures with lots of regs the tag will be loaded
- -- into tag_reg by the code doing the returning.
- let
- tag = CMacroExpr WordRep GET_TAG [CVal (nodeRel 0) DataPtrRep]
- in
- (CLbl ret_label RetRep,
- absC (CRetDirect uniq
- (mkAlgAltsCSwitch tag tagged_alt_absCs deflt_absC)
- srt_info
- liveness));
-
- VectoredReturn table_size ->
- let
- (vector_table, alts_absC) =
- unzip (map mk_vector_entry [fIRST_TAG .. (table_size+fIRST_TAG-1)])
-
- ret_vector = CRetVector vtbl_label vector_table srt_info liveness
- in
- (CLbl vtbl_label DataPtrRep,
- -- alts come first, because we don't want to declare all the symbols
- absC (mkAbstractCs (mkAbstractCs alts_absC : [deflt_absC,ret_vector]))
- )
-
- } in
- vtbl_body `thenC`
- returnFC return_vec_amode
- -- )
- where
-
- vtbl_label = mkVecTblLabel uniq
- ret_label = mkReturnInfoLabel uniq
-
- deflt_lbl =
- case nonemptyAbsC deflt_absC of
- -- the simplifier might have eliminated a case
- Nothing -> mkIntCLit 0 -- CLbl mkErrorStdEntryLabel CodePtrRep
- Just absC@(CCodeBlock lbl _) -> CLbl lbl CodePtrRep
-
- mk_vector_entry :: ConTag -> (CAddrMode, AbstractC)
- mk_vector_entry tag
- = case [ absC | (t, absC) <- tagged_alt_absCs, t == tag ] of
- [] -> (deflt_lbl, AbsCNop)
- [absC@(CCodeBlock lbl _)] -> (CLbl lbl CodePtrRep,absC)
- _ -> panic "mkReturnVector: too many"
-\end{code}
-
-%************************************************************************
-%* *
-\subsection[CgCase-utils]{Utilities for handling case expressions}
-%* *
-%************************************************************************
-
-@possibleHeapCheck@ tests a flag passed in to decide whether to do a
-heap check or not. These heap checks are always in a case
-alternative, so we use altHeapCheck.
-
-\begin{code}
-possibleHeapCheck
- :: GCFlag
- -> Bool -- True <=> algebraic case
- -> [MagicId] -- live registers
- -> [(VirtualSpOffset,Int)] -- stack slots to tag
- -> Maybe Unique -- return address unique
- -> Code -- continuation
- -> Code
-
-possibleHeapCheck GCMayHappen is_alg regs tags lbl code
- = altHeapCheck is_alg regs tags AbsCNop lbl code
-possibleHeapCheck NoGC _ _ tags lbl code
- = code
-\end{code}