fccmplx.c

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

/****************************************************************************
*
*                            Open Watcom Project
*
*    Portions Copyright (c) 1983-2002 Sybase, Inc. All Rights Reserved.
*
*  ========================================================================
*
*    This file contains Original Code and/or Modifications of Original
*    Code as defined in and that are subject to the Sybase Open Watcom
*    Public License version 1.0 (the 'License'). You may not use this file
*    except in compliance with the License. BY USING THIS FILE YOU AGREE TO
*    ALL TERMS AND CONDITIONS OF THE LICENSE. A copy of the License is
*    provided with the Original Code and Modifications, and is also
*    available at www.sybase.com/developer/opensource.
*
*    The Original Code and all software distributed under the License are
*    distributed on an 'AS IS' basis, WITHOUT WARRANTY OF ANY KIND, EITHER
*    EXPRESS OR IMPLIED, AND SYBASE AND ALL CONTRIBUTORS HEREBY DISCLAIM
*    ALL SUCH WARRANTIES, INCLUDING WITHOUT LIMITATION, ANY WARRANTIES OF
*    MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE, QUIET ENJOYMENT OR
*    NON-INFRINGEMENT. Please see the License for the specific language
*    governing rights and limitations under the License.
*
*  ========================================================================
*
* Description:  WHEN YOU FIGURE OUT WHAT THIS FILE DOES, PLEASE
*               DESCRIBE IT HERE!
*
****************************************************************************/


//
// FCCMPLX  : F-Code processor for complex arithmetic.
//

#include "ftnstd.h"
#include "rtconst.h"
#include "wf77defs.h"
#include "wf77cg.h"
#include "tmpdefs.h"
#include "cpopt.h"
#include "global.h"
#include "emitobj.h"
#include "fctypes.h"

//=================== Back End Code Generation Routines ====================

extern  cg_name         CGBinary(cg_op,cg_name,cg_name,cg_type);
extern  cg_name         CGCall(call_handle);
extern  cg_name         CGCompare(cg_op,cg_name,cg_name,cg_type);
extern  cg_name         CGChoose(cg_name,cg_name,cg_name,cg_type);
extern  cg_name         CGInteger(signed_32,cg_type);
extern  cg_type         CGType(cg_name);
extern  cg_name         CGUnary(cg_op,cg_name,cg_type);
extern  cg_name         CGFlow(cg_op,cg_name,cg_name);
extern  cg_name         CGAssign(cg_name,cg_name,cg_type);
extern  cg_name         CGFloat(char*,cg_type);
extern  cg_name         CGVolatile(cg_name);
extern  cg_name         CGEval(cg_name);
extern  void            CGAddParm(call_handle,cg_name,cg_type);
extern  void            CGTrash(cg_name);
extern  cg_name         CGTempName(temp_handle,cg_type);
extern  temp_handle     CGTemp(cg_type);
extern  void            CGDone(cg_name);
extern  unsigned long   BETypeLength(cg_type);

//=========================================================================

extern  void            XPush(cg_name);
extern  cg_name         XPopValue(cg_type);
extern  cg_name         XPop(void);
extern  call_handle     InitCall(RTCODE);
extern  cg_name         SymAddr(sym_id);
extern  void            CnvS2S(float *,char *);
extern  void            CnvD2S(double *,char *);
extern  void            CnvX2S(extended *,char *);
extern  cg_name         StructRef(cg_name,int);
extern  tmp_handle      AllocTmp(cg_type);
extern  cg_name         TmpPtr(tmp_handle,cg_type);
extern  void            CloneCGName(cg_name,cg_name *,cg_name *);


cg_name ImagPtr( cg_name dest, cg_type typ ) {
//============================================

// Get pointer to imaginary part of complex number.

    dest = StructRef( dest, BETypeLength( typ ) );
    if( OZOpts & OZOPT_O_VOLATILE ) {
        dest = CGVolatile( dest );
    }
    return( dest );
}


cg_type         CmplxBaseType( cg_type typ ) {
//============================================

    if( typ == T_COMPLEX ) return( T_SINGLE );
    if( typ == T_DCOMPLEX ) return( T_DOUBLE );
    return( T_LONGDOUBLE );
}


void    SplitCmplx( cg_name cmplx_addr, cg_type typ ) {
//=====================================================

// Split real and imaginary parts of complex number.

    cg_name     cmplx_1;
    cg_name     cmplx_2;

    typ = CmplxBaseType( typ );
    CloneCGName( cmplx_addr, &cmplx_1, &cmplx_2 );
    XPush( CGUnary( O_POINTS, ImagPtr( cmplx_1, typ ), typ ) );
    XPush( CGUnary( O_POINTS, cmplx_2, 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 == 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, 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    XCmplxOp( RTCODE rtn_id ) {
//=================================

// F-Code processor for binary complex number operations involving
// runtime routines.
// ( a, b ) OP ( c, d ).

    unsigned_16 typ_info;
    cg_cmplx    x;
    cg_cmplx    y;

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


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

// Binary operator F-Code processor for complex addition and subtraction.

    unsigned_16 typ_info;
    int         typ1;
    int         typ2;
    cg_cmplx    x;
    cg_cmplx    y;

    typ_info = GetU16();
    typ1 = GetType1( typ_info );
    typ2 = GetType2( typ_info );
    XPopCmplx( &x, typ1 );
    XPopCmplx( &y, typ2 );
    typ1 = CmplxBaseType( typ1 );
    typ2 = CmplxBaseType( typ2 );
    XPush( CGBinary( op, x.imagpart, y.imagpart, ResCGType( typ1, typ2 ) ) );
    XPush( CGBinary( op, x.realpart, y.realpart, ResCGType( typ1, typ2 ) ) );
}


void    XMixed( int op, bool cmplx_scalar ) {
//===========================================

// Binary F-Code processor for cmplx-scalar addition & subtraction.
// cx   - true if complex OP scalar, false if scalar OP complex.

    cg_cmplx    z;
    cg_name     x;
    unsigned_16 typ_info;
    cg_type     z_typ;
    cg_type     x_typ;

    typ_info = GetU16();
    if( cmplx_scalar ) {
        z_typ = GetType1( typ_info );
        x_typ = GetType2( typ_info );
        XPopCmplx( &z, z_typ );
        x = XPopValue( x_typ );
    } else {
        x_typ = GetType1( typ_info );
        z_typ = GetType2( typ_info );
        x = XPopValue( x_typ );
        XPopCmplx( &z, z_typ );
    }
    z_typ = CmplxBaseType( z_typ );
    if( cmplx_scalar ) {
        XPush( z.imagpart );
        XPush( CGBinary( op, z.realpart, x, ResCGType( z_typ, x_typ ) ) );
    } else {
        if( op == O_MINUS ) {
            XPush( CGUnary( O_UMINUS, z.imagpart, z_typ ) );
        } else {
            XPush( z.imagpart );
        }
        XPush( CGBinary( op, x, z.realpart, ResCGType( x_typ, z_typ ) ) );
    }
}


void    XMulDivMix( int op, bool cmplx_scalar, unsigned_16 typ_info ) {
//=====================================================================

// Binary F-Code processor for mixed multiplication and division.

    cg_cmplx    z;
    cg_name     s;
    cg_type     s_typ;
    cg_type     z_typ;
    cg_name     s_1;
    cg_name     s_2;

    if( cmplx_scalar ) {
        z_typ = GetType1( typ_info );
        s_typ = GetType2( typ_info );
        XPopCmplx( &z, z_typ );
        s = XPopValue( s_typ );
    } else {
        s_typ = GetType1( typ_info );
        z_typ = GetType2( typ_info );
        s = XPopValue( s_typ );
        XPopCmplx( &z, z_typ );
    }
    z_typ = ResCGType( s_typ, CmplxBaseType( z_typ ) );
    CloneCGName( s, &s_1, &s_2 );
    XPush( CGBinary( op, z.imagpart, s_1, z_typ ) );
    XPush( CGBinary( op, z.realpart, s_2, z_typ ) );
}


void    FCCmplxFlip( void ) {
//=====================

// Flip 2 complex operands.

    cg_name     rp_1;
    cg_name     ip_1;
    cg_name     rp_2;
    cg_name     ip_2;

    rp_1 = XPop();
    if( !TypePointer( CGType( rp_1 ) ) ) {
        ip_1 = XPop();
    }
    rp_2 = XPop();
    if( !TypePointer( CGType( rp_2 ) ) ) {
        ip_2 = XPop();
    }
    if( !TypePointer( CGType( rp_1 ) ) ) {
        XPush( ip_1 );
    }
    XPush( rp_1 );
    if( !TypePointer( CGType( rp_2 ) ) ) {
        XPush( ip_2 );
    }
    XPush( rp_2 );
}


void    FCCXFlip( void ) {
//==================

// Flip complex and scalar operands.

    cg_name     rp;
    cg_name     ip;
    cg_name     scalar;

    rp = XPop();
    if( !TypePointer( CGType( rp ) ) ) {
        ip = XPop();
    }
    scalar = XPop();
    if( !TypePointer( CGType( rp ) ) ) {
        XPush( ip );
    }
    XPush( rp );
    XPush( scalar );
}


void    FCXCFlip( void ) {
//==================

// Flip scalar and complex operands.

    cg_name     rp;
    cg_name     ip;
    cg_name     scalar;

    scalar = XPop();
    rp = XPop();
    if( !TypePointer( CGType( rp ) ) ) {
        ip = XPop();
    }
    XPush( scalar );
    if( !TypePointer( CGType( rp ) ) ) {
        XPush( ip );
    }
    XPush( rp );
}


void    FCUMinusCmplx( void ) {
//=======================

// Unary minus (-) F-Code processor for complex numbers.

    cg_cmplx    op;
    cg_type     typ;

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


void    FCAddCmplx( void ) {
//====================

// Add one complex number to another.

    XCmplx( O_PLUS );
}


void    FCSubCmplx( void ) {
//====================

// Subtract one complex number from another.

    XCmplx( O_MINUS );
}


void    FCAddMixCX( void ) {
//====================

// Add a complex to a scalar.

    XMixed( O_PLUS, TRUE );
}


void    FCAddMixXC( void ) {
//====================

// Add a scalar to a complex.

    XMixed( O_PLUS, FALSE );
}


void    FCSubMixCX( void ) {
//====================

// Subtract a scalar from a complex.

    XMixed( O_MINUS, TRUE );
}


void    FCSubMixXC( void ) {
//====================

// Subtract a scalar from a complex.

    XMixed( O_MINUS, FALSE );
}


void    FCMulMixCX( void ) {
//====================

// Multiply a complex by a scalar.

    XMulDivMix( O_TIMES, TRUE, GetU16() );
}


void    FCMulMixXC( void ) {
//====================

// Multiply a scalar by a complex.

    XMulDivMix( O_TIMES, FALSE, GetU16() );
}


void    FCDivMixCX( void ) {
//====================

// Divide a complex by a scalar.

    XMulDivMix( O_DIV, TRUE, GetU16() );
}


void    FCDivMixXC( void ) {
//====================

// Divide a scalar by a complex.

    XCmplxMixOp( RT_C8DIV, FALSE );
}


void    FCMulCmplx( void ) {
//====================

// Multiply one complex number by another.
#if _CPU == 8086 || _CPU == 386
    if( CPUOpts & CPUOPT_FPC ) {
        // generate call to runtime complex multiply
        XCmplxOp( RT_C8MUL );
    } else {
        // do multiplication inline
        InLineMulCC( GetU16() );