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