|
|
1.1 ! root 1: #include "stddef.h" ! 2: #ifndef BUFSIZ ! 3: #include "stdio.h" ! 4: #endif ! 5: #if 0 ! 6: typedef struct _iobuf FILE; ! 7: typedef int YYTYPE; ! 8: #endif ! 9: ! 10: #define NO 0 ! 11: #define YES 1 ! 12: ! 13: #define CNULL (char *) 0 ! 14: #define PNULL (ptr) 0 ! 15: #define CHNULL (chainp) 0 ! 16: ! 17: #define HASHEDTABLE 1 ! 18: ! 19: #define XL 6 ! 20: ! 21: #define NFTNTYPES 7 ! 22: #define NEFLTYPES 13 ! 23: ! 24: #define MEMSIZE 20000 ! 25: #define YYMAXDEPTH 250 ! 26: ! 27: #define MAXSTNO 200 ! 28: #define MAXINCLUDEDEPTH 10 ! 29: #define MAXBLOCKDEPTH 30 ! 30: #define MAXINDIFS 150 ! 31: #define MAXFTNAMES 500 ! 32: #define MAXEFLNAMES 500 ! 33: #define MAXSWITCH 100 ! 34: ! 35: #define EXECPOOL 20 ! 36: #define EXPRPOOL 40 ! 37: ! 38: #define NAMESPERLINE 6 ! 39: ! 40: #define LINESPACES 66 ! 41: #define INDENTSPACES 3 ! 42: ! 43: typedef int *ptr; ! 44: ! 45: extern struct chain ! 46: { ! 47: ptr nextp; ! 48: ptr datap; ! 49: } ; ! 50: ! 51: typedef struct chain *chainp; ! 52: ! 53: extern int yylineno; ! 54: extern int dumpic; ! 55: extern int memdump; ! 56: extern int dbgflag; ! 57: extern int nowarnflag; ! 58: extern int nocommentflag; ! 59: extern int verbose; ! 60: extern int dumpcore; ! 61: #define TEST if(dbgflag) ! 62: #define efgetc (efmacp?*efmacp++:getc(yyin)) ! 63: extern char msg[]; ! 64: ! 65: #define UNIX 1 ! 66: #define GCOS 2 ! 67: #define GCOSBCD 3 ! 68: #define CRAY 4 ! 69: #define IBM 5 ! 70: ! 71: #define FIELDMAX 32768. ! 72: ! 73: #define ALLOC(x) (struct x *) intalloc(sizeof(struct x)) ! 74: ! 75: extern FILE *diagfile; ! 76: extern FILE *codefile; ! 77: extern FILE *yyin; ! 78: extern FILE *fileptrs[]; ! 79: extern char *filenames[]; ! 80: extern char *basefile; ! 81: extern int filelines[]; ! 82: extern int filedepth; ! 83: extern char *efmacp; ! 84: extern char *filemacs[]; ! 85: extern int pushchars[]; ! 86: ! 87: extern struct fileblock *iifilep; ! 88: ! 89: extern int mem[]; ! 90: extern unsigned int nmemused; ! 91: extern long int totfreed; ! 92: extern long int totalloc; ! 93: ! 94: extern int nhid[]; ! 95: extern int ndecl[]; ! 96: ! 97: extern int indifs[]; ! 98: extern int nxtindif; ! 99: extern int afterif; ! 100: ! 101: extern neflnames; ! 102: ! 103: extern int nftnch; ! 104: extern int nftncont; ! 105: ! 106: extern char ftnames[MAXFTNAMES][7]; ! 107: extern int nftnames; ! 108: extern int nftnm0; ! 109: extern int impltype[]; ! 110: extern int ftnmask[]; ! 111: ! 112: extern double fieldmax; ! 113: extern int ftnefl[]; ! 114: extern int eflftn[]; ! 115: ! 116: extern ptr thisexec; ! 117: extern ptr thisctl; ! 118: extern int pushlex; ! 119: extern int igeol; ! 120: extern int ateof; ! 121: extern int eofneed; ! 122: extern int forcerr; ! 123: extern int comneed; ! 124: extern int optneed; ! 125: extern int defneed; ! 126: extern int lettneed; ! 127: extern int iobrlevel; ! 128: ! 129: extern int prevbg; ! 130: ! 131: extern chainp hidlist; ! 132: extern chainp commonlist; ! 133: extern chainp tempvarlist; ! 134: extern chainp temptypelist; ! 135: extern chainp gonelist; ! 136: extern int blklevel; ! 137: extern int ctllevel; ! 138: extern int dclsect; ! 139: extern int instruct; ! 140: extern int inbound; ! 141: extern int inproc; ! 142: ! 143: extern int ncases; ! 144: extern ptr comments; ! 145: extern ptr prevcomments; ! 146: extern ptr genequivs; ! 147: extern ptr arrays; ! 148: extern ptr generlist; ! 149: extern ptr knownlist; ! 150: ! 151: extern int graal; ! 152: extern ptr procname; ! 153: extern int procclass; ! 154: extern ptr thisargs; ! 155: ! 156: extern int langopt; ! 157: extern int dotsopt; ! 158: extern int dbgopt; ! 159: extern int dbglevel; ! 160: ! 161: extern int stnos[]; ! 162: extern int nxtstno; ! 163: extern int constno; ! 164: extern int labno; ! 165: extern int nerrs; ! 166: extern int nbad; ! 167: extern int nwarns; ! 168: ! 169: struct headbits ! 170: { ! 171: unsigned int tag:8; ! 172: unsigned int subtype:8; ! 173: unsigned int blklevel:8; ! 174: }; ! 175: ! 176: extern struct fileblock ! 177: { ! 178: FILE *fileptr; ! 179: char filename[20]; ! 180: }; ! 181: ! 182: extern struct fileblock *ibfile; ! 183: extern struct fileblock *icfile; ! 184: extern struct fileblock *idfile; ! 185: extern struct fileblock *iefile; ! 186: ! 187: ! 188: extern struct comentry ! 189: { ! 190: struct headbits header; ! 191: char comname[7]; ! 192: long int comleng; ! 193: unsigned int cominit:2; ! 194: chainp comchain; ! 195: } ; ! 196: ! 197: extern struct stentry ! 198: { ! 199: struct headbits header; ! 200: char *namep; ! 201: ptr varp; ! 202: int hashval; ! 203: }; ! 204: ! 205: extern struct stentry *hashtab[]; ! 206: extern struct stentry **hashend; ! 207: ! 208: extern struct typeblock ! 209: { ! 210: struct headbits header; ! 211: ptr sthead; ! 212: ptr strdesc; ! 213: int stralign; ! 214: int strsize; ! 215: int basetypes; ! 216: } ; ! 217: ! 218: extern struct keyblock ! 219: { ! 220: struct headbits header; ! 221: ptr sthead; ! 222: } ; ! 223: ! 224: ! 225: extern struct varblock ! 226: { ! 227: struct headbits header; ! 228: ptr sthead; ! 229: ptr vinit; ! 230: unsigned int vadjdim:1; ! 231: unsigned int vdcldone:1; ! 232: unsigned int vdclstart:1; ! 233: unsigned int vnamedone:1; ! 234: unsigned int vprec:1; ! 235: unsigned int vext:1; ! 236: unsigned int vproc:2; ! 237: unsigned int needpar:1; ! 238: unsigned int vtype:4; ! 239: unsigned int vclass:3; ! 240: ptr vtypep; ! 241: ptr vdim; ! 242: ptr vsubs; ! 243: ptr voffset; ! 244: int vextbase; ! 245: int vbase[NFTNTYPES]; ! 246: } ; ! 247: ! 248: extern struct atblock ! 249: { ! 250: int atprec; ! 251: int attype; ! 252: int atext; ! 253: int atclass; ! 254: ptr attypep; ! 255: ptr atcommon; ! 256: ptr atdim; ! 257: } ; ! 258: ! 259: extern struct dimblock ! 260: { ! 261: ptr nextp; ! 262: ptr lowerb; ! 263: ptr upperb; ! 264: } ; ! 265: ! 266: extern struct exprblock /* must be same size as varblock */ ! 267: { ! 268: struct headbits header; ! 269: ptr leftp; ! 270: ptr rightp; ! 271: unsigned int vadjdim:1; ! 272: unsigned int vdcldone:1; ! 273: unsigned int vdclstart:1; ! 274: unsigned int vnamedone:1; ! 275: unsigned int vprec:1; ! 276: unsigned int vext:1; ! 277: unsigned int vproc:2; ! 278: unsigned int needpar:1; ! 279: unsigned int vtype:4; ! 280: unsigned int vclass:3; ! 281: ptr vtypep; ! 282: ptr vdim; ! 283: ptr vsubs; ! 284: ptr voffset; ! 285: int vextbase; ! 286: int vbase[NFTNTYPES]; ! 287: } ; ! 288: ! 289: ! 290: extern struct execblock ! 291: { ! 292: struct headbits header; ! 293: ptr temps; ! 294: int labelno; ! 295: unsigned int uniffable:1; ! 296: unsigned int brnchend:1; ! 297: unsigned int labeled:1; ! 298: unsigned int copylab:1; ! 299: unsigned int labdefined:1; ! 300: unsigned int labused:1; ! 301: unsigned int labinacc:1; ! 302: ptr execdesc; ! 303: ptr prevexec; ! 304: int nxtlabno; ! 305: int nftnst; ! 306: } ; ! 307: ! 308: ! 309: extern struct ctlblock /* must be same size as execblock */ ! 310: { ! 311: struct headbits header; ! 312: ptr loopvar; ! 313: ptr loopctl; ! 314: ptr prevctl; ! 315: int nextlab; ! 316: int breaklab; ! 317: int xlab; ! 318: int indifn; ! 319: } ; ! 320: ! 321: extern struct caseblock ! 322: { ! 323: struct headbits header; ! 324: ptr nextcase; ! 325: int labelno; ! 326: unsigned int uniffable:1; ! 327: unsigned int brnchend:1; ! 328: unsigned int labeled:1; ! 329: unsigned int copylab:1; ! 330: unsigned int labdefined:1; ! 331: unsigned int labused:1; ! 332: unsigned int labinacc:1; ! 333: ptr casexpr; ! 334: } ; ! 335: ! 336: extern struct labelblock ! 337: { ! 338: struct headbits header; ! 339: ptr sthead; ! 340: int labelno; ! 341: unsigned int uniffable:1; ! 342: unsigned int brnchend:1; ! 343: unsigned int labeled:1; ! 344: unsigned int copylab:1; ! 345: unsigned int labdefined:1; ! 346: unsigned int labused:1; ! 347: unsigned int labinacc:1; ! 348: } ; ! 349: ! 350: extern struct defblock ! 351: { ! 352: struct headbits header; ! 353: ptr sthead; ! 354: char *valp; ! 355: } ; ! 356: ! 357: extern struct doblock ! 358: { ! 359: struct headbits header; ! 360: ptr dovar; ! 361: ptr dopar[3]; ! 362: } ; ! 363: ! 364: extern struct fieldspec ! 365: { ! 366: struct headbits header; ! 367: ptr flbound; ! 368: ptr frange; ! 369: ptr frshift; ! 370: int fanymore; ! 371: } ; ! 372: ! 373: ! 374: extern struct genblock ! 375: { ! 376: struct headbits header; ! 377: ptr nextgenf; ! 378: char *genname; ! 379: char *genfname[NEFLTYPES]; ! 380: int genftype[NEFLTYPES]; ! 381: } ; ! 382: ! 383: ! 384: extern struct knownname ! 385: { ! 386: struct headbits header; ! 387: ptr nextfunct; ! 388: char *funcname; ! 389: int functype; ! 390: } ; ! 391: ! 392: extern struct iostblock ! 393: { ! 394: struct headbits header; ! 395: ptr leftp; /* padding */ ! 396: ptr right; /* padding */ ! 397: unsigned int vadjdim:1; ! 398: unsigned int vdcldone:1; ! 399: unsigned int vdclstart:1; ! 400: unsigned int vnamedone:1; ! 401: unsigned int vprec:1; ! 402: unsigned int vext:1; ! 403: unsigned int vproc:2; ! 404: unsigned int needpar:1; ! 405: unsigned int vtype:4; ! 406: unsigned int vclass:3; ! 407: int iokwd; ! 408: ptr iounit; ! 409: ptr iolist; ! 410: int iojunk[7]; /* padding */ ! 411: } ; ! 412: ! 413: extern struct ioitem ! 414: { ! 415: struct headbits header; ! 416: ptr ioexpr; ! 417: char *iofmt; ! 418: int nrep; ! 419: } ; ! 420: ! 421: ! 422: struct iogroup ! 423: { ! 424: struct headbits header; ! 425: struct doblock *doptr; ! 426: char *iofmt; ! 427: int nrep; ! 428: ptr ioitems; ! 429: }; ! 430: ! 431: ! 432: extern struct tailoring ! 433: { ! 434: int ftnsys; ! 435: int errmode; ! 436: int charcomp; ! 437: int ftnin; ! 438: int ftnout; ! 439: int ftncontnu; ! 440: char *procheader; ! 441: char *lngcxtype; ! 442: char *lngcxprefix; ! 443: int ftnchwd; ! 444: int ftnsize[NFTNTYPES]; ! 445: int ftnalign[NFTNTYPES]; ! 446: char *dfltfmt[NEFLTYPES]; ! 447: int hollincall; ! 448: int deltastno; ! 449: int dclintrinsics; ! 450: int ftn77; ! 451: } tailor; ! 452: ! 453: ! 454: struct system ! 455: { ! 456: char *sysname; ! 457: short sysno; ! 458: short chperwd; ! 459: short idig; ! 460: short rdig; ! 461: short ddig; ! 462: }; ! 463: ! 464: extern struct system systab[]; ! 465: ! 466: ! 467: ! 468: ! 469: ! 470: /* Declarations of popular functions */ ! 471: ! 472: char *copys(), *convic(), *procnm(); ! 473: ptr cpexpr(), compconst(), simple(), mknode(), mkint(), mkconst(); ! 474: ptr intalloc(), calloc(), allexcblock(), allexpblock(); ! 475: ptr mkcall(), coerce(), fold(), builtin(), gent(), errnode(); ! 476: ptr arg1(), arg2(), arg4(); ! 477: struct stentry *name(); ! 478: chainp mkchain(), hookup(); ! 479: ! 480: /*Block tags */ ! 481: ! 482: #define TAROP 1 ! 483: #define TASGNOP 2 ! 484: #define TLOGOP 3 ! 485: #define TRELOP 4 ! 486: #define TCALL 5 ! 487: #define TREPOP 6 ! 488: #define TLIST 7 ! 489: #define TCONST 8 ! 490: #define TNAME 9 ! 491: #define TERROR 10 ! 492: #define TCOMMON 11 ! 493: #define TSTRUCT 12 ! 494: #define TSTFUNCT 13 ! 495: #define TEXEC 14 ! 496: #define TTEMP 15 ! 497: #define TDEFINE 16 ! 498: #define TKEYWORD 17 ! 499: #define TLABEL 18 ! 500: #define TCASE 19 ! 501: #define TNOTOP 20 ! 502: #define TNEGOP 21 ! 503: #define TDOBLOCK 22 ! 504: #define TCONTROL 23 ! 505: #define TKNOWNFUNCT 24 ! 506: #define TFIELD 25 ! 507: #define TGENERIC 26 ! 508: #define TIOSTAT 27 ! 509: #define TIOGROUP 28 ! 510: #define TIOITEM 29 ! 511: #define TFTNBLOCK 30 ! 512: ! 513: /* Operator subtypes */ ! 514: ! 515: #define OPPLUS 1 ! 516: #define OPMINUS 2 ! 517: #define OPSTAR 3 ! 518: #define OPSLASH 4 ! 519: #define OPPOWER 5 ! 520: ! 521: #define OPNOT 6 ! 522: #define OPAND 7 ! 523: #define OP2AND 8 ! 524: #define OP2OR 9 ! 525: #define OPOR 10 ! 526: ! 527: #define OPEQ 11 ! 528: #define OPLT 12 ! 529: #define OPGT 13 ! 530: #define OPLE 14 ! 531: #define OPGE 15 ! 532: #define OPNE 16 ! 533: ! 534: #define OPLPAR 17 ! 535: #define OPRPAR 18 ! 536: #define OPEQUALS 19 ! 537: #define OPCOMMA 20 ! 538: ! 539: #define OPASGN 0 ! 540: #define OPREL 0 ! 541: ! 542: ! 543: /* Simplification types */ ! 544: ! 545: #define LVAL 1 ! 546: #define RVAL 2 ! 547: #define SUBVAL 3 ! 548: #define IFVAL 4 ! 549: ! 550: ! 551: /* Parser return values */ ! 552: ! 553: #define PARSERR 1 ! 554: #define PARSEOF 2 ! 555: #define PARSOPT 3 ! 556: #define PARSDCL 4 ! 557: #define PARSDEF 5 ! 558: #define PARSPROC 6 ! 559: ! 560: ! 561: /* Symbol table types */ ! 562: ! 563: #define TYUNDEFINED 0 ! 564: #define TYINT 1 ! 565: #define TYREAL 2 ! 566: #define TYLREAL 3 ! 567: #define TYLOG 4 ! 568: #define TYCOMPLEX 5 ! 569: #define TYLCOMPLEX 6 ! 570: #define TYCHAR 7 ! 571: #define TYSTRUCT 8 ! 572: #define TYLABEL 9 ! 573: #define TYSUBR 10 ! 574: #define TYFIELD 11 ! 575: #define TYHOLLERITH 12 ! 576: ! 577: ! 578: ! 579: /* Fortran types */ ! 580: ! 581: #define FTNINT 0 ! 582: #define FTNREAL 1 ! 583: #define FTNLOG 2 ! 584: #define FTNCOMPLEX 3 ! 585: #define FTNDOUBLE 4 ! 586: #define FTNCHAR 5 ! 587: #define FTNDCOMPLEX 6 ! 588: ! 589: ! 590: ! 591: /* symbol table classes */ ! 592: ! 593: #define CLUNDEFINED 0 ! 594: #define CLARG 1 ! 595: #define CLVALUE 2 ! 596: #define CLSTAT 3 ! 597: #define CLAUTO 4 ! 598: #define CLCOMMON 5 ! 599: #define CLMOS 6 ! 600: #define CLEXT 7 ! 601: ! 602: ! 603: /* values of vproc */ ! 604: ! 605: #define PROCUNKNOWN 0 ! 606: #define PROCNO 1 ! 607: #define PROCYES 2 ! 608: #define PROCINTRINSIC 3 ! 609: ! 610: /* values of procclass */ ! 611: ! 612: #define PRBLOCK 1 ! 613: #define PRMAIN 2 ! 614: #define PRSUBR 3 ! 615: #define PRFUNCT 4 ! 616: ! 617: ! 618: ! 619: /* ctlblock subtypes */ ! 620: ! 621: #define STNULL 1 ! 622: #define STIF 2 ! 623: #define STIFELSE 3 ! 624: #define STREPEAT 4 ! 625: #define STWHILE 5 ! 626: #define STFOR 6 ! 627: #define STDO 7 ! 628: #define STSWITCH 8 ! 629: #define STRETURN 9 ! 630: #define STGOTO 10 ! 631: #define STCALL 11 ! 632: #define STPROC 12 ! 633: ! 634: ! 635: ! 636: /* intermediate code definitions */ ! 637: ! 638: #define ICEOF 0 ! 639: #define ICBEGIN 1 ! 640: #define ICKEYWORD 2 ! 641: #define ICOP 3 ! 642: #define ICNAME 4 ! 643: #define ICCONST 5 ! 644: #define ICLABEL 6 ! 645: #define ICMARK 7 ! 646: #define ICINDENT 8 ! 647: #define ICCOMMENT 9 ! 648: #define ICINDPTR 10 ! 649: #define ICBLANK 11 ! 650: ! 651: #define FCONTINUE 2 ! 652: #define FCALL 3 ! 653: #define FDO 4 ! 654: #define FIF1 5 ! 655: #define FIF2 6 ! 656: #define FGOTO 7 ! 657: #define FRETURN 8 ! 658: #define FREAD 9 ! 659: #define FWRITE 10 ! 660: #define FFORMAT 11 ! 661: #define FSTOP 12 ! 662: #define FDATA 13 ! 663: #define FEQUIVALENCE 14 ! 664: #define FCOMMON 15 ! 665: #define FEXTERNAL 16 ! 666: #define FREWIND 17 ! 667: #define FBACKSPACE 18 ! 668: #define FENDFILE 19 ! 669: #define FSUBROUTINE 20 ! 670: #define FFUNCTION 21 ! 671: #define FPROGRAM 22 ! 672: #define FBLOCKDATA 23 ! 673: #define FEND 24 ! 674: ! 675: ! 676: /* I/O error handling options */ ! 677: ! 678: #define IOERRNONE 0 ! 679: #define IOERRIBM 1 ! 680: #define IOERRFORT77 2
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.