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