lang/fortran/comp/defs.h

   1 /****************************************************************
   2 Copyright 1990, 1991 by AT&T Bell Laboratories, Bellcore.
   3
   4 Permission to use, copy, modify, and distribute this software
   5 and its documentation for any purpose and without fee is hereby
   6 granted, provided that the above copyright notice appear in all
   7 copies and that both that the copyright notice and this
   8 permission notice and warranty disclaimer appear in supporting
   9 documentation, and that the names of AT&T Bell Laboratories or
  10 Bellcore or any of their entities not be used in advertising or
  11 publicity pertaining to distribution of the software without
  12 specific, written prior permission.
  13
  14 AT&T and Bellcore disclaim all warranties with regard to this
  15 software, including all implied warranties of merchantability
  16 and fitness.  In no event shall AT&T or Bellcore be liable for
  17 any special, indirect or consequential damages or any damages
  18 whatsoever resulting from loss of use, data or profits, whether
  19 in an action of contract, negligence or other tortious action,
  20 arising out of or in connection with the use or performance of
  21 this software.
  22 ****************************************************************/
  23
  24 #include "sysdep.h"
  25
  26 #include "ftypes.h"
  27 #include "defines.h"
  28 #include "machdefs.h"
  29
  30 #define MAXDIM 20
  31 #define MAXINCLUDES 10
  32 #define MAXLITERALS 200         /* Max number of constants in the literal
  33                                    pool */
  34 #define MAXTOKENLEN 302         /* length of longest token */
  35 #define MAXCTL 20
  36 #define MAXHASH 401
  37 #define MAXSTNO 801
  38 #define MAXEXT 200
  39 #define MAXEQUIV 150
  40 #define MAXLABLIST 125          /* Max number of labels in an alternate
  41                                    return CALL */
  42
  43 /* These are the primary pointer types used in the compiler */
  44
  45 typedef union Expression *expptr, *tagptr;
  46 typedef struct Chain *chainp;
  47 typedef struct Addrblock *Addrp;
  48 typedef struct Constblock *Constp;
  49 typedef struct Exprblock *Exprp;
  50 typedef struct Nameblock *Namep;
  51
  52 extern FILEP opf();
  53 extern FILEP infile;
  54 extern FILEP diagfile;
  55 extern FILEP textfile;
  56 extern FILEP asmfile;
  57 extern FILEP c_file;            /* output file for all functions; extern
  58                                    declarations will have to be prepended */
  59 extern FILEP pass1_file;        /* Temp file to hold the function bodies
  60                                    read on pass 1 */
  61 extern FILEP expr_file;         /* Debugging file */
  62 extern FILEP initfile;          /* Intermediate data file pointer */
  63 extern FILEP blkdfile;          /* BLOCK DATA file */
  64
  65 extern int current_ftn_file;
  66
  67 extern char *blkdfname, *initfname, *sortfname;
  68 extern long int headoffset;     /* Since the header block requires data we
  69                                    don't know about until AFTER each
  70                                    function has been processed, we keep a
  71                                    pointer to the current (dummy) header
  72                                    block (at the top of the assembly file)
  73                                    here */
  74
  75 extern char main_alias[];       /* name given to PROGRAM psuedo-op */
  76 extern char token [ ];
  77 extern int toklen;
  78 extern long lineno;
  79 extern char *infname;
  80 extern int needkwd;
  81 extern struct Labelblock *thislabel;
  82
  83 /* Used to allow runtime expansion of internal tables.  In particular,
  84    these values can exceed their associated constants */
  85
  86 extern int maxctl;
  87 extern int maxequiv;
  88 extern int maxstno;
  89 extern int maxhash;
  90 extern int maxext;
  91
  92 extern flag nowarnflag;
  93 extern flag ftn66flag;          /* Generate warnings when weird f77
  94                                    features are used (undeclared dummy
  95                                    procedure, non-char initialized with
  96                                    string, 1-dim subscript in EQUIV) */
  97 extern flag no66flag;           /* Generate an error when a generic
  98                                    function (f77 feature) is used */
  99 extern flag noextflag;          /* Generate an error when an extension to
 100                                    Fortran 77 is used (hex/oct/bin
 101                                    constants, automatic, static, double
 102                                    complex types) */
 103 extern flag zflag;              /* enable double complex intrinsics */
 104 extern flag shiftcase;
 105 extern flag undeftype;
 106 extern flag shortsubs;          /* Use short subscripts on arrays? */
 107 extern flag onetripflag;        /* if true, always execute DO loop body */
 108 extern flag checksubs;
 109 extern flag debugflag;
 110 extern int nerr;
 111 extern int nwarn;
 112
 113 extern int parstate;
 114 extern flag headerdone;         /* True iff the current procedure's header
 115                                    data has been written */
 116 extern int blklevel;
 117 extern flag saveall;
 118 extern flag substars;           /* True iff some formal parameter is an
 119                                    asterisk */
 120 extern int impltype[ ];
 121 extern ftnint implleng[ ];
 122 extern int implstg[ ];
 123
 124 extern int tycomplex, tyint, tyioint, tyreal;
 125 extern int tylogical;           /* TY____ of the implementation of   logical.
 126                                    This will be LONG unless '-2' is given
 127                                    on the command line */
 128 extern int type_choice[];
 129 extern char *typename[];
 130
 131 extern int typesize[];  /* size (in bytes) of an object of each
 132                                    type.  Indexed by TY___ macros */
 133 extern int typealign[];
 134 extern int proctype;    /* Type of return value in this procedure */
 135 extern char * procname; /* External name of the procedure, or last ENTRY name */
 136 extern int rtvlabel[ ]; /* Return value labels, indexed by TY___ macros */
 137 extern Addrp retslot;
 138 extern Addrp xretslot[];
 139 extern int cxslot;      /* Complex return argument slot (frame pointer offset)*/
 140 extern int chslot;      /* Character return argument slot (fp offset) */
 141 extern int chlgslot;    /* Argument slot for length of character buffer */
 142 extern int procclass;   /* Class of the current procedure:  either CLPROC,
 143                            CLMAIN, CLBLOCK or CLUNKNOWN */
 144 extern ftnint procleng; /* Length of function return value (e.g. char
 145                            string length).  If this is -1, then the length is
 146                            not known at compile time */
 147 extern int nentry;      /* Number of entry points (other than the original
 148                            function call) into this procedure */
 149 extern flag multitype;  /* YES iff there is more than one return value
 150                            possible */
 151 extern int blklevel;
 152 extern long lastiolabno;
 153 extern int lastlabno;
 154 extern int lastvarno;
 155 extern int lastargslot; /* integer offset pointing to the next free
 156                            location for an argument to the current routine */
 157 extern int argloc;
 158 extern int autonum[];           /* for numbering
 159                                    automatic variables, e.g. temporaries */
 160 extern int retlabel;
 161 extern int ret0label;
 162 extern int dorange;             /* Number of the label which terminates
 163                                    the innermost DO loop */
 164 extern int regnum[ ];           /* Numbers of DO indicies named in
 165                                    regnamep   (below) */
 166 extern Namep regnamep[ ];       /* List of DO indicies in registers */
 167 extern int maxregvar;           /* number of elts in   regnamep   */
 168 extern int highregvar;          /* keeps track of the highest register
 169                                    number used by DO index allocator */
 170 extern int nregvar;             /* count of DO indicies in registers */
 171
 172 extern chainp templist[];
 173 extern int maxdim;
 174 extern chainp earlylabs;
 175 extern chainp holdtemps;
 176 extern struct Entrypoint *entries;
 177 extern struct Rplblock *rpllist;
 178 extern struct Chain *curdtp;
 179 extern ftnint curdtelt;
 180 extern chainp allargs;          /* union of args in entries */
 181 extern int nallargs;            /* total number of args */
 182 extern int nallchargs;          /* total number of character args */
 183 extern flag toomanyinit;        /* True iff too many initializers in a
 184                                    DATA statement */
 185
 186 extern flag inioctl;
 187 extern int iostmt;
 188 extern Addrp ioblkp;
 189 extern int nioctl;
 190 extern int nequiv;
 191 extern int eqvstart;    /* offset to eqv number to guarantee uniqueness
 192                            and prevent <something> from going negative */
 193 extern int nintnames;
 194
 195 /* Chain of tagged blocks */
 196
 197 struct Chain
 198         {
 199         chainp nextp;
 200         char * datap;           /* Tagged block */
 201         };
 202
 203 extern chainp chains;
 204
 205 /* Recall that   field   is intended to hold four-bit characters */
 206
 207 /* This structure exists only to defeat the type checking */
 208
 209 struct Headblock
 210         {
 211         field tag;
 212         field vtype;
 213         field vclass;
 214         field vstg;
 215         expptr vleng;           /* Expression for length of char string -
 216                                    this may be a constant, or an argument
 217                                    generated by mkarg() */
 218         } ;
 219
 220 /* Control construct info (for do loops, else, etc) */
 221
 222 struct Ctlframe
 223         {
 224         unsigned ctltype:8;
 225         unsigned dostepsign:8;  /* 0 - variable, 1 - pos, 2 - neg */
 226         unsigned dowhile:1;
 227         int ctlabels[4];        /* Control labels, defined below */
 228         int dolabel;            /* label marking end of this DO loop */
 229         Namep donamep;          /* DO index variable */
 230         expptr domax;           /* constant or temp variable holding MAX
 231                                    loop value; or expr of while(expr) */
 232         expptr dostep;          /* expression */
 233         Namep loopname;
 234         };
 235 #define endlabel ctlabels[0]
 236 #define elselabel ctlabels[1]
 237 #define dobodylabel ctlabels[1]
 238 #define doposlabel ctlabels[2]
 239 #define doneglabel ctlabels[3]
 240 extern struct Ctlframe *ctls;           /* Keeps info on DO and BLOCK IF
 241                                            structures - this is the stack
 242                                            bottom */
 243 extern struct Ctlframe *ctlstack;       /* Pointer to current nesting
 244                                            level */
 245 extern struct Ctlframe *lastctl;        /* Point to end of
 246                                            dynamically-allocated array */
 247
 248 typedef struct {
 249         int type;
 250         chainp cp;
 251         } Atype;
 252
 253 typedef struct {
 254         int nargs, changes;
 255         Atype atypes[1];
 256         } Argtypes;
 257
 258 /* External Symbols */
 259
 260 struct Extsym
 261         {
 262         char *fextname;         /* Fortran version of external name */
 263         char *cextname;         /* C version of external name */
 264         field extstg;           /* STG -- should be COMMON, UNKNOWN or EXT
 265                                    */
 266         unsigned extype:4;      /* for transmitting type to output routines */
 267         unsigned used_here:1;   /* Boolean - true on the second pass
 268                                    through a function if the block has
 269                                    been referenced */
 270         unsigned exused:1;      /* Has been used (for help with error msgs
 271                                    about externals typed differently in
 272                                    different modules) */
 273         unsigned exproto:1;     /* type specified in a .P file */
 274         unsigned extinit:1;     /* Procedure has been defined,
 275                                    or COMMON has DATA */
 276         unsigned extseen:1;     /* True if previously referenced */
 277         chainp extp;            /* List of identifiers in the common
 278                                    block for this function, stored as
 279                                    Namep (hash table pointers) */
 280         chainp allextp;         /* List of lists of identifiers; we keep one
 281                                    list for each layout of this common block */
 282         int curno;              /* current number for this common block,
 283                                    used for constructing appending _nnn
 284                                    to the common block name */
 285         int maxno;              /* highest curno value for this common block */
 286         ftnint extleng;
 287         ftnint maxleng;
 288         Argtypes *arginfo;
 289         };
 290 typedef struct Extsym Extsym;
 291
 292 extern Extsym *extsymtab;       /* External symbol table */
 293 extern Extsym *nextext;
 294 extern Extsym *lastext;
 295 extern int complex_seen, dcomplex_seen;
 296
 297 /* Statement labels */
 298
 299 struct Labelblock
 300         {
 301         int labelno;            /* Internal label */
 302         unsigned blklevel:8;    /* level of nesting , for branch-in-loop
 303                                    checking */
 304         unsigned labused:1;
 305         unsigned fmtlabused:1;
 306         unsigned labinacc:1;    /* inaccessible? (i.e. has its scope
 307                                    vanished) */
 308         unsigned labdefined:1;  /* YES or NO */
 309         unsigned labtype:2;     /* LAB{FORMAT,EXEC,etc} */
 310         ftnint stateno;         /* Original label */
 311         char *fmtstring;        /* format string */
 312         };
 313
 314 extern struct Labelblock *labeltab;     /* Label table - keeps track of
 315                                            all labels, including undefined */
 316 extern struct Labelblock *labtabend;
 317 extern struct Labelblock *highlabtab;
 318
 319 /* Entry point list */
 320
 321 struct Entrypoint
 322         {
 323         struct Entrypoint *entnextp;
 324         Extsym *entryname;      /* Name of this ENTRY */
 325         chainp arglist;
 326         int typelabel;                  /* Label for function exit; this
 327                                            will return the proper type of
 328                                            object */
 329         Namep enamep;                   /* External name */
 330         };
 331
 332 /* Primitive block, or Primary block.  This is a general template returned
 333    by the parser, which will be interpreted in context.  It is a template
 334    for an identifier (variable name, function name), parenthesized
 335    arguments (array subscripts, function parameters) and substring
 336    specifications. */
 337
 338 struct Primblock
 339         {
 340         field tag;
 341         field vtype;
 342         Namep namep;                    /* Pointer to structure Nameblock */
 343         struct Listblock *argsp;
 344         expptr fcharp;                  /* first-char-index-pointer (in
 345                                            substring) */
 346         expptr lcharp;                  /* last-char-index-pointer (in
 347                                            substring) */
 348         };
 349
 350
 351 struct Hashentry
 352         {
 353         int hashval;
 354         Namep varp;
 355         };
 356 extern struct Hashentry *hashtab;       /* Hash table */
 357 extern struct Hashentry *lasthash;
 358
 359 struct Intrpacked       /* bits for intrinsic function description */
 360         {
 361         unsigned f1:3;
 362         unsigned f2:4;
 363         unsigned f3:7;
 364         unsigned f4:1;
 365         };
 366
 367 struct Nameblock
 368         {
 369         field tag;
 370         field vtype;
 371         field vclass;
 372         field vstg;
 373         expptr vleng;           /* length of character string, if applicable */
 374         char *fvarname;         /* name in the Fortran source */
 375         char *cvarname;         /* name in the resulting C */
 376         chainp vlastdim;        /* datap points to new_vars entry for the */
 377                                 /* system variable, if any, storing the final */
 378                                 /* dimension; we zero the datap if this */
 379                                 /* variable is needed */
 380         unsigned vprocclass:3;  /* P____ macros - selects the   varxptr
 381                                    field below */
 382         unsigned vdovar:1;      /* "is it a DO variable?" for register
 383                                    and multi-level loop checking */
 384         unsigned vdcldone:1;    /* "do I think I'm done?" - set when the
 385                                    context is sufficient to determine its
 386                                    status */
 387         unsigned vadjdim:1;     /* "adjustable dimension?" - needed for
 388                                    information about copies */
 389         unsigned vsave:1;
 390         unsigned vimpldovar:1;  /* used to prevent erroneous error messages
 391                                    for variables used only in DATA stmt
 392                                    implicit DOs */
 393         unsigned vis_assigned:1;/* True if this variable has had some
 394                                    label ASSIGNED to it; hence
 395                                    varxptr.assigned_values is valid */
 396         unsigned vimplstg:1;    /* True if storage type is assigned implicitly;
 397                                    this allows a COMMON variable to participate
 398                                    in a DIMENSION before the COMMON declaration.
 399                                    */
 400         unsigned vcommequiv:1;  /* True if EQUIVALENCEd onto STGCOMMON */
 401         unsigned vfmt_asg:1;    /* True if char *var_fmt needed */
 402         unsigned vpassed:1;     /* True if passed as a character-variable arg */
 403         unsigned vknownarg:1;   /* True if seen in a previous entry point */
 404         unsigned visused:1;     /* True if variable is referenced -- so we */
 405                                 /* can omit variables that only appear in DATA */
 406         unsigned vnamelist:1;   /* Appears in a NAMELIST */
 407         unsigned vimpltype:1;   /* True if implicitly typed and not
 408                                    invoked as a function or subroutine
 409                                    (so we can consistently type procedures
 410                                    declared external and passed as args
 411                                    but never invoked).
 412                                    */
 413         unsigned vtypewarned:1; /* so we complain just once about
 414                                    changed types of external procedures */
 415         unsigned vinftype:1;    /* so we can restore implicit type to a
 416                                    procedure if it is invoked as a function
 417                                    after being given a different type by -it */
 418         unsigned vinfproc:1;    /* True if -it infers this to be a procedure */
 419         unsigned vcalled:1;     /* has been invoked */
 420         unsigned vdimfinish:1;  /* need to invoke dim_finish() */
 421
 422 /* The   vardesc   union below is used to store the number of an intrinsic
 423    function (when vstg == STGINTR and vprocclass == PINTRINSIC), or to
 424    store the index of this external symbol in   extsymtab   (when vstg ==
 425    STGEXT and vprocclass == PEXTERNAL) */
 426
 427         union   {
 428                 int varno;              /* Return variable for a function.
 429                                            This is used when a function is
 430                                            assigned a return value.  Also
 431                                            used to point to the COMMON
 432                                            block, when this is a field of
 433                                            that block.  Also points to
 434                                            EQUIV block when STGEQUIV */
 435                 struct Intrpacked intrdesc;     /* bits for intrinsic function*/
 436                 } vardesc;
 437         struct Dimblock *vdim;  /* points to the dimensions if they exist */
 438         ftnint voffset;         /* offset in a storage block (the variable
 439                                    name will be "v.%d", voffset in a
 440                                    common blck on the vax).  Also holds
 441                                    pointers for automatic variables.  When
 442                                    STGEQUIV, this is -(offset from array
 443                                    base) */
 444         union   {
 445                 chainp namelist;        /* points to names in the NAMELIST,
 446                                            if this is a NAMELIST name */
 447                 chainp vstfdesc;        /* points to (formals, expr) pair */
 448                 chainp assigned_values; /* list of integers, each being a
 449                                            statement label assigned to
 450                                            this variable in the current function */
 451                 } varxptr;
 452         int argno;              /* for multiple entries */
 453         Argtypes *arginfo;
 454         };
 455
 456
 457 /* PARAMETER statements */
 458
 459 struct Paramblock
 460         {
 461         field tag;
 462         field vtype;
 463         field vclass;
 464         field vstg;
 465         expptr vleng;
 466         char *fvarname;
 467         char *cvarname;
 468         expptr paramval;
 469         } ;
 470
 471
 472 /* Expression block */
 473
 474 struct Exprblock
 475         {
 476         field tag;
 477         field vtype;
 478         field vclass;
 479         field vstg;
 480         expptr vleng;           /* in the case of a character expression, this
 481                                    value is inherited from the children */
 482         unsigned opcode;
 483         expptr leftp;
 484         expptr rightp;
 485         };
 486
 487
 488 union Constant
 489         {
 490         struct {
 491                 char *ccp0;
 492                 ftnint blanks;
 493                 } ccp1;
 494         ftnint ci;              /* Constant long integer */
 495         double cd[2];
 496         char *cds[2];
 497         };
 498 #define ccp ccp1.ccp0
 499
 500 struct Constblock
 501         {
 502         field tag;
 503         field vtype;
 504         field vclass;
 505         field vstg;             /* vstg = 1 when using Const.cds */
 506         expptr vleng;
 507         union Constant Const;
 508         };
 509
 510
 511 struct Listblock
 512         {
 513         field tag;
 514         field vtype;
 515         chainp listp;
 516         };
 517
 518
 519
 520 /* Address block - this is the FINAL form of identifiers before being
 521    sent to pass 2.  We'll want to add the original identifier here so that it can
 522    be preserved in the translation.
 523
 524    An example identifier is q.7.  The "q" refers to the storage class
 525    (field vstg), the 7 to the variable number (int memno). */
 526
 527 struct Addrblock
 528         {
 529         field tag;
 530         field vtype;
 531         field vclass;
 532         field vstg;
 533         expptr vleng;
 534         /* put union...user here so the beginning of an Addrblock
 535          * is the same as a Constblock.
 536          */
 537         union {
 538             Namep name;         /* contains a pointer into the hash table */
 539             char ident[IDENT_LEN + 1];  /* C string form of identifier */
 540             char *Charp;
 541             union Constant Const;       /* Constant value */
 542             struct {
 543                 double dfill[2];
 544                 field vstg1;
 545                 } kludge;       /* so we can distinguish string vs binary
 546                                  * floating-point constants */
 547         } user;
 548         long memno;             /* when vstg == STGCONST, this is the
 549                                    numeric part of the assembler label
 550                                    where the constant value is stored */
 551         expptr memoffset;       /* used in subscript computations, usually */
 552         unsigned istemp:1;      /* used in stack management of temporary
 553                                    variables */
 554         unsigned isarray:1;     /* used to show that memoffset is
 555                                    meaningful, even if zero */
 556         unsigned ntempelt:10;   /* for representing temporary arrays, as
 557                                    in concatenation */
 558         unsigned dbl_builtin:1; /* builtin to be declared double */
 559         unsigned charleng:1;    /* so saveargtypes can get i/o calls right */
 560         ftnint varleng;         /* holds a copy of a constant length which
 561                                    is stored in the   vleng   field (e.g.
 562                                    a double is 8 bytes) */
 563         int uname_tag;          /* Tag describing which of the unions()
 564                                    below to use */
 565         char *Field;            /* field name when dereferencing a struct */
 566 }; /* struct Addrblock */
 567
 568
 569 /* Errorbock - placeholder for errors, to allow the compilation to
 570    continue */
 571
 572 struct Errorblock
 573         {
 574         field tag;
 575         field vtype;
 576         };
 577
 578
 579 /* Implicit DO block, especially related to DATA statements.  This block
 580    keeps track of the compiler's location in the implicit DO while it's
 581    running.  In particular, the   isactive and isbusy   flags tell where
 582    it is */
 583
 584 struct Impldoblock
 585         {
 586         field tag;
 587         unsigned isactive:1;
 588         unsigned isbusy:1;
 589         Namep varnp;
 590         Constp varvp;
 591         chainp impdospec;
 592         expptr implb;
 593         expptr impub;
 594         expptr impstep;
 595         ftnint impdiff;
 596         ftnint implim;
 597         struct Chain *datalist;
 598         };
 599
 600
 601 /* Each of these components has a first field called   tag.   This union
 602    exists just for allocation simplicity */
 603
 604 union Expression
 605         {
 606         field tag;
 607         struct Addrblock addrblock;
 608         struct Constblock constblock;
 609         struct Errorblock errorblock;
 610         struct Exprblock exprblock;
 611         struct Headblock headblock;
 612         struct Impldoblock impldoblock;
 613         struct Listblock listblock;
 614         struct Nameblock nameblock;
 615         struct Paramblock paramblock;
 616         struct Primblock primblock;
 617         } ;
 618
 619
 620
 621 struct Dimblock
 622         {
 623         int ndim;
 624         expptr nelt;            /* This is NULL if the array is unbounded */
 625         expptr baseoffset;      /* a constant or local variable holding
 626                                    the offset in this procedure */
 627         expptr basexpr;         /* expression for comuting the offset, if
 628                                    it's not constant.  If this is
 629                                    non-null, the register named in
 630                                    baseoffset will get initialized to this
 631                                    value in the procedure's prolog */
 632         struct
 633                 {
 634                 expptr dimsize; /* constant or register holding the size
 635                                    of this dimension */
 636                 expptr dimexpr; /* as above in basexpr, this is an
 637                                    expression for computing a variable
 638                                    dimension */
 639                 } dims[1];      /* Dimblocks are allocated with enough
 640                                    space for this to become dims[ndim] */
 641         };
 642
 643
 644 /* Statement function identifier stack - this holds the name and value of
 645    the parameters in a statement function invocation.  For example,
 646
 647         f(x,y,z)=x+y+z
 648                 .
 649                 .
 650         y = f(1,2,3)
 651
 652    generates a stack of depth 3, with <x 1>, <y 2>, <z 3> AT THE INVOCATION, NOT
 653    at the definition */
 654
 655 struct Rplblock /* name replacement block */
 656         {
 657         struct Rplblock *rplnextp;
 658         Namep rplnp;            /* Name of the formal parameter */
 659         expptr rplvp;           /* Value of the actual parameter */
 660         expptr rplxp;           /* Initialization of temporary variable,
 661                                    if required; else null */
 662         int rpltag;             /* Tag on the value of the actual param */
 663         };
 664
 665
 666
 667 /* Equivalence block */
 668
 669 struct Equivblock
 670         {
 671         struct Eqvchain *equivs;        /* List (Eqvchain) of primblocks
 672                                            holding variable identifiers */
 673         flag eqvinit;
 674         long int eqvtop;
 675         long int eqvbottom;
 676         int eqvtype;
 677         } ;
 678 #define eqvleng eqvtop
 679
 680 extern struct Equivblock *eqvclass;
 681
 682
 683 struct Eqvchain
 684         {
 685         struct Eqvchain *eqvnextp;
 686         union
 687                 {
 688                 struct Primblock *eqvlhs;
 689                 Namep eqvname;
 690                 } eqvitem;
 691         long int eqvoffset;
 692         } ;
 693
 694
 695
 696 /* For allocation purposes only, and to keep lint quiet.  In particular,
 697    don't count on the tag being able to tell you which structure is used */
 698
 699
 700 /* There is a tradition in Fortran that the compiler not generate the same
 701    bit pattern more than is necessary.  This structure is used to do just
 702    that; if two integer constants have the same bit pattern, just generate
 703    it once.  This could be expanded to optimize without regard to type, by
 704    removing the type check in   putconst()   */
 705
 706 struct Literal
 707         {
 708         short littype;
 709         short litnum;                   /* numeric part of the assembler
 710                                            label for this constant value */
 711         int lituse;             /* usage count */
 712         union   {
 713                 ftnint litival;
 714                 double litdval[2];
 715                 ftnint litival2[2];     /* length, nblanks for strings */
 716                 } litval;
 717         char *cds[2];
 718         };
 719
 720 extern struct Literal *litpool;
 721 extern int maxliterals, nliterals;
 722 extern char Letters[];
 723 #define letter(x) Letters[x]
 724
 725 struct Dims { expptr lb, ub; };
 726
 727
 728 /* popular functions with non integer return values */
 729
 730
 731 int *ckalloc();
 732 char *varstr(), *nounder(), *addunder();
 733 char *copyn(), *copys();
 734 chainp hookup(), mkchain(), revchain();
 735 ftnint convci();
 736 char *convic();
 737 char *setdoto();
 738 double convcd();
 739 Namep mkname();
 740 struct Labelblock *mklabel(), *execlab();
 741 Extsym *mkext(), *newentry();
 742 expptr addrof(), call1(), call2(), call3(), call4();
 743 Addrp builtin(), mktmp(), mktmp0(), mktmpn(), autovar();
 744 Addrp mkplace(), mkaddr(), putconst(), memversion();
 745 expptr mkprim(), mklhs(), mkexpr(), mkconv(), mkfunct(), fixexpr(), fixtype();
 746 expptr errnode(), mkaddcon(), mkintcon(), putcxop();
 747 tagptr cpexpr();
 748 ftnint lmin(), lmax(), iarrlen();
 749 char *dbconst(), *flconst();
 750
 751 void puteq (), putex1 ();
 752 expptr putx (), putsteq (), putassign ();
 753
 754 extern int forcedouble;         /* force real functions to double */
 755 extern int doin_setbound;       /* special handling for array bounds */
 756 extern int Ansi;
 757 extern char *cds(), *cpstring(), *dtos(), *string_num();
 758 extern char *c_type_decl();
 759 extern char hextoi_tab[];
 760 #define hextoi(x) hextoi_tab[(x) & 0xff]
 761 extern char *casttypes[], *ftn_types[], *protorettypes[], *usedcasts[];
 762 extern int Castargs, infertypes;
 763 extern FILE *protofile;
 764 extern void exit(), inferdcl(), protowrite(), save_argtypes();
 765 extern char binread[], binwrite[], textread[], textwrite[];
 766 extern char *ei_first, *ei_last, *ei_next;
 767 extern char *wh_first, *wh_last, *wh_next;
 768 extern void putwhile();
 769 extern char *halign;