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