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