|
|
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: #ifndef UCBPASS2
161: for(s = argv[0] ; ; s += 8)
162: {
163: prstab(s,N_SO,0,0);
164: if( strlen(s) < 8 )
165: break;
166: }
167: #else
168: prstab(argv[0],N_SO,0,0);
169: #endif
170: #endif
171:
172: fileinit();
173: procinit();
174: if(k = yyparse())
175: {
176: fprintf(diagfile, "Bad parse, return code %d\n", k);
177: DONE(1);
178: }
179: if(nerr > 0)
180: DONE(1);
181: if(parstate != OUTSIDE)
182: {
183: warn("missing END statement");
184: endproc();
185: }
186: doext();
187: preven(ALIDOUBLE);
188: prtail();
189: #if FAMILY==PCC
190: puteof();
191: #endif
192:
193: if(nerr > 0)
194: DONE(1);
195: DONE(0);
196:
197:
198: finis:
199: done(retcode);
200: return(retcode);
201: }
202:
203:
204:
205: done(k)
206: int k;
207: {
208: static int recurs = NO;
209:
210: if(recurs == NO)
211: {
212: recurs = YES;
213: clfiles();
214: }
215: exit(k);
216: }
217:
218:
219: LOCAL FILEP opf(fn)
220: char *fn;
221: {
222: FILEP fp;
223: if( fp = fopen(fn, "w") )
224: return(fp);
225:
226: fatalstr("cannot open intermediate file %s", fn);
227: /* NOTREACHED */
228: }
229:
230:
231:
232: LOCAL clfiles()
233: {
234: clf(&textfile);
235: clf(&asmfile);
236: clf(&initfile);
237: }
238:
239:
240: clf(p)
241: FILEP *p;
242: {
243: if(p!=NULL && *p!=NULL && *p!=stdout)
244: {
245: if(ferror(*p))
246: fatal("writing error");
247: fclose(*p);
248: }
249: *p = NULL;
250: }
251:
252:
253:
254:
255: flovflo()
256: {
257: err("floating exception during constant evaluation");
258: #if HERE == VAX
259: fatal("vax cannot recover from floating exception");
260: /* vax returns a reserved operand that generates
261: an illegal operand fault on next instruction,
262: which if ignored causes an infinite loop.
263: */
264: #endif
265: signal(SIGFPE, flovflo);
266: }
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.