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