![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to main.c CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [Research Unix] / researchv10no / cmd / f77|
Return to main.c CVS log | Up to [Research Unix] / researchv10no / cmd / f77 |
1.1 root 1: char xxxvers[] = "\n@(#) FORTRAN 77 PASS 1, VERSION 2.10.2, 27 JUNE 1989\n";
2: #define VER 0x5625 /* for pi; 8YMDD */
3:
4: #include "defs"
5: #include <signal.h>
6:
7: #ifdef SDB
8: # include <a.out.h>
9: # ifndef N_SO
10: # include <stab.h>
11: # endif
12:
13: int types3[] = { /* for supplying type to N_GSYM stab line */
14: 0, /* TYUNKNOWN */
15: 0, /* TYADDR */
16: 0100|3, /* TYSHORT */
17: 0100|5, /* TYLONG */
18: 0100|6, /* TYREAL */
19: 0100|7, /* TYDREAL */
20: 0100|16, /* TYCOMPLEX */
21: 0100|16, /* TYDCOMPLEX */
22: 0100|4, /* TYLOGICAL */
23: 0100|16, /* TYCHAR */
24: 0100|4, /* TYSUBR */
25: 0 /* TYERROR */
26: };
27:
28: int complex_seen, dcomplex_seen;
29: #endif
30:
31: LOCAL clfiles();
32: LOCAL FILEP opf();
33:
34: int bugwarn;
35:
36: main(argc, argv)
37: int argc;
38: char **argv;
39: {
40: char *s;
41: int k, retcode, *ip;
42: #if SDB
43: char elab[10];
44: int elnum;
45: #endif
46: void flovflo();
47:
48: #define DONE(c) { retcode = c; goto finis; }
49:
50: signal(SIGFPE, flovflo); /* catch overflows */
51:
52: #if HERE == PDP11
53: ldfps(01200); /* trap on overflow */
54: #endif
55:
56:
57:
58: --argc;
59: ++argv;
60:
61: while(argc>0 && argv[0][0]=='-')
62: {
63: for(s = argv[0]+1 ; *s ; ++s) switch(*s)
64: {
65: case 'w':
66: if(s[1]=='6' && s[2]=='6')
67: {
68: ftn66flag = YES;
69: s += 2;
70: }
71: else
72: nowarnflag = YES;
73: break;
74:
75: case 'U':
76: shiftcase = NO;
77: break;
78:
79: case 'u':
80: undeftype = YES;
81: break;
82:
83: case 'O':
84: optimflag = YES;
85: if( isdigit(s[1]) )
86: {
87: k = *++s - '0';
88: if(k > MAXREGVAR)
89: {
90: warn1("-O%d: too many register variables", k);
91: maxregvar = MAXREGVAR;
92: }
93: else
94: maxregvar = k;
95: }
96: break;
97:
98: case 'b':
99: bugwarn |= 1;
100: break;
101:
102: case 'B':
103: bugwarn |= 2;
104: break;
105:
106: case 'd':
107: debugflag = YES;
108: break;
109:
110: case 'p':
111: profileflag = YES;
112: break;
113:
114: case 'C':
115: checksubs = YES;
116: break;
117:
118: case '6':
119: no66flag = YES;
120: noextflag = YES;
121: break;
122:
123: case '1':
124: onetripflag = YES;
125: break;
126:
127: #ifdef SDB
128: case 'g':
129: sdbflag = YES;
130: break;
131: #endif
132:
133: case 'N':
134: switch(*++s)
135: {
136: case 'q':
137: ip = &maxequiv;
138: goto getnum;
139: case 'x':
140: ip = &maxext;
141: goto getnum;
142: case 's':
143: ip = &maxstno;
144: goto getnum;
145: case 'c':
146: ip = &maxctl;
147: goto getnum;
148: case 'n':
149: ip = &maxhash;
150: goto getnum;
151:
152: default:
153: fatali("invalid flag -N%c", *s);
154: }
155: getnum:
156: k = 0;
157: while( isdigit(*++s) )
158: k = 10*k + (*s - '0');
159: if(k <= 0)
160: fatal("Table size too small");
161: *ip = k;
162: break;
163:
164: case 'I':
165: if(*++s == '2') {
166: tyint = TYSHORT;
167: #ifdef SDB
168: types3[TYLOGICAL] = 0100|3;
169: #endif
170: }
171: else if(*s == '4')
172: {
173: shortsubs = NO;
174: tyint = TYLONG;
175: #ifdef SDB
176: types3[TYLOGICAL] = 0100|4;
177: #endif
178: }
179: else if(*s == 's')
180: shortsubs = YES;
181: else
182: fatali("invalid flag -I%c\n", *s);
183: tylogical = tyint;
184: break;
185:
186: default:
187: fatali("invalid flag %c\n", *s);
188: }
189: --argc;
190: ++argv;
191: }
192:
193: if(argc != 4)
194: fatali("arg count %d", argc);
195: asmfile = opf(argv[1]);
196: initfile = opf(argv[2]);
197: textfile = opf(argv[3]);
198:
199: initkey();
200: if(inilex( copys(argv[0]) ))
201: DONE(1);
202: fprintf(diagfile, "%s:\n", argv[0]);
203:
204: #ifdef SDB
205: #ifndef UCBPASS2
206: for(s = argv[0] ; ; s += 8)
207: {
208: prstab(s,N_SO,0,0);
209: if( strlen(s) < 8 )
210: break;
211: }
212: #else
213: prstab(argv[0],N_SO,0,0);
214: #endif
215: prstab("vaxf77",N_VER,VER,0);
216: #endif
217:
218: fileinit();
219: procinit();
220: if(k = yyparse())
221: {
222: fprintf(diagfile, "Bad parse, return code %d\n", k);
223: DONE(1);
224: }
225: if(nerr > 0)
226: DONE(1);
227: if(parstate != OUTSIDE)
228: {
229: warn("missing END statement");
230: endproc();
231: }
232: doext();
233: preven(ALIDOUBLE);
234: prtail();
235: #if SDB
236: if (sdbflag)
237: commstruct(); /* make commons appear to pi as global structs */
238: sprintf(elab, "L%d", elnum = newlabel());
239: putlabel(elnum);
240: prstab(argv[0],N_ESO,lineno,elab);
241: #endif
242: #if FAMILY==PCC
243: puteof();
244: #endif
245:
246: if(nerr > 0)
247: DONE(1);
248: DONE(0);
249:
250:
251: finis:
252: done(retcode);
253: return(retcode);
254: }
255:
256:
257:
258: done(k)
259: int k;
260: {
261: static int recurs = NO;
262:
263: if(recurs == NO)
264: {
265: recurs = YES;
266: clfiles();
267: }
268: exit(k);
269: }
270:
271:
272: LOCAL FILEP opf(fn)
273: char *fn;
274: {
275: FILEP fp;
276: if( fp = fopen(fn, "w") )
277: return(fp);
278:
279: fatalstr("cannot open intermediate file %s", fn);
280: /* NOTREACHED */
281: }
282:
283:
284:
285: LOCAL clfiles()
286: {
287: clf(&textfile);
288: clf(&asmfile);
289: clf(&initfile);
290: }
291:
292:
293: clf(p)
294: FILEP *p;
295: {
296: if(p!=NULL && *p!=NULL && *p!=stdout)
297: {
298: if(ferror(*p))
299: fatal("writing error");
300: fclose(*p);
301: }
302: *p = NULL;
303: }
304:
305:
306:
307:
308: void
309: flovflo()
310: {
311: err("floating exception during constant evaluation");
312: #if HERE == VAX
313: fatal("vax cannot recover from floating exception");
314: /* vax returns a reserved operand that generates
315: an illegal operand fault on next instruction,
316: which if ignored causes an infinite loop.
317: */
318: #endif
319: signal(SIGFPE, flovflo);
320: }
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.