|
|
1.1 ! root 1: char *xxxvers[] = "\n@(#) FORTRAN 77 PASS 1, VERSION 2.10, 16 AUGUST 1980\n"; ! 2: ! 3: #include "defs" ! 4: #include <signal.h> ! 5: ! 6: #ifdef SDB ! 7: # include <a.out.h> ! 8: # ifndef N_SO ! 9: # include <stab.h> ! 10: # endif ! 11: #endif ! 12: ! 13: ! 14: main(argc, argv) ! 15: int argc; ! 16: char **argv; ! 17: { ! 18: char *s; ! 19: int k, retcode, *ip; ! 20: FILEP opf(); ! 21: int flovflo(); ! 22: ! 23: #define DONE(c) { retcode = c; goto finis; } ! 24: ! 25: signal(SIGFPE, flovflo); /* catch overflows */ ! 26: ! 27: #if HERE == PDP11 ! 28: ldfps(01200); /* trap on overflow */ ! 29: #endif ! 30: ! 31: ! 32: ! 33: --argc; ! 34: ++argv; ! 35: ! 36: while(argc>0 && argv[0][0]=='-') ! 37: { ! 38: for(s = argv[0]+1 ; *s ; ++s) switch(*s) ! 39: { ! 40: case 'w': ! 41: if(s[1]=='6' && s[2]=='6') ! 42: { ! 43: ftn66flag = YES; ! 44: s += 2; ! 45: } ! 46: else ! 47: nowarnflag = YES; ! 48: break; ! 49: ! 50: case 'U': ! 51: shiftcase = NO; ! 52: break; ! 53: ! 54: case 'u': ! 55: undeftype = YES; ! 56: break; ! 57: ! 58: case 'O': ! 59: optimflag = YES; ! 60: if( isdigit(s[1]) ) ! 61: { ! 62: k = *++s - '0'; ! 63: if(k > MAXREGVAR) ! 64: { ! 65: warn1("-O%d: too many register variables", k); ! 66: maxregvar = MAXREGVAR; ! 67: } ! 68: else ! 69: maxregvar = k; ! 70: } ! 71: break; ! 72: ! 73: case 'd': ! 74: debugflag = YES; ! 75: break; ! 76: ! 77: case 'p': ! 78: profileflag = YES; ! 79: break; ! 80: ! 81: case 'C': ! 82: checksubs = YES; ! 83: break; ! 84: ! 85: case '6': ! 86: no66flag = YES; ! 87: noextflag = YES; ! 88: break; ! 89: ! 90: case '1': ! 91: onetripflag = YES; ! 92: break; ! 93: ! 94: #ifdef SDB ! 95: case 'g': ! 96: sdbflag = YES; ! 97: break; ! 98: #endif ! 99: ! 100: case 'N': ! 101: switch(*++s) ! 102: { ! 103: case 'q': ! 104: ip = &maxequiv; goto getnum; ! 105: case 'x': ! 106: ip = &maxext; goto getnum; ! 107: case 's': ! 108: ip = &maxstno; goto getnum; ! 109: case 'c': ! 110: ip = &maxctl; goto getnum; ! 111: case 'n': ! 112: ip = &maxhash; goto getnum; ! 113: ! 114: default: ! 115: fatali("invalid flag -N%c", *s); ! 116: } ! 117: getnum: ! 118: k = 0; ! 119: while( isdigit(*++s) ) ! 120: k = 10*k + (*s - '0'); ! 121: if(k <= 0) ! 122: fatal("Table size too small"); ! 123: *ip = k; ! 124: break; ! 125: ! 126: case 'I': ! 127: if(*++s == '2') ! 128: tyint = TYSHORT; ! 129: else if(*s == '4') ! 130: { ! 131: shortsubs = NO; ! 132: tyint = TYLONG; ! 133: } ! 134: else if(*s == 's') ! 135: shortsubs = YES; ! 136: else ! 137: fatali("invalid flag -I%c\n", *s); ! 138: tylogical = tyint; ! 139: break; ! 140: ! 141: default: ! 142: fatali("invalid flag %c\n", *s); ! 143: } ! 144: --argc; ! 145: ++argv; ! 146: } ! 147: ! 148: if(argc != 4) ! 149: fatali("arg count %d", argc); ! 150: asmfile = opf(argv[1]); ! 151: initfile = opf(argv[2]); ! 152: textfile = opf(argv[3]); ! 153: ! 154: initkey(); ! 155: if(inilex( copys(argv[0]) )) ! 156: DONE(1); ! 157: fprintf(diagfile, "%s:\n", argv[0]); ! 158: ! 159: #ifdef SDB ! 160: for(s = argv[0] ; ; s += 8) ! 161: { ! 162: prstab(s,N_SO,0,0); ! 163: if( strlen(s) < 8 ) ! 164: break; ! 165: } ! 166: #endif ! 167: ! 168: fileinit(); ! 169: procinit(); ! 170: if(k = yyparse()) ! 171: { ! 172: fprintf(diagfile, "Bad parse, return code %d\n", k); ! 173: DONE(1); ! 174: } ! 175: if(nerr > 0) ! 176: DONE(1); ! 177: if(parstate != OUTSIDE) ! 178: { ! 179: warn("missing END statement"); ! 180: endproc(); ! 181: } ! 182: doext(); ! 183: preven(ALIDOUBLE); ! 184: prtail(); ! 185: #if FAMILY==PCC ! 186: puteof(); ! 187: #endif ! 188: ! 189: if(nerr > 0) ! 190: DONE(1); ! 191: DONE(0); ! 192: ! 193: ! 194: finis: ! 195: done(retcode); ! 196: return(retcode); ! 197: } ! 198: ! 199: ! 200: ! 201: done(k) ! 202: int k; ! 203: { ! 204: static int recurs = NO; ! 205: ! 206: if(recurs == NO) ! 207: { ! 208: recurs = YES; ! 209: clfiles(); ! 210: } ! 211: exit(k); ! 212: } ! 213: ! 214: ! 215: LOCAL FILEP opf(fn) ! 216: char *fn; ! 217: { ! 218: FILEP fp; ! 219: if( fp = fopen(fn, "w") ) ! 220: return(fp); ! 221: ! 222: fatalstr("cannot open intermediate file %s", fn); ! 223: /* NOTREACHED */ ! 224: } ! 225: ! 226: ! 227: ! 228: LOCAL clfiles() ! 229: { ! 230: clf(&textfile); ! 231: clf(&asmfile); ! 232: clf(&initfile); ! 233: } ! 234: ! 235: ! 236: clf(p) ! 237: FILEP *p; ! 238: { ! 239: if(p!=NULL && *p!=NULL && *p!=stdout) ! 240: { ! 241: if(ferror(*p)) ! 242: fatal("writing error"); ! 243: fclose(*p); ! 244: } ! 245: *p = NULL; ! 246: } ! 247: ! 248: ! 249: ! 250: ! 251: flovflo() ! 252: { ! 253: err("floating exception during constant evaluation"); ! 254: #if HERE == VAX ! 255: fatal("vax cannot recover from floating exception"); ! 256: /* vax returns a reserved operand that generates ! 257: an illegal operand fault on next instruction, ! 258: which if ignored causes an infinite loop. ! 259: */ ! 260: #endif ! 261: signal(SIGFPE, flovflo); ! 262: }
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.