usr/src/cmd/f77/defs

#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 100

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;
\f
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();