-cgExpr (StgCon (PrimOp op@(CCallOp _ _ may_gc@True _)) args res_ty)
- = primRetUnboxedTuple op args res_ty
-
-cgExpr x@(StgCon (PrimOp op) args res_ty)
- | primOpOutOfLine op = tailCallPrimOp op args
- | otherwise
- = ASSERT(op /= SeqOp) -- can't handle SeqOp
-
- getArgAmodes args `thenFC` \ arg_amodes ->
-
- case (getPrimOpResultInfo op) of
-
- ReturnsPrim kind ->
- 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 = CTableEntry
- (CLbl (mkClosureTblLabel tycon) PtrRep)
- dyn_tag PtrRep
-
+cgExpr (StgOpApp (StgFCallOp fcall _) stg_args res_ty) = do
+ {-
+ First, copy the args into temporaries. We're going to push
+ a return address right before doing the call, so the args
+ must be out of the way.
+ -}
+ reps_n_amodes <- getArgAmodes stg_args
+ let
+ -- Get the *non-void* args, and jiggle them with shimForeignCall
+ arg_exprs = [ shimForeignCallArg stg_arg expr
+ | (stg_arg, (rep,expr)) <- stg_args `zip` reps_n_amodes,
+ nonVoidArg rep]
+
+ -- in
+ arg_tmps <- mapM assignTemp arg_exprs
+ let
+ 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))
+ where
+ result_info = getPrimOpResultInfo primop