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