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