fccmplx.c

来自「开放源码的编译器open watcom 1.6.0版的源代码」· C语言 代码 · 共 932 行 · 第 1/2 页

    }
#else
    // For risc we just inline the entire code
    InLineMulCC( GetU16() );
#endif
}


void    InLineMulCC( unsigned_16 typ_info ) {
//===========================================

// Do complex multiplication in-line.
// (c,d) * (a,b).

    cg_name     d_1;
    cg_name     d_2;
    cg_name     c_1;
    cg_name     c_2;
    cg_name     b_1;
    cg_name     b_2;
    cg_name     a_1;
    cg_name     a_2;
    cg_type     typ1;
    cg_type     typ2;
    cg_cmplx    x;
    cg_cmplx    y;

    typ1 = GetType1( typ_info );
    typ2 = GetType2( typ_info );
    XPopCmplx( &x, typ1 );
    XPopCmplx( &y, typ2 );
    typ1 = CmplxBaseType( typ1 );
    typ2 = CmplxBaseType( typ2 );
    CloneCGName( x.realpart, &a_1, &a_2 );
    CloneCGName( x.imagpart, &b_1, &b_2 );
    CloneCGName( y.realpart, &c_1, &c_2 );
    CloneCGName( y.imagpart, &d_1, &d_2 );
    typ1 = ResCGType( typ1, typ2 );
    XPush( CGBinary( O_PLUS,
                     CGBinary( O_TIMES, a_1, d_1, typ1 ),
                     CGBinary( O_TIMES, b_1, c_1, typ1 ),
                     typ1 ) );
    XPush( CGBinary( O_MINUS,
                     CGBinary( O_TIMES, a_2, c_2, typ1 ),
                     CGBinary( O_TIMES, b_2, d_2, typ1 ),
                     typ1 ) );
}


void    FCDivCmplx( void ) {
//====================

// Binary division for complex numbers.

    XCmplxOp( RT_C8DIV );
}


void    FCExpCmplx( void ) {
//====================

// Binary exponentiation for complex numbers.

    XCmplxOp( RT_C8POW );
}


void    FCExpMixCX( void ) {
//====================

// Binary exponentiation for complex**non-complex.

    XCmplxMixOp( RT_C8POW, TRUE );
}


void    FCExpMixXC( void ) {
//====================

// Binary exponentiation for non-complex**complex.

    XCmplxMixOp( RT_C8POW, FALSE );
}


static cg_type PromoteIntType( cg_type typ ) {
//============================================

    if( ( typ == T_INT_1 ) || ( typ == T_INT_2 ) ) {
        typ = T_INT_4;
    }
    return( typ );
}


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 == T_DOUBLE ) {
        rtn_id += RT_C_DOUBLE;
        r_typ = T_DCOMPLEX;
    } else if( typ == T_LONGDOUBLE ) {
        rtn_id += RT_C_EXTENDED;
        r_typ = T_XCOMPLEX;
    } else {
        r_typ = T_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    XCmplxMixOp( RTCODE rtn_id, bool cmplx_scalar ) {
//=======================================================

// F-Code processor for binary complex number operations involving
// runtime routines.
// x / (c,d) or (c,d) / x

    unsigned_16 typ_info;
    cg_type     s_typ;
    cg_type     x_typ;
    cg_name     s;
    cg_cmplx    x;

    typ_info = GetU16();
    if( cmplx_scalar ) {
        x_typ = GetType1( typ_info );
        s_typ = GetType2( typ_info );
        XPopCmplx( &x, x_typ );
        s = XPopValue( s_typ );
    } else {
        s_typ = GetType1( typ_info );
        x_typ = GetType2( typ_info );
        s = XPopValue( s_typ );
        XPopCmplx( &x, x_typ );
    }
    x_typ = ResCGType( s_typ, CmplxBaseType( x_typ ) );
    if( cmplx_scalar ) {
        // currently, the only time XCmplxMixOp() is called when the left
        // operand is complex and the right operand is a scalar, is for
        // exponentiation
        s_typ = PromoteIntType( s_typ );
        if( s_typ == T_INT_4 ) {
            DoCmplxScalarOp( RT_C8POWI, x.realpart, x.imagpart, s );
        } else {
            DoCmplxOp( rtn_id, x.realpart, x.imagpart, s, CGInteger( 0, x_typ ) );
        }
    } else {
        DoCmplxOp( rtn_id, s, CGInteger( 0, x_typ ), x.realpart, x.imagpart );
    }
}


static  void    CCCmp( cg_op op, cg_name a, cg_name b, cg_name c, cg_name d ) {
//=============================================================================

// Complex/Complex compare.

    cg_type     res_type;
    cg_op       flow_op;

    res_type = ResCGType( CGType( a ), CGType( c ) );
    if( op == O_EQ ) {
       flow_op = O_FLOW_AND;
    } else {
       flow_op = O_FLOW_OR;
    }
    XPush( CGFlow( flow_op, CGCompare( op, a, c, res_type ),
                            CGCompare( op, b, d, res_type ) ) );
}


void    CCCompare( int op ) {
//===========================

// Complex/Complex compare.

    cg_cmplx    x;
    cg_cmplx    y;
    unsigned_16 typ_info;

    typ_info = GetU16();
    XPopCmplx( &x, GetType1( typ_info ) );
    XPopCmplx( &y, GetType2( typ_info ) );
    CCCmp( op, x.realpart, x.imagpart, y.realpart, y.imagpart );
}


void    XCCompare( int op ) {
//===========================

// Scalar/Complex compare.

    cg_name     x;
    cg_cmplx    z;
    unsigned_16 typ_info;
    cg_type     typ1;

    typ_info = GetU16();
    typ1 = GetType1( typ_info );
    x = XPopValue( typ1 );
    XPopCmplx( &z, GetType2( typ_info ) );
    CCCmp( op, x, CGInteger( 0, typ1 ), z.realpart, z.imagpart );
}


static  void    CXCompare( int op ) {
//===================================

// Complex/Scalar compare.

    cg_name     x;
    cg_cmplx    z;
    unsigned_16 typ_info;
    cg_type     typ2;

    typ_info = GetU16();
    typ2 = GetType2( typ_info );
    XPopCmplx( &z, GetType1( typ_info ) );
    x = XPopValue( typ2 );
    CCCmp( op, z.realpart, z.imagpart, x, CGInteger( 0, typ2 ) );
}


void    FCCCCmpEQ( void ) {
//===================

// Complex/Complex compare for equality.

    CCCompare( O_EQ );
}


void    FCCCCmpNE( void ) {
//===================

// Complex/Complex compare for non-equality.

    CCCompare( O_NE );
}


void    FCXCCmpEQ( void ) {
//===================

// Scalar/Complex compare for equality.

    XCCompare( O_EQ );
}


void    FCXCCmpNE( void ) {
//===================

// Scalar/Complex compare for non-equality.

    XCCompare( O_NE );
}


void    FCCXCmpEQ( void ) {
//===================

// Complex/Scalar compare for equality.

    CXCompare( O_EQ );
}


void    FCCXCmpNE( void ) {
//===================

// Complex/Scalar compare for non-equality.

    CXCompare( O_NE );
}


void    PushComplex( sym_id sym ) {
//=================================

// Push a complex number.

    XPush( SymAddr( sym ) );
}


void            PushCmplxConst( sym_id sym ) {
//============================================

// Push a complex constant.

    char        fmt_buff[80];

    if( sym->cn.typ == TY_COMPLEX ) {
        CnvS2S( &sym->cn.value.complex.imagpart, fmt_buff );
        XPush( CGFloat( fmt_buff, T_SINGLE ) );
        CnvS2S( &sym->cn.value.complex.realpart, fmt_buff );
        XPush( CGFloat( fmt_buff, T_SINGLE ) );
    } else if( sym->cn.typ == TY_DCOMPLEX ) {
        CnvD2S( &sym->cn.value.dcomplex.imagpart, fmt_buff );
        XPush( CGFloat( fmt_buff, T_DOUBLE ) );
        CnvD2S( &sym->cn.value.dcomplex.realpart, fmt_buff );
        XPush( CGFloat( fmt_buff, T_DOUBLE ) );
    } else {
        CnvX2S( &sym->cn.value.xcomplex.imagpart, fmt_buff );
        XPush( CGFloat( fmt_buff, T_LONGDOUBLE ) );
        CnvX2S( &sym->cn.value.xcomplex.realpart, fmt_buff );
        XPush( CGFloat( fmt_buff, T_LONGDOUBLE ) );
    }
}


void            CmplxAssign( sym_id sym, cg_type dst_typ, cg_type src_typ ) {
//===========================================================================

// Do complex assignment.

    cg_type     typ;
    cg_name     dest;
    cg_name     dest_1;
    cg_name     dest_2;
    cg_cmplx    z;
    unsigned_16 flags;
    temp_handle tr;
    temp_handle ti;

    flags = sym->ns.flags;
    if( (flags & SY_CLASS) == SY_SUBPROGRAM ) {
        // assigning to statement function
        if( !(OZOpts & OZOPT_O_INLINE) ) {
            dest = SymAddr( sym );
        }
    } else {
        // check for structure type before checking for array
        // Consider:    A(1).X = A(2).X
        //    where A is an array of structures containing complex field X
        if( sym->ns.typ == TY_STRUCTURE ) {
            dest = XPop();
            GetU16(); // ignore structure information
        } else if( flags & SY_SUBSCRIPTED ) {
            dest = XPop();
        } else {
            dest = SymAddr( sym );
        }
    }
    typ = CmplxBaseType( dst_typ );
    if( ( src_typ != T_COMPLEX ) && ( src_typ != T_DCOMPLEX ) &&
                                                ( src_typ != T_XCOMPLEX ) ) {
        z.realpart = XPopValue( src_typ );
        z.imagpart = CGInteger( 0, typ );
    } else {
        XPopCmplx( &z, src_typ );
        z.imagpart = CGEval( z.imagpart );
    }
    z.realpart = CGEval( z.realpart );
    // Before assigning the real and imaginary parts, force evaluation of each.
    // Consider:    Z = Z * Z
    // The above expression will be evaluated as follows.
    //     z.r = z.r*z.r - z.i*z.i
    //     z.i = z.r*z.i + z.r*z.i
    // In the expression that evaluates the imaginary part, the value of "z.r"
    // must be the original value and not the new value.
    if( ((flags & SY_CLASS) == SY_SUBPROGRAM) && (OZOpts & OZOPT_O_INLINE) ) {
        XPush( z.imagpart );
        XPush( z.realpart );
        return;
    }

    // Code to avoid the criss cross problem
    // i.e. z = complx(imag(z), real(z))
    // or similar problems due to overwriting of one part with the other
    // before accessing it.
    // This should not affect efficiency (for optimized code) very much
    // because the temps will not be used when they are not required
    tr = CGTemp( typ );
    ti = CGTemp( typ );
    CGDone( CGAssign( CGTempName( tr, typ ), z.realpart, typ ) );
    CGDone( CGAssign( CGTempName( ti, typ ), z.imagpart, typ ) );

    CloneCGName( dest, &dest_1, &dest_2 );
    XPush( CGAssign( ImagPtr( dest_2, typ ),
                CGUnary( O_POINTS, CGTempName( ti, typ ), typ ), typ ) );
    XPush( CGAssign( dest_1, CGUnary( O_POINTS, CGTempName( tr, typ ), typ ),
                        typ ) );
}


cg_name         CmplxAddr( cg_name real, cg_name imag ) {
//=======================================================

// Pass a complex value to a subprogram.

    tmp_handle  tmp;
    cg_type     typ;
    cg_type     c_type;

    typ = CGType( real );
    if( typ == T_SINGLE ) {
        c_type = T_COMPLEX;
    } else if( typ == T_DOUBLE ) {
        c_type = T_DCOMPLEX;
    } else {
        c_type = T_XCOMPLEX;
    }
    tmp = AllocTmp( c_type );
    CGTrash( CGAssign( TmpPtr( tmp, c_type ), real, typ ) );
    CGTrash( CGAssign( ImagPtr( TmpPtr( tmp, c_type ), typ ), imag, typ ) );
    return( TmpPtr( tmp, c_type ) );
}


void            Cmplx2Scalar( void ) {
//==============================

// Convert complex to scalar.

    cg_name     opn;

    opn = XPop();
    if( !TypePointer( CGType( opn ) ) ) {
        CGTrash( XPop() );
    }
    XPush( opn );
}


void    FCImag( void ) {
//================

    cg_name     opn;
    cg_type     typ;

    typ = CmplxBaseType( GetType( GetU16() ) );
    opn = XPop();
    if( TypePointer( CGType( opn ) ) ) {
        XPush( CGUnary( O_POINTS, ImagPtr( opn, typ ), typ ) );
    } else {
        CGTrash( opn );
    }
}


void    FCConjg( void ) {
//=================

    cg_cmplx    z;
    cg_type     typ;

    typ = GetType( GetU16() );
    XPopCmplx( &z, typ );
    XPush( CGUnary( O_UMINUS, z.imagpart, CmplxBaseType( typ ) ) );
    XPush( z.realpart );
}