|
|
1.1 ! root 1: #include "stdio.h" ! 2: #ifndef NULL ! 3: /* ANSI C version */ ! 4: #include "stddef.h" ! 5: #endif ! 6: ! 7: #ifdef unix ! 8: # include <ctype.h> ! 9: #endif ! 10: ! 11: #include "ftypes" ! 12: #include "defines" ! 13: #include "machdefs" ! 14: ! 15: #define VL 6 ! 16: ! 17: #define MAXDIM 20 ! 18: #define MAXINCLUDES 10 ! 19: #define MAXLITERALS 20 ! 20: #define MAXCTL 20 ! 21: #define MAXHASH 401 ! 22: #define MAXSTNO 801 ! 23: #define MAXEXT 200 ! 24: #define MAXEQUIV 150 ! 25: #define MAXLABLIST 125 ! 26: ! 27: typedef union Expression *expptr; ! 28: typedef union Taggedblock *tagptr; ! 29: typedef struct Chain *chainp; ! 30: typedef struct Addrblock *Addrp; ! 31: typedef struct Constblock *Constp; ! 32: typedef struct Exprblock *Exprp; ! 33: typedef struct Nameblock *Namep; ! 34: ! 35: extern FILEP infile; ! 36: extern FILEP diagfile; ! 37: extern FILEP textfile; ! 38: extern FILEP asmfile; ! 39: extern FILEP initfile; ! 40: extern long int headoffset; ! 41: ! 42: extern char token [ ]; ! 43: extern int toklen; ! 44: extern int lineno; ! 45: extern char *infname; ! 46: extern int needkwd; ! 47: extern struct Labelblock *thislabel; ! 48: ! 49: extern int maxctl; ! 50: extern int maxequiv; ! 51: extern int maxstno; ! 52: extern int maxhash; ! 53: extern int maxext; ! 54: ! 55: extern flag profileflag; ! 56: extern flag optimflag; ! 57: extern flag nowarnflag; ! 58: extern flag ftn66flag; ! 59: extern flag no66flag; ! 60: extern flag noextflag; ! 61: extern flag shiftcase; ! 62: extern flag undeftype; ! 63: extern flag shortsubs; ! 64: extern flag onetripflag; ! 65: extern flag checksubs; ! 66: extern flag debugflag; ! 67: extern int nerr; ! 68: extern int nwarn; ! 69: extern int ndata; ! 70: ! 71: extern int parstate; ! 72: extern flag headerdone; ! 73: extern int blklevel; ! 74: extern flag saveall; ! 75: extern flag substars; ! 76: extern int impltype[ ]; ! 77: extern int implleng[ ]; ! 78: extern int implstg[ ]; ! 79: ! 80: extern int tyint; ! 81: extern int tylogical; ! 82: extern ftnint typesize[]; ! 83: extern int typealign[]; ! 84: extern int procno; ! 85: extern int proctype; ! 86: extern char * procname; ! 87: extern int rtvlabel[ ]; ! 88: extern int fudgelabel; /* to confuse the pdp11 optimizer */ ! 89: extern Addrp typeaddr; ! 90: extern Addrp retslot; ! 91: extern int cxslot; ! 92: extern int chslot; ! 93: extern int chlgslot; ! 94: extern int procclass; ! 95: extern ftnint procleng; ! 96: extern int nentry; ! 97: extern flag multitype; ! 98: extern int blklevel; ! 99: extern int lastlabno; ! 100: extern int lastvarno; ! 101: extern int lastargslot; ! 102: extern int argloc; ! 103: extern ftnint autoleng; ! 104: extern ftnint bssleng; ! 105: extern int retlabel; ! 106: extern int ret0label; ! 107: extern int dorange; ! 108: extern int regnum[ ]; ! 109: extern Namep regnamep[ ]; ! 110: extern int maxregvar; ! 111: extern int highregvar; ! 112: extern int nregvar; ! 113: ! 114: extern chainp templist; ! 115: extern int maxdim; ! 116: extern chainp holdtemps; ! 117: extern struct Entrypoint *entries; ! 118: extern struct Rplblock *rpllist; ! 119: extern struct Chain *curdtp; ! 120: extern ftnint curdtelt; ! 121: extern flag toomanyinit; ! 122: ! 123: extern flag inioctl; ! 124: extern int iostmt; ! 125: extern Addrp ioblkp; ! 126: extern int nioctl; ! 127: extern int nequiv; ! 128: extern int eqvstart; /* offset to eqv number to guarantee uniqueness */ ! 129: extern int nintnames; ! 130: ! 131: #ifdef SDB ! 132: extern int dbglabel; ! 133: extern flag sdbflag; ! 134: #endif ! 135: ! 136: struct Chain ! 137: { ! 138: chainp nextp; ! 139: tagptr datap; ! 140: }; ! 141: ! 142: extern chainp chains; ! 143: ! 144: struct Headblock ! 145: { ! 146: field tag; ! 147: field vtype; ! 148: field vclass; ! 149: field vstg; ! 150: expptr vleng; ! 151: } ; ! 152: ! 153: struct Ctlframe ! 154: { ! 155: unsigned ctltype:8; ! 156: unsigned dostepsign:8; ! 157: int ctlabels[4]; ! 158: int dolabel; ! 159: Namep donamep; ! 160: expptr domax; ! 161: expptr dostep; ! 162: }; ! 163: #define endlabel ctlabels[0] ! 164: #define elselabel ctlabels[1] ! 165: #define dobodylabel ctlabels[1] ! 166: #define doposlabel ctlabels[2] ! 167: #define doneglabel ctlabels[3] ! 168: extern struct Ctlframe *ctls; ! 169: extern struct Ctlframe *ctlstack; ! 170: extern struct Ctlframe *lastctl; ! 171: ! 172: struct Comvar { ! 173: struct Comvar *next; ! 174: char *name, *tyid; ! 175: int type; ! 176: ftnint offset, nelt; ! 177: }; ! 178: ! 179: struct Extsym ! 180: { ! 181: char extname[XL]; ! 182: field extstg; ! 183: unsigned extsave:1; ! 184: unsigned extinit:1; ! 185: chainp extp; ! 186: struct Comvar *cv; ! 187: ftnint extleng; ! 188: ftnint maxleng; ! 189: }; ! 190: ! 191: extern struct Extsym *extsymtab; ! 192: extern struct Extsym *nextext; ! 193: extern struct Extsym *lastext; ! 194: extern int complex_seen, dcomplex_seen; ! 195: ! 196: struct Labelblock ! 197: { ! 198: int labelno; ! 199: unsigned blklevel:8; ! 200: unsigned labused:1; ! 201: unsigned labinacc:1; ! 202: unsigned labdefined:1; ! 203: unsigned labtype:2; ! 204: ftnint stateno; ! 205: }; ! 206: ! 207: extern struct Labelblock *labeltab; ! 208: extern struct Labelblock *labtabend; ! 209: extern struct Labelblock *highlabtab; ! 210: ! 211: struct Entrypoint ! 212: { ! 213: struct Entrypoint *entnextp; ! 214: struct Extsym *entryname; ! 215: chainp arglist; ! 216: int entrylabel; ! 217: int typelabel; ! 218: Namep enamep; ! 219: }; ! 220: ! 221: struct Primblock ! 222: { ! 223: field tag; ! 224: field vtype; ! 225: Namep namep; ! 226: struct Listblock *argsp; ! 227: expptr fcharp; ! 228: expptr lcharp; ! 229: }; ! 230: ! 231: ! 232: struct Hashentry ! 233: { ! 234: int hashval; ! 235: Namep varp; ! 236: }; ! 237: extern struct Hashentry *hashtab; ! 238: extern struct Hashentry *lasthash; ! 239: ! 240: struct Intrpacked /* bits for intrinsic function description */ ! 241: { ! 242: unsigned f1:3; ! 243: unsigned f2:4; ! 244: unsigned f3:7; ! 245: }; ! 246: ! 247: struct Nameblock ! 248: { ! 249: field tag; ! 250: field vtype; ! 251: field vclass; ! 252: field vstg; ! 253: expptr vleng; ! 254: char varname[VL]; ! 255: unsigned vdovar:1; ! 256: unsigned vdcldone:1; ! 257: unsigned vadjdim:1; ! 258: unsigned vsave:1; ! 259: unsigned vprocclass:3; ! 260: unsigned vregno:4; ! 261: unsigned vimpldovar:1; ! 262: union { ! 263: int varno; ! 264: struct Intrpacked intrdesc; /* bits for intrinsic function*/ ! 265: } vardesc; ! 266: struct Dimblock *vdim; ! 267: ftnint voffset; ! 268: union { ! 269: chainp namelist; /* points to chain of names in */ ! 270: chainp vstfdesc; /* points to (formals, expr) pair */ ! 271: } varxptr; ! 272: int nlmemno; /* for namelist */ ! 273: }; ! 274: ! 275: ! 276: struct Paramblock ! 277: { ! 278: field tag; ! 279: field vtype; ! 280: field vclass; ! 281: field vstg; ! 282: expptr vleng; ! 283: char varname[VL]; ! 284: expptr paramval; ! 285: } ; ! 286: ! 287: ! 288: struct Exprblock ! 289: { ! 290: field tag; ! 291: field vtype; ! 292: field vclass; ! 293: field vstg; ! 294: expptr vleng; ! 295: unsigned opcode:6; ! 296: expptr leftp; ! 297: expptr rightp; ! 298: }; ! 299: ! 300: ! 301: union Constant ! 302: { ! 303: char *ccp; ! 304: ftnint ci; ! 305: double cd[2]; ! 306: }; ! 307: ! 308: struct Constblock ! 309: { ! 310: field tag; ! 311: field vtype; ! 312: field vclass; ! 313: field vstg; ! 314: expptr vleng; ! 315: union Constant Const; ! 316: }; ! 317: ! 318: ! 319: struct Listblock ! 320: { ! 321: field tag; ! 322: field vtype; ! 323: chainp listp; ! 324: }; ! 325: ! 326: ! 327: ! 328: struct Addrblock ! 329: { ! 330: field tag; ! 331: field vtype; ! 332: field vclass; ! 333: field vstg; ! 334: expptr vleng; ! 335: int memno; ! 336: expptr memoffset; ! 337: unsigned istemp:1; ! 338: unsigned ntempelt:10; ! 339: ftnint varleng; ! 340: }; ! 341: ! 342: ! 343: ! 344: struct Errorblock ! 345: { ! 346: field tag; ! 347: field vtype; ! 348: }; ! 349: ! 350: ! 351: union Expression ! 352: { ! 353: field tag; ! 354: struct Headblock headblock; ! 355: struct Exprblock exprblock; ! 356: struct Addrblock addrblock; ! 357: struct Constblock constblock; ! 358: struct Errorblock errorblock; ! 359: struct Listblock listblock; ! 360: struct Primblock primblock; ! 361: } ; ! 362: ! 363: ! 364: ! 365: struct Dimblock ! 366: { ! 367: int ndim; ! 368: expptr nelt; ! 369: expptr baseoffset; ! 370: expptr basexpr; ! 371: struct ! 372: { ! 373: expptr dimsize; ! 374: expptr dimexpr; ! 375: } dims[1]; ! 376: }; ! 377: ! 378: ! 379: struct Impldoblock ! 380: { ! 381: field tag; ! 382: unsigned isactive:1; ! 383: unsigned isbusy:1; ! 384: Namep varnp; ! 385: Constp varvp; ! 386: chainp impdospec; ! 387: expptr implb; ! 388: expptr impub; ! 389: expptr impstep; ! 390: ftnint impdiff; ! 391: ftnint implim; ! 392: struct Chain *datalist; ! 393: }; ! 394: ! 395: ! 396: struct Rplblock /* name replacement block */ ! 397: { ! 398: struct Rplblock *rplnextp; ! 399: Namep rplnp; ! 400: expptr rplvp; ! 401: expptr rplxp; ! 402: int rpltag; ! 403: }; ! 404: ! 405: ! 406: ! 407: struct Equivblock ! 408: { ! 409: struct Eqvchain *equivs; ! 410: flag eqvinit; ! 411: #ifdef SDB ! 412: int comno; ! 413: #endif ! 414: long int eqvtop; ! 415: long int eqvbottom; ! 416: } ; ! 417: #define eqvleng eqvtop ! 418: ! 419: extern struct Equivblock *eqvclass; ! 420: ! 421: ! 422: struct Eqvchain ! 423: { ! 424: struct Eqvchain *eqvnextp; ! 425: union ! 426: { ! 427: struct Primblock *eqvlhs; ! 428: Namep eqvname; ! 429: } eqvitem; ! 430: long int eqvoffset; ! 431: } ; ! 432: ! 433: ! 434: union Taggedblock ! 435: { ! 436: field tag; ! 437: struct Headblock headblock; ! 438: struct Nameblock nameblock; ! 439: struct Paramblock paramblock; ! 440: struct Exprblock exprblock; ! 441: struct Constblock constblock; ! 442: struct Listblock listblock; ! 443: struct Addrblock addrblock; ! 444: struct Errorblock errorblock; ! 445: struct Primblock primblock; ! 446: struct Impldoblock impldoblock; ! 447: } ; ! 448: ! 449: ! 450: ! 451: ! 452: struct Literal ! 453: { ! 454: short littype; ! 455: short litnum; ! 456: union { ! 457: ftnint litival; ! 458: double litdval; ! 459: struct { ! 460: char litclen; /* small integer */ ! 461: char litcstr[XL]; ! 462: } litcval; ! 463: } litval; ! 464: }; ! 465: ! 466: extern struct Literal litpool[ ]; ! 467: extern int nliterals; ! 468: ! 469: ! 470: ! 471: /* popular functions with non integer return values */ ! 472: ! 473: ! 474: int *ckalloc(); ! 475: char *varstr(), *nounder(), *varunder(); ! 476: char *copyn(), *copys(); ! 477: chainp hookup(), mkchain(); ! 478: ftnint convci(); ! 479: char *convic(); ! 480: char *setdoto(); ! 481: double convcd(); ! 482: Namep mkname(); ! 483: struct Labelblock *mklabel(), *execlab(); ! 484: struct Extsym *mkext(), *newentry(); ! 485: expptr addrof(), call1(), call2(), call3(), call4(); ! 486: Addrp builtin(), mktemp(), mktmpn(), autovar(); ! 487: Addrp mkplace(), mkaddr(), putconst(), memversion(); ! 488: expptr mkprim(), mklhs(), mkexpr(), mkconv(), mkfunct(), fixexpr(), fixtype(); ! 489: expptr errnode(), mkintcon(); ! 490: tagptr cpexpr(); ! 491: ftnint lmin(), lmax(), iarrlen(); ! 492: extern int bugwarn;
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.