%
% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
%
-% $Id: CgExpr.lhs,v 1.48 2002/04/29 14:03:41 simonmar Exp $
+% $Id: CgExpr.lhs,v 1.51 2002/09/13 15:02:28 simonpj Exp $
%
%********************************************************
%* *
import StgSyn
import CgMonad
import AbsCSyn
-import AbsCUtils ( mkAbstractCs )
+import AbsCUtils ( mkAbstractCs, getAmodeRep )
import CLabel ( mkClosureTblLabel )
import SMRep ( fixedHdrSize )
import CostCentre ( sccAbleCostCentre, isSccCountCostCentre )
import Id ( idPrimRep, idType, Id )
import VarSet
-import PrimOp ( primOpOutOfLine, getPrimOpResultInfo, PrimOp(..), PrimOpResultInfo(..) )
+import PrimOp ( primOpOutOfLine, getPrimOpResultInfo,
+ PrimOp(..), PrimOpResultInfo(..) )
+import TysPrim ( foreignObjPrimTyCon, arrayPrimTyCon,
+ byteArrayPrimTyCon, mutableByteArrayPrimTyCon,
+ mutableArrayPrimTyCon )
import PrimRep ( PrimRep(..), isFollowableRep )
import TyCon ( isUnboxedTupleTyCon, isEnumerationTyCon )
import Type ( Type, typePrimRep, tyConAppArgs, tyConAppTyCon, repType )
= tailCallPrimOp primop args
| otherwise
- = ASSERT(primop /= SeqOp) -- can't handle SeqOp
-
- getArgAmodes args `thenFC` \ arg_amodes ->
+ = getArgAmodes args `thenFC` \ arg_amodes ->
case (getPrimOpResultInfo primop) of
\begin{code}
primRetUnboxedTuple :: StgOp -> [StgArg] -> Type -> Code
primRetUnboxedTuple op args res_ty
- = getArgAmodes args `thenFC` \ arg_amodes ->
+ = getArgAmodes args `thenFC` \ arg_amodes1 ->
+ {-
+ For a foreign call, we might need to fiddle with some of the args:
+ for example, when passing a ByteArray#, we pass a ptr to the goods
+ rather than the heap object.
+ -}
+ let
+ arg_amodes
+ | StgFCallOp{} <- op = zipWith shimFCallArg args arg_amodes1
+ | otherwise = arg_amodes1
+ in
{-
put all the arguments in temporaries so they don't get stomped when
we push the return address.
let
n_args = length args
arg_uniqs = map mkBuiltinUnique [0 .. n_args-1]
- arg_reps = map getArgPrimRep args
+ arg_reps = map getAmodeRep arg_amodes
arg_temps = zipWith CTemp arg_uniqs arg_reps
in
absC (mkAbstractCs (zipWith CAssign arg_temps arg_amodes)) `thenC`
temp_amodes = zipWith CTemp temp_uniqs prim_reps
in
returnUnboxedTuple temp_amodes (absC (COpStmt temp_amodes op arg_temps []))
+
+shimFCallArg arg amode
+ | tycon == foreignObjPrimTyCon
+ = CMacroExpr AddrRep ForeignObj_CLOSURE_DATA [amode]
+ | tycon == arrayPrimTyCon || tycon == mutableArrayPrimTyCon
+ = CMacroExpr PtrRep PTRS_ARR_CTS [amode]
+ | tycon == byteArrayPrimTyCon || tycon == mutableByteArrayPrimTyCon
+ = CMacroExpr AddrRep BYTE_ARR_CTS [amode]
+ | otherwise = amode
+ where
+ -- should be a tycon app, since this is a foreign call
+ tycon = tyConAppTyCon (repType (stgArgType arg))
\end{code}