defs.h

把fortran语言编的程序转为c语言编的程序, 运行环境linux

struct Hashentry
	{
	int hashval;
	Namep varp;
	};
extern struct Hashentry *hashtab;	/* Hash table */
extern struct Hashentry *lasthash;

struct Intrpacked	/* bits for intrinsic function description */
	{
	unsigned f1:3;
	unsigned f2:4;
	unsigned f3:7;
	unsigned f4:1;
	};

struct Nameblock
	{
	field tag;
	field vtype;
	field vclass;
	field vstg;
	expptr vleng;		/* length of character string, if applicable */
	char *fvarname;		/* name in the Fortran source */
	char *cvarname;		/* name in the resulting C */
	chainp vlastdim;	/* datap points to new_vars entry for the */
				/* system variable, if any, storing the final */
				/* dimension; we zero the datap if this */
				/* variable is needed */
	unsigned vprocclass:3;	/* P____ macros - selects the   varxptr
				   field below */
	unsigned vdovar:1;	/* "is it a DO variable?" for register
				   and multi-level loop	checking */
	unsigned vdcldone:1;	/* "do I think I'm done?" - set when the
				   context is sufficient to determine its
				   status */
	unsigned vadjdim:1;	/* "adjustable dimension?" - needed for
				   information about copies */
	unsigned vsave:1;
	unsigned vimpldovar:1;	/* used to prevent erroneous error messages
				   for variables used only in DATA stmt
				   implicit DOs */
	unsigned vis_assigned:1;/* True if this variable has had some
				   label ASSIGNED to it; hence
				   varxptr.assigned_values is valid */
	unsigned vimplstg:1;	/* True if storage type is assigned implicitly;
				   this allows a COMMON variable to participate
				   in a DIMENSION before the COMMON declaration.
				   */
	unsigned vcommequiv:1;	/* True if EQUIVALENCEd onto STGCOMMON */
	unsigned vfmt_asg:1;	/* True if char *var_fmt needed */
	unsigned vpassed:1;	/* True if passed as a character-variable arg */
	unsigned vknownarg:1;	/* True if seen in a previous entry point */
	unsigned visused:1;	/* True if variable is referenced -- so we */
				/* can omit variables that only appear in DATA */
	unsigned vnamelist:1;	/* Appears in a NAMELIST */
	unsigned vimpltype:1;	/* True if implicitly typed and not
				   invoked as a function or subroutine
				   (so we can consistently type procedures
				   declared external and passed as args
				   but never invoked).
				   */
	unsigned vtypewarned:1;	/* so we complain just once about
				   changed types of external procedures */
	unsigned vinftype:1;	/* so we can restore implicit type to a
				   procedure if it is invoked as a function
				   after being given a different type by -it */
	unsigned vinfproc:1;	/* True if -it infers this to be a procedure */
	unsigned vcalled:1;	/* has been invoked */
	unsigned vdimfinish:1;	/* need to invoke dim_finish() */
	unsigned vrefused:1;	/* Need to #define name_ref (for -s) */
	unsigned vsubscrused:1;	/* Need to #define name_subscr (for -2) */
	unsigned veqvadjust:1;	/* voffset has been adjusted for equivalence */

/* The   vardesc   union below is used to store the number of an intrinsic
   function (when vstg == STGINTR and vprocclass == PINTRINSIC), or to
   store the index of this external symbol in   extsymtab   (when vstg ==
   STGEXT and vprocclass == PEXTERNAL) */

	union	{
		int varno;		/* Return variable for a function.
					   This is used when a function is
					   assigned a return value.  Also
					   used to point to the COMMON
					   block, when this is a field of
					   that block.  Also points to
					   EQUIV block when STGEQUIV */
		struct Intrpacked intrdesc;	/* bits for intrinsic function*/
		} vardesc;
	struct Dimblock *vdim;	/* points to the dimensions if they exist */
	ftnint voffset;		/* offset in a storage block (the variable
				   name will be "v.%d", voffset in a
				   common blck on the vax).  Also holds
				   pointers for automatic variables.  When
				   STGEQUIV, this is -(offset from array
				   base) */
	union	{
		chainp namelist;	/* points to names in the NAMELIST,
					   if this is a NAMELIST name */
		chainp vstfdesc;	/* points to (formals, expr) pair */
		chainp assigned_values;	/* list of integers, each being a
					   statement label assigned to
					   this variable in the current function */
		} varxptr;
	int argno;		/* for multiple entries */
	Argtypes *arginfo;
	};


/* PARAMETER statements */

struct Paramblock
	{
	field tag;
	field vtype;
	field vclass;
	field vstg;
	expptr vleng;
	char *fvarname;
	char *cvarname;
	expptr paramval;
	} ;


/* Expression block */

struct Exprblock
	{
	field tag;
	field vtype;
	field vclass;
	field vstg;
	expptr vleng;		/* in the case of a character expression, this
				   value is inherited from the children */
	unsigned opcode;
	expptr leftp;
	expptr rightp;
	int typefixed;
	};


union Constant
	{
	struct {
		char *ccp0;
		ftnint blanks;
		} ccp1;
	ftnint ci;		/* Constant longeger */
	double cd[2];
	char *cds[2];
	};
#define ccp ccp1.ccp0

struct Constblock
	{
	field tag;
	field vtype;
	field vclass;
	field vstg;		/* vstg = 1 when using Const.cds */
	expptr vleng;
	union Constant Const;
	};


struct Listblock
	{
	field tag;
	field vtype;
	chainp listp;
	};



/* Address block - this is the FINAL form of identifiers before being
   sent to pass 2.  We'll want to add the original identifier here so that it can
   be preserved in the translation.

   An example identifier is q.7.  The "q" refers to the storage class
   (field vstg), the 7 to the variable number (int memno). */

struct Addrblock
	{
	field tag;
	field vtype;
	field vclass;
	field vstg;
	expptr vleng;
	/* put union...user here so the beginning of an Addrblock
	 * is the same as a Constblock.
	 */
	union {
	    Namep name;		/* contains a pointer into the hash table */
	    char ident[IDENT_LEN + 1];	/* C string form of identifier */
	    char *Charp;
	    union Constant Const;	/* Constant value */
	    struct {
		double dfill[2];
		field vstg1;
		} kludge;	/* so we can distinguish string vs binary
				 * floating-point constants */
	} user;
	long memno;		/* when vstg == STGCONST, this is the
				   numeric part of the assembler label
				   where the constant value is stored */
	expptr memoffset;	/* used in subscript computations, usually */
	unsigned istemp:1;	/* used in stack management of temporary
				   variables */
	unsigned isarray:1;	/* used to show that memoffset is
				   meaningful, even if zero */
	unsigned ntempelt:10;	/* for representing temporary arrays, as
				   in concatenation */
	unsigned dbl_builtin:1;	/* builtin to be declared double */
	unsigned charleng:1;	/* so saveargtypes can get i/o calls right */
	unsigned cmplx_sub:1;	/* used in complex arithmetic under -s */
	unsigned skip_offset:1;	/* used in complex arithmetic under -s */
	unsigned parenused:1;	/* distinguish (a) from a */
	ftnint varleng;		/* holds a copy of a constant length which
				   is stored in the   vleng   field (e.g.
				   a double is 8 bytes) */
	int uname_tag;		/* Tag describing which of the unions()
				   below to use */
	char *Field;		/* field name when dereferencing a struct */
}; /* struct Addrblock */


/* Errorbock - placeholder for errors, to allow the compilation to
   continue */

struct Errorblock
	{
	field tag;
	field vtype;
	};


/* Implicit DO block, especially related to DATA statements.  This block
   keeps track of the compiler's location in the implicit DO while it's
   running.  In particular, the   isactive and isbusy   flags tell where
   it is */

struct Impldoblock
	{
	field tag;
	unsigned isactive:1;
	unsigned isbusy:1;
	Namep varnp;
	Constp varvp;
	chainp impdospec;
	expptr implb;
	expptr impub;
	expptr impstep;
	ftnint impdiff;
	ftnint implim;
	struct Chain *datalist;
	};


/* Each of these components has a first field called   tag.   This union
   exists just for allocation simplicity */

union Expression
	{
	field tag;
	struct Addrblock addrblock;
	struct Constblock constblock;
	struct Errorblock errorblock;
	struct Exprblock exprblock;
	struct Headblock headblock;
	struct Impldoblock impldoblock;
	struct Listblock listblock;
	struct Nameblock nameblock;
	struct Paramblock paramblock;
	struct Primblock primblock;
	} ;



struct Dimblock
	{
	int ndim;
	expptr nelt;		/* This is NULL if the array is unbounded */
	expptr baseoffset;	/* a constant or local variable holding
				   the offset in this procedure */
	expptr basexpr;		/* expression for comuting the offset, if
				   it's not constant.  If this is
				   non-null, the register named in
				   baseoffset will get initialized to this
				   value in the procedure's prolog */
	struct
		{
		expptr dimsize;	/* constant or register holding the size
				   of this dimension */
		expptr dimexpr;	/* as above in basexpr, this is an
				   expression for computing a variable
				   dimension */
		} dims[1];	/* Dimblocks are allocated with enough
				   space for this to become dims[ndim] */
	};


/* Statement function identifier stack - this holds the name and value of
   the parameters in a statement function invocation.  For example,

	f(x,y,z)=x+y+z
		.
		.
	y = f(1,2,3)

   generates a stack of depth 3, with <x 1>, <y 2>, <z 3> AT THE INVOCATION, NOT
   at the definition */

struct Rplblock	/* name replacement block */
	{
	struct Rplblock *rplnextp;
	Namep rplnp;		/* Name of the formal parameter */
	expptr rplvp;		/* Value of the actual parameter */
	expptr rplxp;		/* Initialization of temporary variable,
				   if required; else null */
	int rpltag;		/* Tag on the value of the actual param */
	};



/* Equivalence block */

struct Equivblock
	{
	struct Eqvchain *equivs;	/* List (Eqvchain) of primblocks
					   holding variable identifiers */
	flag eqvinit;
	long eqvtop;
	long eqvbottom;
	int eqvtype;
	} ;
#define eqvleng eqvtop

extern struct Equivblock *eqvclass;


struct Eqvchain
	{
	struct Eqvchain *eqvnextp;
	union
		{
		struct Primblock *eqvlhs;
		Namep eqvname;
		} eqvitem;
	long eqvoffset;
	} ;