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