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