home *** CD-ROM | disk | FTP | other *** search
- #include <stdio.h>
-
- #ifdef unix
- # include <ctype.h>
- #endif
-
- #include "ftypes"
- #include "defines"
- #include "locdefs"
-
- #define VL 6
-
- #define MAXINCLUDES 10
- #define MAXLITERALS 20
- #define MAXCTL 20
- #define MAXHASH 401
- #define MAXSTNO 201
- #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();
-