#include "stdio.h" #define NO 0 #define YES 1 #define CNULL (char *) 0 #define PNULL (ptr) 0 #define CHNULL (chainp) 0 #define HASHEDTABLE 1 #define XL 6 #define NFTNTYPES 7 #define NEFLTYPES 13 #define MEMSIZE 12240 #define YYMAXDEPTH 250 #define MAXSTNO 200 #define MAXINCLUDEDEPTH 10 #define MAXBLOCKDEPTH 30 #define MAXINDIFS 150 #define MAXFTNAMES 250 #define MAXEFLNAMES 300 #define MAXSWITCH 100 #define EXECPOOL 20 #define EXPRPOOL 40 #define NAMESPERLINE 6 #define LINESPACES 66 #define INDENTSPACES 3 typedef int *ptr; extern struct chain { ptr nextp; ptr datap; } ; typedef struct chain *chainp; extern int yylineno; extern int dumpic; extern int memdump; extern int dbgflag; extern int nowarnflag; extern int nocommentflag; extern int verbose; extern int dumpcore; #define TEST if(dbgflag) #define efgetc (efmacp?*efmacp++:getc(yyin)) extern char msg[]; #define UNIX 1 #define GCOS 2 #define GCOSBCD 3 #define CRAY 4 #define IBM 5 #define FIELDMAX 32768. #define ALLOC(x) (struct x *) intalloc(sizeof(struct x)) #define calloc efl_calloc #define alloc efl_alloc #define malloc efl_malloc #define cfree efl_cfree #define free efl_free extern FILE *diagfile; extern FILE *codefile; extern FILE *yyin; extern FILE *fileptrs[]; extern char *filenames[]; extern char *basefile; extern int filelines[]; extern int filedepth; extern char *efmacp; extern char *filemacs[]; extern int pushchars[]; extern struct fileblock *iifilep; extern int mem[]; extern unsigned int nmemused; extern long int totfreed; extern long int totalloc; extern int nhid[]; extern int ndecl[]; extern int indifs[]; extern int nxtindif; extern int afterif; extern neflnames; extern int nftnch; extern int nftncont; extern char ftnames[MAXFTNAMES][7]; extern int nftnames; extern int nftnm0; extern int impltype[]; extern int ftnmask[]; extern double fieldmax; extern int ftnefl[]; extern int eflftn[]; extern ptr thisexec; extern ptr thisctl; extern int pushlex; extern int igeol; extern int ateof; extern int eofneed; extern int forcerr; extern int comneed; extern int optneed; extern int defneed; extern int lettneed; extern int iobrlevel; extern int prevbg; extern chainp hidlist; extern chainp commonlist; extern chainp tempvarlist; extern chainp temptypelist; extern chainp gonelist; extern int blklevel; extern int ctllevel; extern int dclsect; extern int instruct; extern int inbound; extern int inproc; extern int ncases; extern ptr comments; extern ptr prevcomments; extern ptr genequivs; extern ptr arrays; extern ptr generlist; extern ptr knownlist; extern int graal; extern ptr procname; extern int procclass; extern ptr thisargs; extern int langopt; extern int dotsopt; extern int dbgopt; extern int dbglevel; extern int stnos[]; extern int nxtstno; extern int constno; extern int labno; extern int nerrs; extern int nbad; extern int nwarns; struct headbits { unsigned int tag:8; unsigned int subtype:8; unsigned int blklevel:8; }; extern struct fileblock { FILE *fileptr; char filename[20]; }; extern struct fileblock *ibfile; extern struct fileblock *icfile; extern struct fileblock *idfile; extern struct fileblock *iefile; extern struct comentry { struct headbits header; char comname[7]; long int comleng; unsigned int cominit:2; chainp comchain; } ; extern struct stentry { struct headbits header; char *namep; ptr varp; int hashval; }; extern struct stentry *hashtab[]; extern struct stentry **hashend; extern struct typeblock { struct headbits header; ptr sthead; ptr strdesc; int stralign; int strsize; int basetypes; } ; extern struct keyblock { struct headbits header; ptr sthead; } ; extern struct varblock { struct headbits header; ptr sthead; ptr vinit; unsigned int vadjdim:1; unsigned int vdcldone:1; unsigned int vdclstart:1; unsigned int vnamedone:1; unsigned int vprec:1; unsigned int vext:1; unsigned int vproc:2; unsigned int needpar:1; unsigned int vtype:4; unsigned int vclass:3; ptr vtypep; ptr vdim; ptr vsubs; ptr voffset; int vextbase; int vbase[NFTNTYPES]; } ; extern struct atblock { int atprec; int attype; int atext; int atclass; ptr attypep; ptr atcommon; ptr atdim; } ; extern struct dimblock { ptr nextp; ptr lowerb; ptr upperb; } ; extern struct exprblock /* must be same size as varblock */ { struct headbits header; ptr leftp; ptr rightp; unsigned int vadjdim:1; unsigned int vdcldone:1; unsigned int vdclstart:1; unsigned int vnamedone:1; unsigned int vprec:1; unsigned int vext:1; unsigned int vproc:2; unsigned int needpar:1; unsigned int vtype:4; unsigned int vclass:3; ptr vtypep; ptr vdim; ptr vsubs; ptr voffset; int vextbase; int vbase[NFTNTYPES]; } ; extern struct execblock { struct headbits header; ptr temps; int labelno; unsigned int uniffable:1; unsigned int brnchend:1; unsigned int labeled:1; unsigned int copylab:1; unsigned int labdefined:1; unsigned int labused:1; unsigned int labinacc:1; ptr execdesc; ptr prevexec; int nxtlabno; int nftnst; } ; extern struct ctlblock /* must be same size as execblock */ { struct headbits header; ptr loopvar; ptr loopctl; ptr prevctl; int nextlab; int breaklab; int xlab; int indifn; } ; extern struct caseblock { struct headbits header; ptr nextcase; int labelno; unsigned int uniffable:1; unsigned int brnchend:1; unsigned int labeled:1; unsigned int copylab:1; unsigned int labdefined:1; unsigned int labused:1; unsigned int labinacc:1; ptr casexpr; } ; extern struct labelblock { struct headbits header; ptr sthead; int labelno; unsigned int uniffable:1; unsigned int brnchend:1; unsigned int labeled:1; unsigned int copylab:1; unsigned int labdefined:1; unsigned int labused:1; unsigned int labinacc:1; } ; extern struct defblock { struct headbits header; ptr sthead; char *valp; } ; extern struct doblock { struct headbits header; ptr dovar; ptr dopar[3]; } ; extern struct fieldspec { struct headbits header; ptr flbound; ptr frange; ptr frshift; int fanymore; } ; extern struct genblock { struct headbits header; ptr nextgenf; char *genname; char *genfname[NEFLTYPES]; int genftype[NEFLTYPES]; } ; extern struct knownname { struct headbits header; ptr nextfunct; char *funcname; int functype; } ; extern struct iostblock { struct headbits header; ptr leftp; /* padding */ ptr right; /* padding */ unsigned int vadjdim:1; unsigned int vdcldone:1; unsigned int vdclstart:1; unsigned int vnamedone:1; unsigned int vprec:1; unsigned int vext:1; unsigned int vproc:2; unsigned int needpar:1; unsigned int vtype:4; unsigned int vclass:3; int iokwd; ptr iounit; ptr iolist; int iojunk[7]; /* padding */ } ; extern struct ioitem { struct headbits header; ptr ioexpr; char *iofmt; int nrep; } ; struct iogroup { struct headbits header; struct doblock *doptr; char *iofmt; int nrep; ptr ioitems; }; extern struct tailoring { int ftnsys; int errmode; int charcomp; int ftnin; int ftnout; int ftncontnu; char *procheader; char *lngcxtype; char *lngcxprefix; int ftnchwd; int ftnsize[NFTNTYPES]; int ftnalign[NFTNTYPES]; char *dfltfmt[NEFLTYPES]; int hollincall; int deltastno; int dclintrinsics; int ftn77; } tailor; struct system { char *sysname; short sysno; short chperwd; short idig; short rdig; short ddig; } systab[]; /* Declarations of popular functions */ char *copys(), *convic(), *procnm(); ptr cpexpr(), compconst(), simple(), mknode(), mkint(), mkconst(); ptr intalloc(), calloc(), allexcblock(), allexpblock(); ptr mkcall(), coerce(), fold(), builtin(), gent(), errnode(); ptr arg1(), arg2(), arg4(); struct stentry *name(); chainp mkchain(), hookup(); /*Block tags */ #define TAROP 1 #define TASGNOP 2 #define TLOGOP 3 #define TRELOP 4 #define TCALL 5 #define TREPOP 6 #define TLIST 7 #define TCONST 8 #define TNAME 9 #define TERROR 10 #define TCOMMON 11 #define TSTRUCT 12 #define TSTFUNCT 13 #define TEXEC 14 #define TTEMP 15 #define TDEFINE 16 #define TKEYWORD 17 #define TLABEL 18 #define TCASE 19 #define TNOTOP 20 #define TNEGOP 21 #define TDOBLOCK 22 #define TCONTROL 23 #define TKNOWNFUNCT 24 #define TFIELD 25 #define TGENERIC 26 #define TIOSTAT 27 #define TIOGROUP 28 #define TIOITEM 29 #define TFTNBLOCK 30 /* Operator subtypes */ #define OPPLUS 1 #define OPMINUS 2 #define OPSTAR 3 #define OPSLASH 4 #define OPPOWER 5 #define OPNOT 6 #define OPAND 7 #define OP2AND 8 #define OP2OR 9 #define OPOR 10 #define OPEQ 11 #define OPLT 12 #define OPGT 13 #define OPLE 14 #define OPGE 15 #define OPNE 16 #define OPLPAR 17 #define OPRPAR 18 #define OPEQUALS 19 #define OPCOMMA 20 #define OPASGN 0 #define OPREL 0 /* Simplification types */ #define LVAL 1 #define RVAL 2 #define SUBVAL 3 #define IFVAL 4 /* Parser return values */ #define PARSERR 1 #define PARSEOF 2 #define PARSOPT 3 #define PARSDCL 4 #define PARSDEF 5 #define PARSPROC 6 /* Symbol table types */ #define TYUNDEFINED 0 #define TYINT 1 #define TYREAL 2 #define TYLREAL 3 #define TYLOG 4 #define TYCOMPLEX 5 #define TYLCOMPLEX 6 #define TYCHAR 7 #define TYSTRUCT 8 #define TYLABEL 9 #define TYSUBR 10 #define TYFIELD 11 #define TYHOLLERITH 12 /* Fortran types */ #define FTNINT 0 #define FTNREAL 1 #define FTNLOG 2 #define FTNCOMPLEX 3 #define FTNDOUBLE 4 #define FTNCHAR 5 #define FTNDCOMPLEX 6 /* symbol table classes */ #define CLUNDEFINED 0 #define CLARG 1 #define CLVALUE 2 #define CLSTAT 3 #define CLAUTO 4 #define CLCOMMON 5 #define CLMOS 6 #define CLEXT 7 /* values of vproc */ #define PROCUNKNOWN 0 #define PROCNO 1 #define PROCYES 2 #define PROCINTRINSIC 3 /* values of procclass */ #define PRBLOCK 1 #define PRMAIN 2 #define PRSUBR 3 #define PRFUNCT 4 /* ctlblock subtypes */ #define STNULL 1 #define STIF 2 #define STIFELSE 3 #define STREPEAT 4 #define STWHILE 5 #define STFOR 6 #define STDO 7 #define STSWITCH 8 #define STRETURN 9 #define STGOTO 10 #define STCALL 11 #define STPROC 12 /* intermediate code definitions */ #define ICEOF 0 #define ICBEGIN 1 #define ICKEYWORD 2 #define ICOP 3 #define ICNAME 4 #define ICCONST 5 #define ICLABEL 6 #define ICMARK 7 #define ICINDENT 8 #define ICCOMMENT 9 #define ICINDPTR 10 #define ICBLANK 11 #define FCONTINUE 2 #define FCALL 3 #define FDO 4 #define FIF1 5 #define FIF2 6 #define FGOTO 7 #define FRETURN 8 #define FREAD 9 #define FWRITE 10 #define FFORMAT 11 #define FSTOP 12 #define FDATA 13 #define FEQUIVALENCE 14 #define FCOMMON 15 #define FEXTERNAL 16 #define FREWIND 17 #define FBACKSPACE 18 #define FENDFILE 19 #define FSUBROUTINE 20 #define FFUNCTION 21 #define FPROGRAM 22 #define FBLOCKDATA 23 #define FEND 24 /* I/O error handling options */ #define IOERRNONE 0 #define IOERRIBM 1 #define IOERRFORT77 2