|
|
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 Extsym ! 169: { ! 170: char extname[XL]; ! 171: field extstg; ! 172: unsigned extsave:1; ! 173: unsigned extinit:1; ! 174: chainp extp; ! 175: ftnint extleng; ! 176: ftnint maxleng; ! 177: }; ! 178: ! 179: extern struct Extsym *extsymtab; ! 180: extern struct Extsym *nextext; ! 181: extern struct Extsym *lastext; ! 182: ! 183: struct Labelblock ! 184: { ! 185: int labelno; ! 186: unsigned blklevel:8; ! 187: unsigned labused:1; ! 188: unsigned labinacc:1; ! 189: unsigned labdefined:1; ! 190: unsigned labtype:2; ! 191: ftnint stateno; ! 192: }; ! 193: ! 194: extern struct Labelblock *labeltab; ! 195: extern struct Labelblock *labtabend; ! 196: extern struct Labelblock *highlabtab; ! 197: ! 198: struct Entrypoint ! 199: { ! 200: struct Entrypoint *entnextp; ! 201: struct Extsym *entryname; ! 202: chainp arglist; ! 203: int entrylabel; ! 204: int typelabel; ! 205: Namep enamep; ! 206: }; ! 207: ! 208: struct Primblock ! 209: { ! 210: field tag; ! 211: field vtype; ! 212: Namep namep; ! 213: struct Listblock *argsp; ! 214: expptr fcharp; ! 215: expptr lcharp; ! 216: }; ! 217: ! 218: ! 219: struct Hashentry ! 220: { ! 221: int hashval; ! 222: Namep varp; ! 223: }; ! 224: extern struct Hashentry *hashtab; ! 225: extern struct Hashentry *lasthash; ! 226: ! 227: struct Intrpacked /* bits for intrinsic function description */ ! 228: { ! 229: unsigned f1:3; ! 230: unsigned f2:4; ! 231: unsigned f3:7; ! 232: }; ! 233: ! 234: struct Nameblock ! 235: { ! 236: field tag; ! 237: field vtype; ! 238: field vclass; ! 239: field vstg; ! 240: expptr vleng; ! 241: char varname[VL]; ! 242: unsigned vdovar:1; ! 243: unsigned vdcldone:1; ! 244: unsigned vadjdim:1; ! 245: unsigned vsave:1; ! 246: unsigned vprocclass:3; ! 247: unsigned vregno:4; ! 248: union { ! 249: int varno; ! 250: struct Intrpacked intrdesc; /* bits for intrinsic function*/ ! 251: } vardesc; ! 252: struct Dimblock *vdim; ! 253: ftnint voffset; ! 254: union { ! 255: chainp namelist; /* points to chain of names in */ ! 256: chainp vstfdesc; /* points to (formals, expr) pair */ ! 257: } varxptr; ! 258: }; ! 259: ! 260: ! 261: struct Paramblock ! 262: { ! 263: field tag; ! 264: field vtype; ! 265: field vclass; ! 266: field vstg; ! 267: expptr vleng; ! 268: char varname[VL]; ! 269: expptr paramval; ! 270: } ; ! 271: ! 272: ! 273: struct Exprblock ! 274: { ! 275: field tag; ! 276: field vtype; ! 277: field vclass; ! 278: field vstg; ! 279: expptr vleng; ! 280: unsigned opcode:6; ! 281: expptr leftp; ! 282: expptr rightp; ! 283: }; ! 284: ! 285: ! 286: union Constant ! 287: { ! 288: char *ccp; ! 289: ftnint ci; ! 290: double cd[2]; ! 291: }; ! 292: ! 293: struct Constblock ! 294: { ! 295: field tag; ! 296: field vtype; ! 297: field vclass; ! 298: field vstg; ! 299: expptr vleng; ! 300: union Constant const; ! 301: }; ! 302: ! 303: ! 304: struct Listblock ! 305: { ! 306: field tag; ! 307: field vtype; ! 308: chainp listp; ! 309: }; ! 310: ! 311: ! 312: ! 313: struct Addrblock ! 314: { ! 315: field tag; ! 316: field vtype; ! 317: field vclass; ! 318: field vstg; ! 319: expptr vleng; ! 320: int memno; ! 321: expptr memoffset; ! 322: unsigned istemp:1; ! 323: unsigned ntempelt:10; ! 324: ftnint varleng; ! 325: }; ! 326: ! 327: ! 328: ! 329: struct Errorblock ! 330: { ! 331: field tag; ! 332: field vtype; ! 333: }; ! 334: ! 335: ! 336: union Expression ! 337: { ! 338: field tag; ! 339: struct Headblock headblock; ! 340: struct Exprblock exprblock; ! 341: struct Addrblock addrblock; ! 342: struct Constblock constblock; ! 343: struct Errorblock errorblock; ! 344: struct Listblock listblock; ! 345: struct Primblock primblock; ! 346: } ; ! 347: ! 348: ! 349: ! 350: struct Dimblock ! 351: { ! 352: int ndim; ! 353: expptr nelt; ! 354: expptr baseoffset; ! 355: expptr basexpr; ! 356: struct ! 357: { ! 358: expptr dimsize; ! 359: expptr dimexpr; ! 360: } dims[1]; ! 361: }; ! 362: ! 363: ! 364: struct Impldoblock ! 365: { ! 366: field tag; ! 367: unsigned isactive:1; ! 368: unsigned isbusy:1; ! 369: Namep varnp; ! 370: Constp varvp; ! 371: chainp impdospec; ! 372: expptr implb; ! 373: expptr impub; ! 374: expptr impstep; ! 375: ftnint impdiff; ! 376: ftnint implim; ! 377: struct Chain *datalist; ! 378: }; ! 379: ! 380: ! 381: struct Rplblock /* name replacement block */ ! 382: { ! 383: struct Rplblock *rplnextp; ! 384: Namep rplnp; ! 385: expptr rplvp; ! 386: expptr rplxp; ! 387: int rpltag; ! 388: }; ! 389: ! 390: ! 391: ! 392: struct Equivblock ! 393: { ! 394: struct Eqvchain *equivs; ! 395: flag eqvinit; ! 396: long int eqvtop; ! 397: long int eqvbottom; ! 398: } ; ! 399: #define eqvleng eqvtop ! 400: ! 401: extern struct Equivblock *eqvclass; ! 402: ! 403: ! 404: struct Eqvchain ! 405: { ! 406: struct Eqvchain *eqvnextp; ! 407: union ! 408: { ! 409: struct Primblock *eqvlhs; ! 410: Namep eqvname; ! 411: } eqvitem; ! 412: long int eqvoffset; ! 413: } ; ! 414: ! 415: ! 416: union Taggedblock ! 417: { ! 418: field tag; ! 419: struct Headblock headblock; ! 420: struct Nameblock nameblock; ! 421: struct Paramblock paramblock; ! 422: struct Exprblock exprblock; ! 423: struct Constblock constblock; ! 424: struct Listblock listblock; ! 425: struct Addrblock addrblock; ! 426: struct Errorblock errorblock; ! 427: struct Primblock primblock; ! 428: struct Impldoblock impldoblock; ! 429: } ; ! 430: ! 431: ! 432: ! 433: ! 434: struct Literal ! 435: { ! 436: short littype; ! 437: short litnum; ! 438: union { ! 439: ftnint litival; ! 440: double litdval; ! 441: struct { ! 442: char litclen; /* small integer */ ! 443: char litcstr[XL]; ! 444: } litcval; ! 445: } litval; ! 446: }; ! 447: ! 448: extern struct Literal litpool[ ]; ! 449: extern int nliterals; ! 450: ! 451: ! 452: ! 453: /* popular functions with non integer return values */ ! 454: ! 455: ! 456: int *ckalloc(); ! 457: char *varstr(), *nounder(), *varunder(); ! 458: char *copyn(), *copys(); ! 459: chainp hookup(), mkchain(); ! 460: ftnint convci(); ! 461: char *convic(); ! 462: char *setdoto(); ! 463: double convcd(); ! 464: Namep mkname(); ! 465: struct Labelblock *mklabel(), *execlab(); ! 466: struct Extsym *mkext(), *newentry(); ! 467: expptr addrof(), call1(), call2(), call3(), call4(); ! 468: Addrp builtin(), mktemp(), mktmpn(), autovar(); ! 469: Addrp mkplace(), mkaddr(), putconst(), memversion(); ! 470: expptr mkprim(), mklhs(), mkexpr(), mkconv(), mkfunct(), fixexpr(), fixtype(); ! 471: expptr errnode(), mkintcon(); ! 472: tagptr cpexpr(); ! 473: ftnint lmin(), lmax(), iarrlen();
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.