static void DoCmplxScalarOp( RTCODE rtn_id, cg_name a, cg_name b, cg_name s ) {
//=========================================================================
// Do a complex operation.
call_handle handle;
cg_type typ;
cg_type r_typ;
typ = CGType( a );
if( typ == TY_DOUBLE ) {
rtn_id += RT_C_DOUBLE;
r_typ = TY_DCOMPLEX;
} else if( typ == TY_LONGDOUBLE ) {
rtn_id += RT_C_EXTENDED;
r_typ = TY_XCOMPLEX;
} else {
r_typ = TY_COMPLEX;
}
handle = InitCall( rtn_id );
CGAddParm( handle, a, typ );
CGAddParm( handle, b, typ );
CGAddParm( handle, s, PromoteIntType( CGType( s ) ) );
SplitCmplx( CGCall( handle ), r_typ );
}
void DoCmplxOp( RTCODE rtn_id, cg_name a, cg_name b, cg_name c, cg_name d ) {
//===========================================================================
// Do a complex operation.
call_handle handle;
cg_type typ;
cg_type r_typ;
typ = ResCGType( CGType( a ), CGType( c ) );
if( typ == TY_DOUBLE ) {
rtn_id += RT_C_DOUBLE;
r_typ = TY_DCOMPLEX;
} else if( typ == TY_LONGDOUBLE ) {
rtn_id += RT_C_EXTENDED;
r_typ = TY_XCOMPLEX;
} else {
r_typ = TY_COMPLEX;
}
handle = InitCall( rtn_id );
CGAddParm( handle, a, typ );
CGAddParm( handle, b, typ );
CGAddParm( handle, c, typ );
CGAddParm( handle, d, typ );
SplitCmplx( CGCall( handle ), r_typ );
}
void XPopCmplx( cg_cmplx *z, cg_type typ ) {
//=====================================================
// Get complex value.
cg_name opn;
opn = XPop();
if( TypePointer( CGType( opn ) ) ) {
SplitCmplx( opn, typ );
z->realpart = XPop();
} else {
z->realpart = opn;
}
z->imagpart = XPop();
}
void FCSFCall( void ) {
//==================
// Call a statement function.
sym_id sf;
sym_id sf_arg;
sym_id tmp;
cg_type sf_type;
cg_name arg_list;
cg_name value;
cg_cmplx z;
obj_ptr curr_obj;
sf = GetPtr();
arg_list = NULL;
value = NULL;
sf_type = 0;
for(;;) {
sf_arg = GetPtr();
if( sf_arg == NULL ) break;
if( sf_arg->u.ns.u1.s.typ == FT_CHAR ) {
value = Concat( 1, CGFEName( sf_arg, TY_CHAR ) );
} else {
sf_type = F772CGType( sf_arg );
if( TypeCmplx( sf_arg->u.ns.u1.s.typ ) ) {
XPopCmplx( &z, sf_type );
sf_type = CmplxBaseType( sf_type );
value = ImagPtr( SymAddr( sf_arg ), sf_type );
CGTrash( CGAssign( value, z.imagpart, sf_type ) );
value = CGFEName( sf_arg, sf_type );
value = CGAssign( value, z.realpart, sf_type );
} else {
value = CGFEName( sf_arg, sf_type );
value = CGAssign( value, XPopValue( sf_type ), sf_type );
}
}
if( arg_list == NULL ) {
arg_list = value;
} else {
arg_list = CGBinary( O_COMMA, arg_list, value, TY_DEFAULT );
}
}
if( sf->u.ns.u1.s.typ == FT_CHAR ) {
tmp = GetPtr();
value = CGUnary( O_POINTS, CGFEName( tmp, TY_CHAR ), TY_CHAR );
value = CGAssign( CGFEName( sf, TY_CHAR ), value, TY_CHAR );
if( arg_list == NULL ) {
arg_list = value;
} else {
arg_list = CGBinary( O_COMMA, arg_list, value, TY_DEFAULT );
}
value = CGFEName( tmp, TY_CHAR );
} else {
sf_type = F772CGType( sf );
if( !(OZOpts & OZOPT_O_INLINE) ) {
value = CGUnary( O_POINTS, CGFEName( sf, sf_type ), sf_type );
}
}
if( OZOpts & OZOPT_O_INLINE ) {
if( arg_list != NULL ) {
CGTrash( arg_list );
}
curr_obj = FCodeSeek( sf->u.ns.si.sf.u.sequence );
GetObjPtr();
FCodeSequence();
FCodeSeek( curr_obj );
if( sf->u.ns.u1.s.typ == FT_CHAR ) {
CGTrash( XPop() );
XPush( value );
} else if( TypeCmplx( sf->u.ns.u1.s.typ ) ) {
XPopCmplx( &z, sf_type );
sf_type = CmplxBaseType( sf_type );
XPush( TmpVal( MkTmp( z.imagpart, sf_type ), sf_type ) );
XPush( TmpVal( MkTmp( z.realpart, sf_type ), sf_type ) );
} else {
XPush( TmpVal( MkTmp( XPopValue( sf_type ), sf_type ), sf_type ) );
}
} else {
value = CGWarp( arg_list, GetLabel( sf->u.ns.si.sf.u.location ), value );
// consider: y = f( a, f( b, c, d ), e )
// make sure that inner reference to f gets evaluated before we assign
// arguments for outer reference
value = CGEval( value );
if( TypeCmplx( sf->u.ns.u1.s.typ ) ) {
SplitCmplx( TmpPtr( MkTmp( value, sf_type ), sf_type ), sf_type );
} else {
XPush( value );
}
RefStmtFunc( sf );
}
}
