fcdata.c

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

/****************************************************************************
*
*                            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:  DATA statement processor.
*
****************************************************************************/


#include "ftnstd.h"
#include "global.h"
#include "fcgbls.h"
#include "errcod.h"
#include "types.h"
#include "cg.h"
#include "emitobj.h"
#include "ferror.h"
#include "insert.h"

// The following are to support a temporary fix so that constants dumped by
// DATA statements provide the same precision for constants dumped by the code
// generator.  Consider:
//      DOUBLE PRECISION X, Y
//      PARAMETER (Y=1D036)
//      DATA X/Y/
//      PRINT *, X - Y
//      END
// The result should be 0.
#include "fltcnv.h"
#include "wf77defs.h"
#include <string.h>

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

extern  segment_id      BESetSeg(segment_id);
extern  void            BEFiniBack(back_handle);
extern  void            BEFreeBack(back_handle);

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

extern  void            DtInit(segment_id,seg_offset);
extern  void            DtBytes(byte *,int);
extern  void            DtIBytes(byte,int);
extern  segment_id      GetDataSegId(sym_id);
extern  seg_offset      GetDataOffset(sym_id);
extern  void            DXPush(intstar4);
extern  intstar4        DXPop(void);
extern  bool            DoSubscript(act_dim_list *,intstar4 *,intstar4 *);
extern  bool            DoSubstring(intstar4,intstar4,int);
extern  void            FCodeSequence(void);
extern  char            *STFieldName(sym_id,char *);
extern  void            DtStartSequence(void);
extern  void            DtFiniSequence(void);

extern  void            (* __FAR FCJmpTab[])( void );
extern  void            (* __FAR DataJmpTab[])( void );
extern  char            *StmtKeywords[];

static  void            InitStructArr( sym_id fd, act_dim_list *dim );
static  void            StructInit( sym_id fd );

#define CONST_TYPES     9

#ifdef pick
#undef pick
#endif
#define pick(id,type,dbgtype,cgtype) type,

static  TYPE    MapType[] = {
#include "ptypdefn.h"
};

#define DT_NO_MORE_CONSTS       0x01
#define DT_SS_NO_HIGH           0x02

static  unsigned_32     DtItemSize;


static  void    I2toI1( intstar2 *old, intstar1 *to ) {
//=====================================================

// Convert constant old INTEGER*2 to INTEGER*1.

    *to = *old;
}


static  void    I4toI1( intstar4 *old, intstar1 *to ) {
//=====================================================

// Convert constant old INTEGER*4 to INTEGER*1.

    *to = *old;
}


static  void    R4toI1( single *old, intstar1 *to ) {
//===================================================

// Convert constant old REAL*4 to INTEGER*1.

    *to = *old;
}


static  void    R8toI1( double *old, intstar1 *to ) {
//===================================================

// Convert constant old REAL*8 to INTEGER*1.

    *to = *old;
}


static  void    R10toI1( extended *old, intstar1 *to ) {
//==========================================================

// Convert constant old REAL*10 to INTEGER*1.

    *to = *old;
}


static  void    C8toI1( complex *old, intstar1 *to ) {
//====================================================

// Convert constant old COMPLEX*8 to INTSTAR4.

    *to = old->realpart;
}


static  void    C16toI1( dcomplex *old, intstar1 *to ) {
//======================================================

// Convert constant old COMPLEX*16 to INTEGER*1.

    *to = old->realpart;
}


static  void    C20toI1( xcomplex *old, intstar1 *to ) {
//======================================================

// Convert constant old COMPLEX*20 to INTEGER*1.

    *to = old->realpart;
}


static  void    I1toI2( intstar1 *old, intstar2 *to ) {
//=====================================================

// Convert constant old INTEGER*1 to INTEGER*2.

    *to = *old;
}


static  void    I4toI2( intstar4 *old, intstar2 *to ) {
//=====================================================

// Convert constant old INTEGER*4 to INTEGER*2.

    *to = *old;
}


static  void    R4toI2( single *old, intstar2 *to ) {
//===================================================

// Convert constant old REAL*4 to INTEGER*2.

    *to = *old;
}


static  void    R8toI2( double *old, intstar2 *to ) {
//===================================================

// Convert constant old REAL*8 to INTEGER*2.

    *to = *old;
}


static  void    R10toI2( extended *old, intstar2 *to ) {
//=========================================================

// Convert constant old REAL*10 to INTEGER*2.

    *to = *old;
}


static  void    C8toI2( complex *old, intstar2 *to ) {
//====================================================

// Convert constant old COMPLEX*8 to INTEGER*2.

    *to = old->realpart;
}


static  void    C16toI2( dcomplex *old, intstar2 *to ) {
//======================================================

// Convert constant old COMPLEX*16 to INTEGER*2.

    *to = old->realpart;
}


static  void    C20toI2( xcomplex *old, intstar2 *to ) {
//======================================================

// Convert constant old COMPLEX*20 to INTEGER*2.

    *to = old->realpart;
}


static  void    I1toI4( intstar1 *old, intstar4 *to ) {
//=====================================================

// Convert constant old INTEGER*1 to INTEGER*4.

    *to = *old;
}


static  void    I2toI4( intstar2 *old, intstar4 *to ) {
//=====================================================

// Convert constant old INTEGER*2 to INTEGER*4.

    *to = *old;
}


static  void    R4toI4( single *old, intstar4 *to ) {
//===================================================

// Convert constant old REAL*8 to INTEGER*4.

    *to = *old;
}


static  void    R8toI4( double *old, intstar4 *to ) {
//===================================================

// Convert constant old REAL*8 to INTEGER*4.

    *to = *old;
}


static  void    R10toI4( extended *old, intstar4 *to ) {
//=========================================================

// Convert constant old REAL*10 to INTEGER*4.

    *to = *old;
}


static  void    C8toI4( complex *old, intstar4 *to ) {
//====================================================

// Convert constant old COMPLEX*8 to INTEGER*4.

    *to = old->realpart;
}


static  void    C16toI4( dcomplex *old, intstar4 *to ) {
//======================================================

// Convert constant old COMPLEX*16 to INTEGER*4.

    *to = old->realpart;
}


static  void    C20toI4( xcomplex *old, intstar4 *to ) {
//======================================================

// Convert constant old COMPLEX*20 to INTEGER*4.

    *to = old->realpart;
}


static  void    I1toR4( intstar1 *old, single *to ) {
//===================================================

// Convert constant old INTEGER*1 to REAL*4.

    *to = *old;
}


static  void    I2toR4( intstar2 *old, single *to ) {
//===================================================

// Convert constant old INTEGER*2 to REAL*4.

    *to = *old;
}


static  void    I4toR4( intstar4 *old, single *to ) {
//===================================================

// Convert constant old INTEGER*4 to REAL*4.

    *to = *old;
}


static  void    R8toR4( double *old, single *to ) {
//=================================================

// Convert constant old REAL*8 to REAL*4.

    *to = *old;
}


static  void    R10toR4( extended *old, single *to ) {
//=======================================================

// Convert constant old REAL*10 to REAL*4.

    *to = *old;
}


static  void    C8toR4( complex *old, single *to ) {
//==================================================

// Convert constant old COMPLEX*8 to REAL*4.

    *to = old->realpart;
}


static  void    C16toR4( dcomplex *old, single *to ) {
//====================================================

// Convert constant old COMPLEX*16 to REAL*4.

    *to = old->realpart;
}


static  void    C20toR4( xcomplex *old, single *to ) {
//====================================================

// Convert constant old COMPLEX*20 to REAL*4.

    *to = old->realpart;
}


static  void    I1toR8( intstar1 *old, double *to ) {
//===================================================

// Convert constant old INTEGER*1 to REAL*8.

    *to = *old;
}


static  void    I2toR8( intstar2 *old, double *to ) {
//===================================================

// Convert constant old INTEGER*2 to REAL*8.

    *to = *old;
}


static  void    I4toR8( intstar4 *old, double *to ) {
//===================================================

// Convert constant old INTEGER*4 to REAL*8.

    *to = *old;
}


static  void    R4toR8( single *old, double *to ) {
//=================================================

// Convert constant old REAL*4 to REAL*8.

    *to = *old;
}


static  void    R10toR8( extended *old, double *to ) {
//=======================================================

// Convert constant old REAL*10 to REAL*8.

    *to = *old;
}


static  void    C8toR8( complex *old, double *to ) {
//==================================================

// Convert constant old COMPLEX*8 to REAL*8.

    *to = old->realpart;
}


static  void    C16toR8( dcomplex *old, double *to ) {
//====================================================

// Convert constant old COMPLEX*16 to REAL*8.

    *to = old->realpart;
}


static  void    C20toR8( xcomplex *old, double *to ) {
//====================================================

// Convert constant old COMPLEX*20 to REAL*8.

    *to = old->realpart;
}


static  void    I1toR10( intstar1 *old, extended *to ) {
//=========================================================

// Convert constant old INTEGER*1 to REAL*10.

    *to = *old;
}


static  void    I2toR10( intstar2 *old, extended *to ) {
//=========================================================

// Convert constant old INTEGER*2 to REAL*10.

    *to = *old;
}


static  void    I4toR10( intstar4 *old, extended *to ) {
//=========================================================

// Convert constant old INTEGER*4 to REAL*10.

    *to = *old;
}


static  void    R4toR10( single *old, extended *to ) {
//=======================================================

// Convert constant old REAL*4 to REAL*10.

    *to = *old;
}


static  void    R8toR10( double *old, extended *to ) {
//=======================================================

// Convert constant old REAL*8 to REAL*10.

    *to = *old;
}


static  void    C8toR10( complex *old, extended *to ) {
//========================================================

// Convert constant old COMPLEX*8 to REAL*10.

    *to = old->realpart;
}


static  void    C16toR10( dcomplex *old, extended *to ) {
//==========================================================

// Convert constant old COMPLEX*16 to REAL*10.

    *to = old->realpart;
}


static  void    C20toR10( xcomplex *old, extended *to ) {
//==========================================================

// Convert constant old COMPLEX*20 to REAL*10.

    *to = old->realpart;
}