-doTailCall arg_amodes arg_regs finish_code arity pending_assts
- maybe_join_sp node_points
- = getEndOfBlockInfo `thenFC` \ eob@(EndOfBlockInfo args_sp sequel) ->
-
- let
- (reg_arg_amodes, stk_arg_amodes) = splitAtList arg_regs arg_amodes
- -- We get some stk_arg_amodes if (a) no regs, or
- -- (b) args beyond arity
-
- reg_arg_assts
- = mkAbstractCs (zipWithEqual "assign_to_reg2"
- assign_to_reg arg_regs reg_arg_amodes)
-
- assign_to_reg reg_id amode = CAssign (CReg reg_id) amode
-
- join_sp = case maybe_join_sp of
- Just sp -> ASSERT(not (args_sp > sp)) sp
- -- If ASSERTion fails: Oops: the join point has *lower*
- -- stack ptrs than the continuation Note that we take
- -- the Sp point without the return address here. The
- -- return address is put on by the let-no-escapey thing
- -- when it finishes.
- Nothing -> args_sp
-
- (fast_stk_amodes, tagged_stk_amodes) =
- splitAt arity stk_arg_amodes
-
- -- eager blackholing, at the end of the basic block.
- (r1_tmp_asst, bh_asst)
- = case sequel of
-#if 0
- -- no: UpdateCode doesn't tell us that we're in a thunk's entry code.
- -- we might be in a case continuation later down the line. Also,
- -- we might have pushed a return address on the stack, if we're in
- -- a case scrut, and still be in the thunk's entry code.
- UpdateCode ->
- (CAssign node_save nodeReg,
- CAssign (CVal (CIndex node_save (mkIntCLit 0) PtrRep)
- PtrRep)
- (CLbl mkBlackHoleInfoTableLabel DataPtrRep))
- where
- node_save = CTemp (mkPseudoUnique1 2) DataPtrRep
-#endif
- _ -> (AbsCNop, AbsCNop)
- in
- -- We can omit tags on the arguments passed to the fast entry point,
- -- but we have to be careful to fill in the tags on any *extra*
- -- arguments we're about to push on the stack.
-
- mkTaggedStkAmodes join_sp tagged_stk_amodes `thenFC`
- \ (fast_sp, tagged_arg_assts, tag_assts) ->
-
- mkTaggedStkAmodes fast_sp fast_stk_amodes `thenFC`
- \ (final_sp, fast_arg_assts, _) ->
-
- -- adjust the high-water mark if necessary
- adjustStackHW final_sp `thenC`
-
- -- The stack space for the pushed return addess,
- -- with any args pushed on top, is recorded in final_sp.
-
- -- Do the simultaneous assignments,
- doSimAssts (mkAbstractCs [r1_tmp_asst,
- pending_assts,
- reg_arg_assts,
- fast_arg_assts,
- tagged_arg_assts,
- tag_assts]) `thenC`
- absC bh_asst `thenC`
-
- -- push a return address if necessary
- -- (after the assignments above, in case we clobber a live
- -- stack location)
-
- -- DONT push the return address when we're about
- -- to jump to a let-no-escape: the final tail call
- -- in the let-no-escape will do this.
- (if (maybeToBool maybe_join_sp)
- then nopC
- else pushReturnAddress eob) `thenC`
-
- -- Final adjustment of Sp/Hp
- adjustSpAndHp final_sp `thenC`
+emitAlgReturnCode :: TyCon -> CmmExpr -> Code
+-- emitAlgReturnCode is used both by emitKnownConReturnCode,
+-- and by by PrimOps that return enumerated types (i.e.
+-- all the comparison operators).
+emitAlgReturnCode tycon tag
+ = do { case ctrlReturnConvAlg tycon of
+ VectoredReturn fam_sz -> do { tickyVectoredReturn fam_sz
+ ; emitVectoredReturnInstr tag }
+ UnvectoredReturn _ -> emitDirectReturnInstr
+ }
+
+
+-- ---------------------------------------------------------------------------
+-- Unboxed tuple returns
+
+-- These are a bit like a normal tail call, except that:
+--
+-- - The tail-call target is an info table on the stack
+--
+-- - We separate stack arguments into pointers and non-pointers,
+-- to make it easier to leave things in a sane state for a heap check.
+-- This is OK because we can never partially-apply an unboxed tuple,
+-- unlike a function. The same technique is used when calling
+-- let-no-escape functions, because they also can't be partially
+-- applied.
+
+returnUnboxedTuple :: [(CgRep, CmmExpr)] -> Code
+returnUnboxedTuple amodes
+ = do { eob@(EndOfBlockInfo args_sp sequel) <- getEndOfBlockInfo
+ ; tickyUnboxedTupleReturn (length amodes)
+ ; (final_sp, assts) <- pushUnboxedTuple args_sp amodes
+ ; emitSimultaneously assts
+ ; doFinalJump final_sp False{-not a LNE-} emitDirectReturnInstr }
+
+pushUnboxedTuple :: VirtualSpOffset -- Sp at which to start pushing
+ -> [(CgRep, CmmExpr)] -- amodes of the components
+ -> FCode (VirtualSpOffset, -- final Sp
+ CmmStmts) -- assignments (regs+stack)
+
+pushUnboxedTuple sp []
+ = return (sp, noStmts)
+pushUnboxedTuple sp amodes
+ = do { let (reg_arg_amodes, stk_arg_amodes) = assignReturnRegs amodes