xref: /csrg-svn/usr.bin/pascal/src/main.c (revision 18449)
1 /* Copyright (c) 1979 Regents of the University of California */
2 
3 #ifndef lint
4 static	char copyright[] =
5 	    "@(#)Copyright (c) 1979 Regents of the University of California";
6 
7 static char sccsid[] = "@(#)main.c 2.3 03/20/85";
8 #endif
9 
10 #include "whoami.h"
11 #include "0.h"
12 #include "tree_ty.h"		/* must be included for yy.h */
13 #include "yy.h"
14 #include <signal.h>
15 #include "objfmt.h"
16 #include "config.h"
17 
18 /*
19  * This version of pi has been in use at Berkeley since May 1977
20  * and is very stable. Please report any problems with the error
21  * recovery to the second author at the address given in the file
22  * READ_ME.  The second author takes full responsibility for any bugs
23  * in the syntactic error recovery.
24  */
25 
26 char	piusage[]	= "pi [ -blnpstuw ] [ -i file ... ] name.p";
27 
28 char	*usageis	= piusage;
29 
30 #ifdef OBJ
31 
32 char	pixusage[]	= "pix [ -blnpstuw ] [ -i file ... ] name.p [ arg ... ]";
33 char	*obj	= "obj";
34 
35 #endif OBJ
36 
37 #ifdef PC
38 
39 char	*pcname = "pc.pc0";
40 char	pcusage[]	= "pc [ options ] [ -o file ] [ -i file ... ] name.p";
41 FILE	*pcstream = NULL;
42 
43 #endif PC
44 #ifdef PTREE
45     char	*pTreeName = "pi.pTree";
46 #endif PTREE
47 
48 int	onintr();
49 
50 extern	char *lastname;
51 
52 FILE	*ibuf;
53 
54 /*
55  * these are made real variables
56  * so they can be changed
57  * if you are compiling on a smaller machine
58  */
59 double	MAXINT	=  2147483647.;
60 double	MININT	= -2147483648.;
61 
62 /*
63  * Main program for pi.
64  * Process options, then call yymain
65  * to do all the real work.
66  */
67 main(argc, argv)
68 	int argc;
69 	char *argv[];
70 {
71 	register char *cp;
72 	register c;
73 	FILE *fopen();
74 	extern char *myctime();
75 	extern long lseek();
76 	int i;
77 
78 	if (argv[0][0] == 'a')
79 		err_file += err_pathlen , how_file += how_pathlen;
80 #	ifdef OBJ
81 	    if (argv[0][0] == '-' && argv[0][1] == 'o') {
82 		    obj = &argv[0][2];
83 		    usageis = pixusage;
84 		    how_file[strlen(how_file)] = 'x';
85 		    ofil = 3;
86 	    } else {
87 		    ofil = creat(obj, 0755);
88 		    if (ofil < 0) {
89 			    perror(obj);
90 			    pexit(NOSTART);
91 		    }
92 	    }
93 #	endif OBJ
94 	argv++, argc--;
95 	if (argc == 0) {
96 		i = fork();
97 		if (i == -1)
98 			goto usage;
99 		if (i == 0) {
100 			execl("/bin/cat", "cat", how_file, 0);
101 			goto usage;
102 		}
103 		while (wait(&i) != -1)
104 			continue;
105 		pexit(NOSTART);
106 	}
107 #	ifdef OBJ
108 	    opt('p') = opt('t') = opt('b') = 1;
109 #ifdef vax
110 	    /* pdx is currently supported only on the vax */
111 	    opt('g') = 1;
112 #endif vax
113 	    while (argc > 0) {
114 		    cp = argv[0];
115 		    if (*cp++ != '-')
116 			    break;
117 		    while (c = *cp++) switch (c) {
118 #ifdef DEBUG
119 			    case 'k':
120 			    case 'r':
121 			    case 'y':
122 				    togopt(c);
123 				    continue;
124 			    case 'K':
125 				    yycosts();
126 				    pexit(NOSTART);
127 			    case 'A':
128 				    testtrace = TRUE;
129 			    case 'F':
130 				    fulltrace = TRUE;
131 			    case 'E':
132 				    errtrace = TRUE;
133 				    opt('r')++;
134 				    continue;
135 			    case 'U':
136 				    yyunique = FALSE;
137 				    continue;
138 #endif
139 			    case 'b':
140 				    opt('b') = 2;
141 				    continue;
142 			    case 'i':
143 				    pflist = argv + 1;
144 				    pflstc = 0;
145 				    while (argc > 1) {
146 					    if (dotted(argv[1], 'p'))
147 						    break;
148 					    pflstc++, argc--, argv++;
149 				    }
150 				    if (pflstc == 0)
151 					    goto usage;
152 				    continue;
153 			    case 'g':
154 			    case 'l':
155 			    case 'n':
156 			    case 'p':
157 			    case 's':
158 			    case 't':
159 			    case 'u':
160 			    case 'w':
161 				    togopt(c);
162 				    continue;
163 			    case 'z':
164 				    monflg = TRUE;
165 				    continue;
166 			    case 'L':
167 				    togopt( 'L' );
168 				    continue;
169 			    default:
170     usage:
171 				    Perror( "Usage", usageis);
172 				    pexit(NOSTART);
173 		    }
174 		    argc--, argv++;
175 	    }
176 #	endif OBJ
177 #	ifdef PC
178 	    opt( 'b' ) = 1;
179 	    opt( 'g' ) = 0;
180 	    opt( 't' ) = 0;
181 	    opt( 'p' ) = 0;
182 	    usageis = pcusage;
183 	    while ( argc > 0 ) {
184 		cp = argv[0];
185 		if ( *cp++ != '-' ) {
186 		    break;
187 		}
188 		c = *cp++;
189 		switch( c ) {
190 #ifdef DEBUG
191 		    case 'k':
192 		    case 'r':
193 		    case 'y':
194 			    togopt(c);
195 			    break;
196 		    case 'K':
197 			    yycosts();
198 			    pexit(NOSTART);
199 		    case 'A':
200 			    testtrace = TRUE;
201 			    /* and fall through */
202 		    case 'F':
203 			    fulltrace = TRUE;
204 			    /* and fall through */
205 		    case 'E':
206 			    errtrace = TRUE;
207 			    opt('r')++;
208 			    break;
209 		    case 'U':
210 			    yyunique = FALSE;
211 			    break;
212 #endif
213 		    case 'b':
214 			    opt('b') = 2;
215 			    break;
216 		    case 'i':
217 			    pflist = argv + 1;
218 			    pflstc = 0;
219 			    while (argc > 1) {
220 				    if (dotted(argv[1], 'p'))
221 					    break;
222 				    pflstc++, argc--, argv++;
223 			    }
224 			    if (pflstc == 0)
225 				    goto usage;
226 			    break;
227 			/*
228 			 *	output file for the first pass
229 			 */
230 		    case 'o':
231 			    if ( argc < 2 ) {
232 				goto usage;
233 			    }
234 			    argv++;
235 			    argc--;
236 			    pcname = argv[0];
237 			    break;
238 		    case 'J':
239 			    togopt( 'J' );
240 			    break;
241 		    case 'C':
242 				/*
243 				 * since -t is an ld switch, use -C
244 				 * to turn on tests
245 				 */
246 			    togopt( 't' );
247 			    break;
248 		    case 'g':
249 				/*
250 				 *	sdb symbol table
251 				 */
252 			    togopt( 'g' );
253 			    break;
254 		    case 'l':
255 		    case 's':
256 		    case 'u':
257 		    case 'w':
258 			    togopt(c);
259 			    break;
260 		    case 'p':
261 				/*
262 				 *	-p on the command line means profile
263 				 */
264 			    profflag = TRUE;
265 			    break;
266 		    case 'z':
267 			    monflg = TRUE;
268 			    break;
269 		    case 'L':
270 			    togopt( 'L' );
271 			    break;
272 		    default:
273 usage:
274 			    Perror( "Usage", usageis);
275 			    pexit(NOSTART);
276 		}
277 		argc--;
278 		argv++;
279 	    }
280 #	endif PC
281 	if (argc != 1)
282 		goto usage;
283 	efil = open ( err_file, 0 );
284 	if ( efil < 0 )
285 		perror(err_file), pexit(NOSTART);
286 	filename = argv[0];
287 	if (!dotted(filename, 'p')) {
288 		Perror(filename, "Name must end in '.p'");
289 		pexit(NOSTART);
290 	}
291 	close(0);
292 	if ( ( ibuf = fopen( filename , "r" ) ) == NULL )
293 		perror(filename), pexit(NOSTART);
294 	ibp = ibuf;
295 #	ifdef PC
296 	    if ( ( pcstream = fopen( pcname , "w" ) ) == NULL ) {
297 		perror( pcname );
298 		pexit( NOSTART );
299 	    }
300 	    stabsource( filename, TRUE );
301 #	endif PC
302 #	ifdef PTREE
303 #	    define	MAXpPAGES	16
304 	    if ( ! pCreate( pTreeName , MAXpPAGES ) ) {
305 		perror( pTreeName );
306 		pexit( NOSTART );
307 	    }
308 #	endif PTREE
309 	if ( signal( SIGINT , SIG_IGN ) != SIG_IGN )
310 		(void) signal( SIGINT , onintr );
311 	if (opt('l')) {
312 		opt('n')++;
313 		yysetfile(filename);
314 		opt('n')--;
315 	}
316 	yymain();
317 	/* No return */
318 }
319 
320 pchr(c)
321 	char c;
322 {
323 
324 	putc ( c , stdout );
325 }
326 
327 #ifdef PC
328 char	ugh[]	= "Fatal error in pc\n";
329 #endif
330 #ifdef OBJ
331 char	ugh[]	= "Fatal error in pi\n";
332 #endif
333 /*
334  * Exit from the Pascal system.
335  * We throw in an ungraceful termination
336  * message if c > 1 indicating a severe
337  * error such as running out of memory
338  * or an internal inconsistency.
339  */
340 pexit(c)
341 	int c;
342 {
343 
344 	if (opt('l') && c != DIED && c != NOSTART)
345 		while (getline() != -1)
346 			continue;
347 	yyflush();
348 	switch (c) {
349 		case DIED:
350 			write(2, ugh, sizeof ugh);
351 		case NOSTART:
352 		case ERRS:
353 #			ifdef OBJ
354 			    if (ofil > 0)
355 				    unlink(obj);
356 			/*
357 			 * remove symbol table temp files
358 			 */
359 			    removenlfile();
360 
361 #			endif OBJ
362 #			ifdef PC
363 			    if ( pcstream != NULL ) {
364 				unlink( pcname );
365 			    }
366 #			endif PC
367 			break;
368 		case AOK:
369 #			ifdef OBJ
370 			    pflush();
371 			/*
372 			 * copy symbol table temp files to obj file
373 			 */
374 			    copynlfile();
375 
376 #			endif OBJ
377 #			ifdef PC
378 			    puteof();
379 #			endif PC
380 			break;
381 	}
382 	/*
383 	 *	this to gather statistics on programs being compiled
384 	 *	taken 20 june 79 	... peter
385 	 *
386 	 *  if (fork() == 0) {
387 	 *  	char *cp = "-0";
388 	 *  	cp[1] += c;
389 	 *  	execl("/usr/lib/gather", "gather", cp, filename, 0);
390 	 *  	exit(1);
391 	 *  }
392 	 */
393 #	ifdef PTREE
394 	    pFinish();
395 #	endif
396 	exit(c);
397 }
398 
399 onintr()
400 {
401 
402 	(void) signal( SIGINT , SIG_IGN );
403 	pexit(NOSTART);
404 }
405 
406 /*
407  * Get an error message from the error message file
408  */
409 geterr(seekpt, buf)
410 	int seekpt;
411 	char *buf;
412 {
413 
414 	(void) lseek(efil, (long) seekpt, 0);
415 	if (read(efil, buf, 256) <= 0)
416 		perror(err_file), pexit(DIED);
417 }
418 
419 header()
420 {
421 	extern char *version;
422 	static char anyheaders;
423 
424 	gettime( filename );
425 	if (anyheaders && opt('n'))
426 		putc( '\f' , stdout );
427 	anyheaders++;
428 #	ifdef OBJ
429 	    printf("Berkeley Pascal PI -- Version %s\n\n%s  %s\n\n",
430 		    version, myctime((int *) (&tvec)), filename);
431 #	endif OBJ
432 #	ifdef PC
433 	    printf("Berkeley Pascal PC -- Version %s\n\n%s  %s\n\n",
434 		    version, myctime((int *) (&tvec)), filename);
435 #	endif PC
436 }
437