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