defs.h

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

/****************************************************************
Copyright 1990 - 1994 by AT&T Bell Laboratories, Bellcore.

Permission to use, copy, modify, and distribute this software
and its documentation for any purpose and without fee is hereby
granted, provided that the above copyright notice appear in all
copies and that both that the copyright notice and this
permission notice and warranty disclaimer appear in supporting
documentation, and that the names of AT&T Bell Laboratories or
Bellcore or any of their entities not be used in advertising or
publicity pertaining to distribution of the software without
specific, written prior permission.

AT&T and Bellcore disclaim all warranties with regard to this
software, including all implied warranties of merchantability
and fitness.  In no event shall AT&T or Bellcore be liable for
any special, indirect or consequential damages or any damages
whatsoever resulting from loss of use, data or profits, whether
in an action of contract, negligence or other tortious action,
arising out of or in connection with the use or performance of
this software.
****************************************************************/

#include "sysdep.h"

#include "ftypes.h"
#include "defines.h"
#include "machdefs.h"

#define MAXDIM 20
#define MAXINCLUDES 10
#define MAXLITERALS 200		/* Max number of constants in the literal
				   pool */
#define MAXTOKENLEN 502		/* length of longest token */
#define MAXCTL 20
#define MAXHASH 401
#define MAXSTNO 801
#define MAXEXT 200
#define MAXEQUIV 150
#define MAXLABLIST 258		/* Max number of labels in an alternate
				   return CALL or computed GOTO */
#define MAXCONTIN 99		/* Max continuation lines */

/* These are the primary pointer types used in the compiler */

typedef union Expression *expptr, *tagptr;
typedef struct Chain *chainp;
typedef struct Addrblock *Addrp;
typedef struct Constblock *Constp;
typedef struct Exprblock *Exprp;
typedef struct Nameblock *Namep;

extern FILEP infile;
extern FILEP diagfile;
extern FILEP textfile;
extern FILEP asmfile;
extern FILEP c_file;		/* output file for all functions; extern
				   declarations will have to be prepended */
extern FILEP pass1_file;	/* Temp file to hold the function bodies
				   read on pass 1 */
extern FILEP expr_file;		/* Debugging file */
extern FILEP initfile;		/* Intermediate data file pointer */
extern FILEP blkdfile;		/* BLOCK DATA file */

extern int current_ftn_file;
extern int maxcontin;

extern char *blkdfname, *initfname, *sortfname;
extern long headoffset;		/* Since the header block requires data we
				   don't know about until AFTER each
				   function has been processed, we keep a
				   pointer to the current (dummy) header
				   block (at the top of the assembly file)
				   here */

extern char main_alias[];	/* name given to PROGRAM psuedo-op */
extern char token [ ];
extern int toklen;
extern long lineno;
extern char *infname;
extern int needkwd;
extern struct Labelblock *thislabel;

/* Used to allow runtime expansion of internal tables.  In particular,
   these values can exceed their associated constants */

extern int maxctl;
extern int maxequiv;
extern int maxstno;
extern int maxhash;
extern int maxext;

extern flag nowarnflag;
extern flag ftn66flag;		/* Generate warnings when weird f77
				   features are used (undeclared dummy
				   procedure, non-char initialized with
				   string, 1-dim subscript in EQUIV) */
extern flag no66flag;		/* Generate an error when a generic
				   function (f77 feature) is used */
extern flag noextflag;		/* Generate an error when an extension to
				   Fortran 77 is used (hex/oct/bin
				   constants, automatic, static, double
				   complex types) */
extern flag zflag;		/* enable double complex intrinsics */
extern flag shiftcase;
extern flag undeftype;
extern flag shortsubs;		/* Use short subscripts on arrays? */
extern flag onetripflag;	/* if true, always execute DO loop body */
extern flag checksubs;
extern flag debugflag;
extern int nerr;
extern int nwarn;

extern int parstate;
extern flag headerdone;		/* True iff the current procedure's header
				   data has been written */
extern int blklevel;
extern flag saveall;
extern flag substars;		/* True iff some formal parameter is an
				   asterisk */
extern int impltype[ ];
extern ftnint implleng[ ];
extern int implstg[ ];

extern int tycomplex, tyint, tyioint, tyreal;
extern int tylog, tylogical;	/* TY____ of the implementation of   logical.
				   This will be LONG unless '-2' is given
				   on the command line */
extern int type_choice[];
extern char *typename[];

extern int typesize[];	/* size (in bytes) of an object of each
				   type.  Indexed by TY___ macros */
extern int typealign[];
extern int proctype;	/* Type of return value in this procedure */
extern char * procname;	/* External name of the procedure, or last ENTRY name */
extern int rtvlabel[ ];	/* Return value labels, indexed by TY___ macros */
extern Addrp retslot;
extern Addrp xretslot[];
extern int cxslot;	/* Complex return argument slot (frame pointer offset)*/
extern int chslot;	/* Character return argument slot (fp offset) */
extern int chlgslot;	/* Argument slot for length of character buffer */
extern int procclass;	/* Class of the current procedure:  either CLPROC,
			   CLMAIN, CLBLOCK or CLUNKNOWN */
extern ftnint procleng;	/* Length of function return value (e.g. char
			   string length).  If this is -1, then the length is
			   not known at compile time */
extern int nentry;	/* Number of entry points (other than the original
			   function call) into this procedure */
extern flag multitype;	/* YES iff there is more than one return value
			   possible */
extern int blklevel;
extern long lastiolabno;
extern int lastlabno;
extern int lastvarno;
extern int lastargslot;	/* integer offset pointing to the next free
			   location for an argument to the current routine */
extern int argloc;
extern int autonum[];		/* for numbering
				   automatic variables, e.g. temporaries */
extern int retlabel;
extern int ret0label;
extern int dorange;		/* Number of the label which terminates
				   the innermost DO loop */
extern int regnum[ ];		/* Numbers of DO indicies named in
				   regnamep   (below) */
extern Namep regnamep[ ];	/* List of DO indicies in registers */
extern int maxregvar;		/* number of elts in   regnamep   */
extern int highregvar;		/* keeps track of the highest register
				   number used by DO index allocator */
extern int nregvar;		/* count of DO indicies in registers */

extern chainp templist[];
extern int maxdim;
extern chainp earlylabs;
extern chainp holdtemps;
extern struct Entrypoint *entries;
extern struct Rplblock *rpllist;
extern struct Chain *curdtp;
extern ftnint curdtelt;
extern chainp allargs;		/* union of args in entries */
extern int nallargs;		/* total number of args */
extern int nallchargs;		/* total number of character args */
extern flag toomanyinit;	/* True iff too many initializers in a
				   DATA statement */

extern flag inioctl;
extern int iostmt;
extern Addrp ioblkp;
extern int nioctl;
extern int nequiv;
extern int eqvstart;	/* offset to eqv number to guarantee uniqueness
			   and prevent <something> from going negative */
extern int nintnames;

/* Chain of tagged blocks */

struct Chain
	{
	chainp nextp;
	char * datap;		/* Tagged block */
	};

extern chainp chains;

/* Recall that   field   is intended to hold four-bit characters */

/* This structure exists only to defeat the type checking */

struct Headblock
	{
	field tag;
	field vtype;
	field vclass;
	field vstg;
	expptr vleng;		/* Expression for length of char string -
				   this may be a constant, or an argument
				   generated by mkarg() */
	} ;

/* Control construct info (for do loops, else, etc) */

struct Ctlframe
	{
	unsigned ctltype:8;
	unsigned dostepsign:8;	/* 0 - variable, 1 - pos, 2 - neg */
	unsigned dowhile:1;
	int ctlabels[4];	/* Control labels, defined below */
	int dolabel;		/* label marking end of this DO loop */
	Namep donamep;		/* DO index variable */
	expptr domax;		/* constant or temp variable holding MAX
				   loop value; or expr of while(expr) */
	expptr dostep;		/* expression */
	Namep loopname;
	};
#define endlabel ctlabels[0]
#define elselabel ctlabels[1]
#define dobodylabel ctlabels[1]
#define doposlabel ctlabels[2]
#define doneglabel ctlabels[3]
extern struct Ctlframe *ctls;		/* Keeps info on DO and BLOCK IF
					   structures - this is the stack
					   bottom */
extern struct Ctlframe *ctlstack;	/* Pointer to current nesting
					   level */
extern struct Ctlframe *lastctl;	/* Point to end of
					   dynamically-allocated array */

typedef struct {
	int type;
	chainp cp;
	} Atype;

typedef struct {
	int defined, dnargs, nargs, changes;
	Atype atypes[1];
	} Argtypes;

/* External Symbols */

struct Extsym
	{
	char *fextname;		/* Fortran version of external name */
	char *cextname;		/* C version of external name */
	field extstg;		/* STG -- should be COMMON, UNKNOWN or EXT
				   */
	unsigned extype:4;	/* for transmitting type to output routines */
	unsigned used_here:1;	/* Boolean - true on the second pass
				   through a function if the block has
				   been referenced */
	unsigned exused:1;	/* Has been used (for help with error msgs
				   about externals typed differently in
				   different modules) */
	unsigned exproto:1;	/* type specified in a .P file */
	unsigned extinit:1;	/* Procedure has been defined,
				   or COMMON has DATA */
	unsigned extseen:1;	/* True if previously referenced */
	chainp extp;		/* List of identifiers in the common
				   block for this function, stored as
				   Namep (hash table pointers) */
	chainp allextp;		/* List of lists of identifiers; we keep one
				   list for each layout of this common block */
	int curno;		/* current number for this common block,
				   used for constructing appending _nnn
				   to the common block name */
	int maxno;		/* highest curno value for this common block */
	ftnint extleng;
	ftnint maxleng;
	Argtypes *arginfo;
	};
typedef struct Extsym Extsym;

extern Extsym *extsymtab;	/* External symbol table */
extern Extsym *nextext;
extern Extsym *lastext;
extern int complex_seen, dcomplex_seen;

/* Statement labels */

struct Labelblock
	{
	int labelno;		/* Internal label */
	unsigned blklevel:8;	/* level of nesting, for branch-in-loop
				   checking */
	unsigned labused:1;
	unsigned fmtlabused:1;
	unsigned labinacc:1;	/* inaccessible? (i.e. has its scope
				   vanished) */
	unsigned labdefined:1;	/* YES or NO */
	unsigned labtype:2;	/* LAB{FORMAT,EXEC,etc} */
	ftnint stateno;		/* Original label */
	char *fmtstring;	/* format string */
	};

extern struct Labelblock *labeltab;	/* Label table - keeps track of
					   all labels, including undefined */
extern struct Labelblock *labtabend;
extern struct Labelblock *highlabtab;

/* Entry point list */

struct Entrypoint
	{
	struct Entrypoint *entnextp;
	Extsym *entryname;	/* Name of this ENTRY */
	chainp arglist;
	int typelabel;			/* Label for function exit; this
					   will return the proper type of
					   object */
	Namep enamep;			/* External name */
	};

/* Primitive block, or Primary block.  This is a general template returned
   by the parser, which will be interpreted in context.  It is a template
   for an identifier (variable name, function name), parenthesized
   arguments (array subscripts, function parameters) and substring
   specifications. */

struct Primblock
	{
	field tag;
	field vtype;
	unsigned parenused:1;		/* distinguish (a) from a */
	Namep namep;			/* Pointer to structure Nameblock */
	struct Listblock *argsp;
	expptr fcharp;			/* first-char-index-pointer (in
					   substring) */
	expptr lcharp;			/* last-char-index-pointer (in
					   substring) */
	};