#include #ifdef unix # include #endif #include "ftypes" #include "defines" #include "locdefs" #define VL 6 /* * Normal Table definitions */ #define MAXINCLUDES 10 #define MAXLITERALS 20 #define MAXCTL 20 #define MAXHASH 401 #define MAXSTNO 301 /* Increased from 201 PLW 10/80 */ #define MAXEXT 200 #define MAXEQUIV 150 #define MAXLABLIST 125 typedef union expression *expptr; typedef union taggedblock *tagptr; typedef union chainedblock *chainp; extern FILEP infile; extern FILEP diagfile; extern FILEP textfile; extern FILEP asmfile; extern FILEP initfile; extern long int headoffset; extern char token [ ]; extern int toklen; extern int yylval; extern int lineno; extern char *infname; extern int needkwd; extern struct labelblock *thislabel; extern flag profileflag; extern flag optimflag; extern flag nowarnflag; extern flag ftn66flag; extern flag shiftcase; extern flag undeftype; extern flag shortsubs; extern flag onetripflag; extern flag checksubs; extern flag debugflag; extern int nerr; extern int nwarn; extern int ndata; extern int parstate; extern flag headerdone; extern int blklevel; extern flag saveall; extern flag substars; extern int impltype[ ]; extern int implleng[ ]; extern int implstg[ ]; extern int tyint; extern int tylogical; extern ftnint typesize[]; extern int typealign[]; extern int procno; extern int proctype; extern char * procname; extern int rtvlabel[ ]; extern int fudgelabel; /* to confuse the pdp11 optimizer */ extern struct addrblock *typeaddr; extern struct addrblock *retslot; extern int cxslot; extern int chslot; extern int chlgslot; extern int procclass; extern ftnint procleng; extern int nentry; extern flag multitype; extern int blklevel; extern int lastlabno; extern int lastvarno; extern int lastargslot; extern int argloc; extern ftnint autoleng; extern ftnint bssleng; extern int retlabel; extern int ret0label; extern int dorange; extern int regnum[ ]; extern struct nameblock *regnamep[ ]; extern int maxregvar; extern int highregvar; extern int nregvar; extern chainp templist; extern chainp holdtemps; extern struct entrypoint *entries; extern struct rplblock *rpllist; extern chainp curdtp; extern ftnint curdtelt; extern flag toomanyinit; extern flag inioctl; extern int iostmt; extern struct addrblock *ioblkp; extern int nioctl; extern int nequiv; extern int nintnames; extern int nextnames; struct chain { chainp nextp; tagptr datap; }; extern chainp chains; struct ctlframe { unsigned ctltype:8; unsigned dostepsign:8; int ctlabels[4]; int dolabel; struct nameblock *donamep; expptr domax; expptr dostep; }; #define endlabel ctlabels[0] #define elselabel ctlabels[1] #define dobodylabel ctlabels[1] #define doposlabel ctlabels[2] #define doneglabel ctlabels[3] extern struct ctlframe ctls[ ]; extern struct ctlframe *ctlstack; extern struct ctlframe *lastctl; struct extsym { char extname[XL]; unsigned extstg:4; unsigned extsave:1; unsigned extinit:1; ptr extp; ftnint extleng; ftnint maxleng; }; extern struct extsym extsymtab[ ]; extern struct extsym *nextext; extern struct extsym *lastext; struct labelblock { int labelno; unsigned blklevel:8; unsigned labused:1; unsigned labinacc:1; unsigned labdefined:1; unsigned labtype:2; ftnint stateno; }; extern struct labelblock labeltab[ ]; extern struct labelblock *labtabend; extern struct labelblock *highlabtab; struct entrypoint { chainp nextp; struct extsym *entryname; chainp arglist; int entrylabel; int typelabel; ptr enamep; }; struct primblock { unsigned tag:4; unsigned vtype:4; struct nameblock *namep; struct listblock *argsp; expptr fcharp; expptr lcharp; }; struct hashentry { int hashval; struct nameblock *varp; }; extern struct hashentry hashtab[ ]; extern struct hashentry *lasthash; struct intrpacked /* bits for intrinsic function description */ { unsigned f1:3; unsigned f2:4; unsigned f3:7; }; struct nameblock { unsigned tag:4; unsigned vtype:4; unsigned vclass:4; unsigned vstg:4; expptr vleng; char varname[VL]; unsigned vdovar:1; unsigned vdcldone:1; unsigned vadjdim:1; unsigned vsave:1; unsigned vprocclass:3; unsigned vregno:4; union { int varno; chainp vstfdesc; /* points to (formals, expr) pair */ struct intrpacked intrdesc; /* bits for intrinsic function */ } vardesc; struct dimblock *vdim; int voffset; }; struct paramblock { unsigned tag:4; unsigned vtype:4; unsigned vclass:4; expptr vleng; char varname[VL]; ptr paramval; } ; struct exprblock { unsigned tag:4; unsigned vtype:4; unsigned vclass:4; expptr vleng; unsigned opcode:6; expptr leftp; expptr rightp; }; union constant { char *ccp; ftnint ci; double cd[2]; }; struct constblock { unsigned tag:4; unsigned vtype:4; expptr vleng; union constant const; }; struct listblock { unsigned tag:4; unsigned vtype:4; chainp listp; }; struct addrblock { unsigned tag:4; unsigned vtype:4; unsigned vclass:4; unsigned vstg:4; expptr vleng; int memno; expptr memoffset; unsigned istemp:1; unsigned ntempelt:10; }; struct errorblock { unsigned tag:4; unsigned vtype:4; }; union expression { struct exprblock; struct addrblock; struct constblock; struct errorblock; struct listblock; struct primblock; } ; struct dimblock { int ndim; expptr nelt; expptr baseoffset; expptr basexpr; struct { expptr dimsize; expptr dimexpr; } dims[1]; }; struct impldoblock { unsigned tag:4; unsigned isactive:1; unsigned isbusy:1; struct nameblock *varnp; struct constblock *varvp; expptr implb; expptr impub; expptr impstep; ftnint impdiff; ftnint implim; chainp datalist; }; struct rplblock /* name replacement block */ { chainp nextp; struct nameblock *rplnp; ptr rplvp; struct exprblock *rplxp; int rpltag; }; struct equivblock { ptr equivs; unsigned eqvinit:1; long int eqvtop; long int eqvbottom; } ; #define eqvleng eqvtop extern struct equivblock eqvclass[ ]; struct eqvchain { chainp nextp; ptr eqvitem; long int eqvoffset; } ; union chainedblock { struct chain; struct entrypoint; struct rplblock; struct eqvchain; }; union taggedblock { struct nameblock; struct paramblock; struct exprblock; struct constblock; struct listblock; struct addrblock; struct errorblock; struct primblock; struct impldoblock; } ; struct literal { short littype; short litnum; union { ftnint litival; double litdval; struct { char litclen; /* small integer */ char litcstr[XL]; } litcval; } litval; }; extern struct literal litpool[ ]; extern int nliterals; /* popular functions with non integer return values */ int *ckalloc(); char *varstr(), *nounder(), *varunder(); char *copyn(), *copys(); chainp hookup(), mkchain(); ftnint convci(); char *convic(); char *setdoto(); double convcd(); struct nameblock *mkname(); struct labelblock *mklabel(); struct extsym *mkext(), *newentry(); struct exprblock *addrof(), *call1(), *call2(), *call3(), *call4(); struct addrblock *builtin(), *mktemp(), *mktmpn(); struct addrblock *autovar(), *mklhs(), *mkaddr(), *putconst(), *memversion(); struct constblock *mkintcon(); expptr mkexpr(), mkconv(), mkfunct(), fixexpr(), fixtype(); tagptr cpexpr(), mkprim(); struct errorblock *errnode();