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