- result_regs = assignPrimOpResultRegs op
- result_amodes = map CReg result_regs
- may_gc = primOpCanTriggerGC op
- dyn_tag = head result_amodes
- -- The tag from a primitive op returning an algebraic data type
- -- is returned in the first result_reg_amode
- in
- (if may_gc then
- -- Use registers for args, and assign args to the regs
- -- (Can-trigger-gc primops guarantee to have their args in regs)
- let
- (arg_robust_amodes, liveness_mask, arg_assts)
- = makePrimOpArgsRobust op arg_amodes
-
- liveness_arg = mkIntCLit liveness_mask
- in
- returnFC (
- arg_assts,
- COpStmt result_amodes op
- (pin_liveness op liveness_arg arg_robust_amodes)
- liveness_mask
- [{-no vol_regs-}]
- )
- else
- -- Use args from their current amodes.
- let
- liveness_mask = panic "cgExpr: liveness of non-GC-ing primop touched\n"
- in
- returnFC (
- COpStmt result_amodes op arg_amodes liveness_mask [{-no vol_regs-}],
- AbsCNop
- )
- ) `thenFC` \ (do_before_stack_cleanup,
- do_just_before_jump) ->
-
- case (getPrimOpResultInfo op) of
-
- ReturnsPrim kind ->
- 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!
+ arg_hints = zip arg_tmps (map (typeHint.stgArgType) stg_args)
+ -- in
+ {-
+ Now, allocate some result regs.
+ -}
+ (res_reps,res_regs,res_hints) <- newUnboxedTupleRegs res_ty
+ ccallReturnUnboxedTuple (zip res_reps (map CmmReg res_regs)) $
+ emitForeignCall (zip res_regs res_hints) fcall
+ arg_hints emptyVarSet{-no live vars-}
+
+-- tagToEnum# is special: we need to pull the constructor out of the table,
+-- and perform an appropriate return.
+
+cgExpr (StgOpApp (StgPrimOp TagToEnumOp) [arg] res_ty)
+ = ASSERT(isEnumerationTyCon tycon)
+ do { (_,amode) <- getArgAmode arg
+ ; amode' <- assignTemp amode -- We're going to use it twice,
+ -- so save in a temp if non-trivial
+ ; stmtC (CmmAssign nodeReg (tagToClosure tycon amode'))
+ ; performReturn (emitAlgReturnCode tycon amode') }
+ where
+ -- If you're reading this code in the attempt to figure
+ -- out why the compiler panic'ed here, it is probably because
+ -- you used tagToEnum# in a non-monomorphic setting, e.g.,
+ -- intToTg :: Enum a => Int -> a ; intToTg (I# x#) = tagToEnum# x#
+ -- That won't work.
+ tycon = tyConAppTyCon res_ty
+
+
+cgExpr x@(StgOpApp op@(StgPrimOp primop) args res_ty)
+ | primOpOutOfLine primop
+ = tailCallPrimOp primop args
+
+ | ReturnsPrim VoidRep <- result_info
+ = do cgPrimOp [] primop args emptyVarSet
+ performReturn emitDirectReturnInstr
+
+ | ReturnsPrim rep <- result_info
+ = do cgPrimOp [dataReturnConvPrim (primRepToCgRep rep)]
+ primop args emptyVarSet
+ performReturn emitDirectReturnInstr
+
+ | ReturnsAlg tycon <- result_info, isUnboxedTupleTyCon tycon
+ = do (reps, regs, _hints) <- newUnboxedTupleRegs res_ty
+ cgPrimOp regs primop args emptyVarSet{-no live vars-}
+ returnUnboxedTuple (zip reps (map CmmReg regs))
+
+ | ReturnsAlg tycon <- result_info, isEnumerationTyCon tycon
+ -- c.f. cgExpr (...TagToEnumOp...)
+ = do tag_reg <- newTemp wordRep
+ cgPrimOp [tag_reg] primop args emptyVarSet
+ stmtC (CmmAssign nodeReg (tagToClosure tycon (CmmReg tag_reg)))
+ performReturn (emitAlgReturnCode tycon (CmmReg tag_reg))