xref: /original-bsd/usr.bin/pascal/src/main.c (revision 1eec400c)
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.7 03/31/82";
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('g') = opt('p') = opt('t') = opt('b') = 1;
98 	    while (argc > 0) {
99 		    cp = argv[0];
100 		    if (*cp++ != '-')
101 			    break;
102 		    while (c = *cp++) switch (c) {
103 #ifdef DEBUG
104 			    case 'k':
105 			    case 'r':
106 			    case 'y':
107 				    togopt(c);
108 				    continue;
109 			    case 'K':
110 				    yycosts();
111 				    pexit(NOSTART);
112 			    case 'A':
113 				    testtrace = TRUE;
114 			    case 'F':
115 				    fulltrace = TRUE;
116 			    case 'E':
117 				    errtrace = TRUE;
118 				    opt('r')++;
119 				    continue;
120 			    case 'U':
121 				    yyunique = 0;
122 				    continue;
123 #endif
124 			    case 'b':
125 				    opt('b') = 2;
126 				    continue;
127 			    case 'i':
128 				    pflist = argv + 1;
129 				    pflstc = 0;
130 				    while (argc > 1) {
131 					    if (dotted(argv[1], 'p'))
132 						    break;
133 					    pflstc++, argc--, argv++;
134 				    }
135 				    if (pflstc == 0)
136 					    goto usage;
137 				    continue;
138 			    case 'g':
139 			    case 'l':
140 			    case 'n':
141 			    case 'p':
142 			    case 's':
143 			    case 't':
144 			    case 'u':
145 			    case 'w':
146 				    togopt(c);
147 				    continue;
148 			    case 'z':
149 				    monflg = TRUE;
150 				    continue;
151 			    default:
152     usage:
153 				    Perror( "Usage", usageis);
154 				    pexit(NOSTART);
155 		    }
156 		    argc--, argv++;
157 	    }
158 #	endif OBJ
159 #	ifdef PC
160 	    opt( 'b' ) = 1;
161 	    opt( 'g' ) = 0;
162 	    opt( 't' ) = 0;
163 	    opt( 'p' ) = 0;
164 	    usageis = pcusage;
165 	    while ( argc > 0 ) {
166 		cp = argv[0];
167 		if ( *cp++ != '-' ) {
168 		    break;
169 		}
170 		c = *cp++;
171 		switch( c ) {
172 #ifdef DEBUG
173 		    case 'k':
174 		    case 'r':
175 		    case 'y':
176 			    togopt(c);
177 			    break;
178 		    case 'K':
179 			    yycosts();
180 			    pexit(NOSTART);
181 		    case 'A':
182 			    testtrace = TRUE;
183 			    /* and fall through */
184 		    case 'F':
185 			    fulltrace = TRUE;
186 			    /* and fall through */
187 		    case 'E':
188 			    errtrace = TRUE;
189 			    opt('r')++;
190 			    break;
191 		    case 'U':
192 			    yyunique = 0;
193 			    break;
194 #endif
195 		    case 'b':
196 			    opt('b') = 2;
197 			    break;
198 		    case 'i':
199 			    pflist = argv + 1;
200 			    pflstc = 0;
201 			    while (argc > 1) {
202 				    if (dotted(argv[1], 'p'))
203 					    break;
204 				    pflstc++, argc--, argv++;
205 			    }
206 			    if (pflstc == 0)
207 				    goto usage;
208 			    break;
209 			/*
210 			 *	output file for the first pass
211 			 */
212 		    case 'o':
213 			    if ( argc < 2 ) {
214 				goto usage;
215 			    }
216 			    argv++;
217 			    argc--;
218 			    pcname = argv[0];
219 			    break;
220 		    case 'C':
221 				/*
222 				 * since -t is an ld switch, use -C
223 				 * to turn on tests
224 				 */
225 			    togopt( 't' );
226 			    break;
227 		    case 'g':
228 				/*
229 				 *	sdb symbol table
230 				 */
231 			    togopt( 'g' );
232 			    break;
233 		    case 'l':
234 		    case 's':
235 		    case 'u':
236 		    case 'w':
237 			    togopt(c);
238 			    break;
239 		    case 'p':
240 				/*
241 				 *	-p on the command line means profile
242 				 */
243 			    profflag = TRUE;
244 			    break;
245 		    case 'z':
246 			    monflg = TRUE;
247 			    break;
248 		    default:
249 usage:
250 			    Perror( "Usage", usageis);
251 			    pexit(NOSTART);
252 		}
253 		argc--;
254 		argv++;
255 	    }
256 #	endif PC
257 	if (argc != 1)
258 		goto usage;
259 	efil = open ( err_file, 0 );
260 	if ( efil < 0 )
261 		perror(err_file), pexit(NOSTART);
262 	filename = argv[0];
263 	if (!dotted(filename, 'p')) {
264 		Perror(filename, "Name must end in '.p'");
265 		pexit(NOSTART);
266 	}
267 	close(0);
268 	if ( ( ibuf = fopen( filename , "r" ) ) == NULL )
269 		perror(filename), pexit(NOSTART);
270 	ibp = ibuf;
271 #	ifdef PC
272 	    if ( ( pcstream = fopen( pcname , "w" ) ) == NULL ) {
273 		perror( pcname );
274 		pexit( NOSTART );
275 	    }
276 	    stabsource( filename );
277 #	endif PC
278 #	ifdef PTREE
279 #	    define	MAXpPAGES	16
280 	    if ( ! pCreate( pTreeName , MAXpPAGES ) ) {
281 		perror( pTreeName );
282 		pexit( NOSTART );
283 	    }
284 #	endif PTREE
285 	if ( signal( SIGINT , SIG_IGN ) != SIG_IGN )
286 		signal( SIGINT , onintr );
287 	if (opt('l')) {
288 		opt('n')++;
289 		yysetfile(filename);
290 		opt('n')--;
291 	}
292 	yymain();
293 	/* No return */
294 }
295 
296 pchr(c)
297 	char c;
298 {
299 
300 	putc ( c , stdout );
301 }
302 
303 char	ugh[]	= "Fatal error in pi\n";
304 /*
305  * Exit from the Pascal system.
306  * We throw in an ungraceful termination
307  * message if c > 1 indicating a severe
308  * error such as running out of memory
309  * or an internal inconsistency.
310  */
311 pexit(c)
312 	int c;
313 {
314 
315 	if (opt('l') && c != DIED && c != NOSTART)
316 		while (getline() != -1)
317 			continue;
318 	yyflush();
319 	switch (c) {
320 		case DIED:
321 			write(2, ugh, sizeof ugh);
322 		case NOSTART:
323 		case ERRS:
324 #			ifdef OBJ
325 			    if (ofil > 0)
326 				    unlink(obj);
327 			/*
328 			 * remove symbol table temp files
329 			 */
330 			    removenlfile();
331 
332 #			endif OBJ
333 #			ifdef PC
334 			    if ( pcstream != NULL ) {
335 				unlink( pcname );
336 			    }
337 #			endif PC
338 			break;
339 		case AOK:
340 #			ifdef OBJ
341 			    pflush();
342 			/*
343 			 * copy symbol table temp files to obj file
344 			 */
345 			    copynlfile();
346 
347 #			endif OBJ
348 #			ifdef PC
349 			    puteof();
350 #			endif PC
351 			break;
352 	}
353 	/*
354 	 *	this to gather statistics on programs being compiled
355 	 *	taken 20 june 79 	... peter
356 	 *
357 	 *  if (fork() == 0) {
358 	 *  	char *cp = "-0";
359 	 *  	cp[1] += c;
360 	 *  	execl("/usr/lib/gather", "gather", cp, filename, 0);
361 	 *  	exit(1);
362 	 *  }
363 	 */
364 #	ifdef PTREE
365 	    pFinish();
366 #	endif
367 	exit(c);
368 }
369 
370 onintr()
371 {
372 
373 	signal( SIGINT , SIG_IGN );
374 	pexit(NOSTART);
375 }
376 
377 /*
378  * Get an error message from the error message file
379  */
380 geterr(seekpt, buf)
381 	int seekpt;
382 	char *buf;
383 {
384 
385 	lseek(efil, (long) seekpt, 0);
386 	if (read(efil, buf, 256) <= 0)
387 		perror(err_file), pexit(DIED);
388 }
389 
390 header()
391 {
392 	extern char *version;
393 	static char anyheaders;
394 
395 	gettime( filename );
396 	if (anyheaders && opt('n'))
397 		putc( '\f' , stdout );
398 	anyheaders++;
399 #	ifdef OBJ
400 	    printf("Berkeley Pascal PI -- Version %s\n\n%s  %s\n\n",
401 		    version, myctime(&tvec), filename);
402 #	endif OBJ
403 #	ifdef PC
404 	    printf("Berkeley Pascal PC -- Version %s\n\n%s  %s\n\n",
405 		    version, myctime(&tvec), filename);
406 #	endif PC
407 }
408