xref: /original-bsd/usr.bin/f77/pass1.vax/main.c (revision b9df2d9d) 
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 
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 
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 
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 
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 
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 
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 
359 intexit()
360 {
361   done(1);
362 }
363