|
|
1.1 root 1: /*
2: * Copyright (c) 1980 Regents of the University of California.
3: * All rights reserved. The Berkeley software License Agreement
4: * specifies the terms and conditions for redistribution.
5: */
6:
7: #ifndef lint
8: char copyright[] =
9: "@(#) Copyright (c) 1980 Regents of the University of California.\n\
10: All rights reserved.\n";
11: #endif not lint
12:
13: #ifndef lint
14: static char sccsid[] = "@(#)main.c 5.1 (Berkeley) 6/7/85";
15: #endif not lint
16:
17: /*
18: * main.c
19: *
20: * Main routine for the f77 compiler, pass 1, 4.2 BSD.
21: *
22: * University of Utah CS Dept modification history:
23: *
24: * $Log: main.c,v $
25: * Revision 3.2 85/01/14 04:21:31 donn
26: * Added changes to implement Jerry's '-q' option.
27: *
28: * Revision 3.1 84/10/29 05:47:03 donn
29: * Added Jerry Berkman's change to line buffer stderr.
30: *
31: */
32:
33: char *xxxvers[] = "\n@(#) FORTRAN 77 PASS 1, VERSION 2.10, 16 AUGUST 1980\n";
34:
35: #include "defs.h"
36: #include <signal.h>
37:
38: #ifdef SDB
39: # include <a.out.h>
40: # ifndef N_SO
41: # include <stab.h>
42: # endif
43: #endif
44:
45:
46: LOCAL char *textname = "";
47: LOCAL char *asmname = "";
48: LOCAL char *initname = "";
49:
50:
51: extern intexit();
52:
53: flag namesflag = YES;
54:
55:
56:
57: main(argc, argv)
58: int argc;
59: char **argv;
60: {
61: char *s;
62: int k, retcode, *ip;
63: FILEP opf();
64: int flovflo();
65:
66: #define DONE(c) { retcode = c; goto finis; }
67:
68: signal(SIGFPE, flovflo); /* catch overflows */
69: signal(SIGINT, intexit);
70:
71: #if HERE == PDP11
72: ldfps(01200); /* trap on overflow */
73: #endif
74:
75:
76: setlinebuf(diagfile);
77:
78: --argc;
79: ++argv;
80:
81: while(argc>0 && argv[0][0]=='-')
82: {
83: for(s = argv[0]+1 ; *s ; ++s) switch(*s)
84: {
85: case 'w':
86: if(s[1]=='6' && s[2]=='6')
87: {
88: ftn66flag = YES;
89: s += 2;
90: }
91: else
92: nowarnflag = YES;
93: break;
94:
95: case 'U':
96: shiftcase = NO;
97: break;
98:
99: case 'u':
100: undeftype = YES;
101: break;
102:
103: case 'O':
104: optimflag = YES;
105: break;
106:
107: case 'd':
108: debugflag[0] = YES;
109:
110: while (*s == 'd' || *s == ',')
111: {
112: k = 0;
113: while( isdigit(*++s) )
114: k = 10*k + (*s - '0');
115: if(k < 0 || k >= MAXDEBUGFLAG)
116: fatali("bad debug number %d",k);
117: debugflag[k] = YES;
118: }
119: break;
120:
121: case 'p':
122: profileflag = YES;
123: break;
124:
125: case 'C':
126: checksubs = YES;
127: break;
128:
129: case '6':
130: no66flag = YES;
131: noextflag = YES;
132: break;
133:
134: case '1':
135: onetripflag = YES;
136: break;
137:
138: #ifdef SDB
139: case 'g':
140: sdbflag = YES;
141: break;
142: #endif
143:
144: case 'q':
145: namesflag = NO;
146: break;
147:
148: case 'N':
149: switch(*++s)
150: {
151: case 'q':
152: ip = &maxequiv; goto getnum;
153: case 'x':
154: ip = &maxext; goto getnum;
155: case 's':
156: ip = &maxstno; goto getnum;
157: case 'c':
158: ip = &maxctl; goto getnum;
159: case 'n':
160: ip = &maxhash; goto getnum;
161:
162: default:
163: fatali("invalid flag -N%c", *s);
164: }
165: getnum:
166: k = 0;
167: while( isdigit(*++s) )
168: k = 10*k + (*s - '0');
169: if(k <= 0)
170: fatal("Table size too small");
171: *ip = k;
172: break;
173:
174: case 'i':
175: if(*++s == '2')
176: tyint = TYSHORT;
177: else if(*s == '4')
178: {
179: shortsubs = NO;
180: tyint = TYLONG;
181: }
182: else if(*s == 's')
183: shortsubs = YES;
184: else
185: fatali("invalid flag -i%c\n", *s);
186: tylogical = tyint;
187: break;
188:
189: default:
190: fatali("invalid flag %c\n", *s);
191: }
192: --argc;
193: ++argv;
194: }
195:
196: if(argc != 4)
197: fatali("arg count %d", argc);
198: textname = argv[3];
199: initname = argv[2];
200: asmname = argv[1];
201: asmfile = opf(argv[1]);
202: initfile = opf(argv[2]);
203: textfile = opf(argv[3]);
204:
205: initkey();
206: if(inilex( copys(argv[0]) ))
207: DONE(1);
208: if(namesflag == YES)
209: fprintf(diagfile, "%s:\n", argv[0]);
210:
211: #ifdef SDB
212: filenamestab(argv[0]);
213: #endif
214:
215: fileinit();
216: procinit();
217: if(k = yyparse())
218: {
219: fprintf(diagfile, "Bad parse, return code %d\n", k);
220: DONE(1);
221: }
222: if(nerr > 0)
223: DONE(1);
224: if(parstate != OUTSIDE)
225: {
226: warn("missing END statement");
227: endproc();
228: }
229: doext();
230: preven(ALIDOUBLE);
231: prtail();
232: #if FAMILY==PCC
233: puteof();
234: #endif
235:
236: if(nerr > 0)
237: DONE(1);
238: DONE(0);
239:
240:
241: finis:
242: done(retcode);
243: }
244:
245:
246:
247: done(k)
248: int k;
249: {
250: static char *ioerror = "i/o error on intermediate file %s\n";
251:
252: if (textfile != NULL && textfile != stdout)
253: {
254: if (ferror(textfile))
255: {
256: fprintf(diagfile, ioerror, textname);
257: k = 3;
258: }
259: fclose(textfile);
260: }
261:
262: if (asmfile != NULL && asmfile != stdout)
263: {
264: if (ferror(asmfile))
265: {
266: fprintf(diagfile, ioerror, asmname);
267: k = 3;
268: }
269: fclose(asmfile);
270: }
271:
272: if (initfile != NULL && initfile != stdout)
273: {
274: if (ferror(initfile))
275: {
276: fprintf(diagfile, ioerror, initname);
277: k = 3;
278: }
279: fclose(initfile);
280: }
281:
282: rmtmpfiles();
283:
284: exit(k);
285: }
286:
287:
288: LOCAL FILEP opf(fn)
289: char *fn;
290: {
291: FILEP fp;
292: if( fp = fopen(fn, "w") )
293: return(fp);
294:
295: fatalstr("cannot open intermediate file %s", fn);
296: /* NOTREACHED */
297: }
298:
299:
300:
301: clf(p)
302: FILEP *p;
303: {
304: if(p!=NULL && *p!=NULL && *p!=stdout)
305: {
306: if(ferror(*p))
307: fatal("writing error");
308: fclose(*p);
309: }
310: *p = NULL;
311: }
312:
313:
314:
315:
316: flovflo()
317: {
318: err("floating exception during constant evaluation");
319: #if HERE == VAX
320: fatal("vax cannot recover from floating exception");
321: rmtmpfiles();
322: /* vax returns a reserved operand that generates
323: an illegal operand fault on next instruction,
324: which if ignored causes an infinite loop.
325: */
326: #endif
327: signal(SIGFPE, flovflo);
328: }
329:
330:
331:
332: rmtmpfiles()
333: {
334: close(vdatafile);
335: unlink(vdatafname);
336: close(vchkfile);
337: unlink(vchkfname);
338: close(cdatafile);
339: unlink(cdatafname);
340: close(cchkfile);
341: unlink(cchkfname);
342: }
343:
344:
345:
346: intexit()
347: {
348: done(1);
349: }
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.