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