- performReturn do_before_stack_cleanup
- (\ sequel -> robustifySequel may_gc sequel
- `thenFC` \ (ret_asst, sequel') ->
- absC (ret_asst `mkAbsCStmts` do_just_before_jump)
- `thenC`
- mkPrimReturnCode sequel')
- live_vars
-
- ReturnsAlg tycon ->
- profCtrC SLIT("RET_NEW_IN_REGS") [num_of_fields] `thenC`
-
- performReturn do_before_stack_cleanup
- (\ sequel -> robustifySequel may_gc sequel
- `thenFC` \ (ret_asst, sequel') ->
- absC (mkAbstractCs [ret_asst,
- do_just_before_jump,
- info_ptr_assign])
- -- Must load info ptr here, not in do_just_before_stack_cleanup,
- -- because the info-ptr reg clashes with argument registers
- -- for the primop
- `thenC`
- mkDynamicAlgReturnCode tycon dyn_tag sequel')
- live_vars
- where
-
- -- Here, the destination _can_ be an update frame, so we need to make sure that
- -- infoptr (R2) is loaded with the constructor's info ptr.
-
- info_ptr_assign = CAssign (CReg infoptr) info_lbl
-
- info_lbl
- = case (ctrlReturnConvAlg tycon) of
- VectoredReturn _ -> vec_lbl
- UnvectoredReturn _ -> dir_lbl
-
- vec_lbl = CTableEntry (CLbl (mkInfoTableVecTblLabel tycon) DataPtrRep)
- dyn_tag DataPtrRep
-
- data_con = head (tyConDataCons tycon)
-
- (dir_lbl, num_of_fields)
- = case (dataReturnConvAlg data_con) of
- ReturnInRegs rs
- -> (CLbl (mkPhantomInfoTableLabel data_con) DataPtrRep,
- mkIntCLit (length rs)) -- for ticky-ticky only
-
- ReturnInHeap
- -> pprPanic "CgExpr: can't return prim in heap:" (ppr PprDebug data_con)
- -- Never used, and no point in generating
- -- the code for it!
- where
- -- for all PrimOps except ccalls, we pin the liveness info
- -- on as the first "argument"
- -- ToDo: un-duplicate?
-
- pin_liveness (CCallOp _ _ _ _ _) _ args = args
- pin_liveness other_op liveness_arg args
- = liveness_arg :args
-
- -- We only need to worry about the sequel when we may GC and the
- -- sequel is OnStack. If that's the case, arrange to pull the
- -- sequel out into RetReg before performing the primOp.
-
- robustifySequel True sequel@(OnStack _) =
- sequelToAmode sequel `thenFC` \ amode ->
- returnFC (CAssign (CReg RetReg) amode, InRetReg)
- robustifySequel _ sequel = returnFC (AbsCNop, sequel)
+ let result_amode = CReg (dataReturnConvPrim kind) in
+ performReturn
+ (COpStmt [result_amode] op arg_amodes [{-no vol_regs-}])
+ (mkPrimReturnCode (text "primapp)" <+> ppr x))
+
+ -- otherwise, must be returning an enumerated type (eg. Bool).
+ -- we've only got the tag in R2, so we have to load the constructor
+ -- itself into R1.
+
+ ReturnsAlg tycon
+ | isUnboxedTupleTyCon tycon -> primRetUnboxedTuple op args res_ty
+
+ | isEnumerationTyCon tycon ->
+ performReturn
+ (COpStmt [dyn_tag] op arg_amodes [{-no vol_regs-}])
+ (\ sequel ->
+ absC (CAssign (CReg node) closure_lbl) `thenC`
+ mkDynamicAlgReturnCode tycon dyn_tag sequel)
+
+ where
+ -- Pull a unique out of thin air to put the tag in.
+ -- It shouldn't matter if this overlaps with anything - we're
+ -- about to return anyway.
+ dyn_tag = CTemp (mkBuiltinUnique 0) IntRep
+
+ closure_lbl = CVal (CIndex
+ (CLbl (mkClosureTblLabel tycon) PtrRep)
+ dyn_tag PtrRep) PtrRep
+