xref: /csrg-svn/usr.bin/pascal/pxp/main.c (revision 22232)
12858Speter /*
2*22232Sdist  * Copyright (c) 1980 Regents of the University of California.
3*22232Sdist  * All rights reserved.  The Berkeley software License Agreement
4*22232Sdist  * specifies the terms and conditions for redistribution.
5*22232Sdist  */
6*22232Sdist 
7*22232Sdist #ifndef lint
8*22232Sdist char copyright[] =
9*22232Sdist "@(#) Copyright (c) 1980 Regents of the University of California.\n\
10*22232Sdist  All rights reserved.\n";
11*22232Sdist #endif not lint
12*22232Sdist 
13*22232Sdist #ifndef lint
14*22232Sdist static char sccsid[] = "@(#)main.c	5.1 (Berkeley) 06/05/85";
15*22232Sdist #endif not lint
16*22232Sdist 
17*22232Sdist /*
182858Speter  * pxp - Pascal execution profiler
192858Speter  *
202858Speter  * Bill Joy UCB
212858Speter  * Version 1.2 January 1979
222858Speter  */
232858Speter 
242858Speter #include "0.h"
252858Speter 
262858Speter /*
272858Speter  * This program is described in detail in the "PXP 1.0 Implementation Notes"
282858Speter  *
292858Speter  * The structure of pxp is very similar to that of the translator pi.
302858Speter  * The major new pieces here are a set of profile data maintenance
312858Speter  * routines in the file pmon.c and a set of pretty printing utility
322858Speter  * routines in the file pp.c.
332858Speter  * The semantic routines of pi have been rewritten to do a simple
342858Speter  * reformatting tree walk, the parsing and scanning remains
352858Speter  * the same.
362858Speter  *
372858Speter  * This version does not place more than one statement per line and
382858Speter  * is not very intelligent about folding long lines, with only
392858Speter  * an ad hoc way of folding case label list and enumerated type
402858Speter  * declarations being implemented.
412858Speter  */
422858Speter 
432858Speter char	usagestr[] =
442858Speter 	"pxp [ -acdefjntuw_ ] [ -23456789 ] [ -z [ name ... ] ] name.p";
452858Speter char	*howfile =	"/usr/lib/how_pxp";
462858Speter char	*stdoutn =	"Standard output";
472858Speter 
482858Speter int	unit =	4;
492858Speter 
502858Speter FILE	*ibuf;
512858Speter extern	char errout;
522858Speter 
532858Speter /*
542858Speter  * Main program for pxp.
552858Speter  * Process options, then call yymain
562858Speter  * to do all the real work.
572858Speter  */
582858Speter FILE *ibp;
592858Speter main(argc, argv)
602858Speter 	int argc;
612858Speter 	char *argv[];
622858Speter {
632858Speter 	register char *cp;
642858Speter 	register c;
652858Speter 
662858Speter 	if (argv[0][0] == 'a')
672858Speter 		howfile =+ 9;
682858Speter 	argc--, argv++;
692858Speter 	if (argc == 0) {
702858Speter 		execl("/bin/cat", "cat", howfile, 0);
712858Speter 		goto usage;
722858Speter 	}
732858Speter 	while (argc > 0) {
742858Speter 		cp = argv[0];
752858Speter 		if (*cp++ != '-')
762858Speter 			break;
772858Speter 		while (c = *cp++) switch (c) {
782858Speter #ifdef DEBUG
792858Speter 			case 'T':
802858Speter 				typetest++;
812858Speter 				continue;
822858Speter 			case 'A':
832858Speter 				testtrace++;
842858Speter 			case 'F':
852858Speter 				fulltrace++;
862858Speter 			case 'E':
872858Speter 				errtrace++;
882858Speter 				continue;
892858Speter 			case 'C':
902858Speter 				yycosts();
912858Speter 				pexit(NOSTART);
922858Speter 			case 'U':
932858Speter 				yyunique++;
942858Speter 				continue;
952858Speter #endif
962858Speter 			case 'a':
972858Speter 				all++;
982858Speter 				continue;
992858Speter 			case 'c':
1002858Speter 				core++;
1012858Speter 				continue;
1022858Speter 			case 'd':
1032858Speter 				nodecl++;
1042858Speter 				continue;
1052858Speter 			case 'e':
1062858Speter 				noinclude = -1;
1072858Speter 				continue;
1082858Speter 			case 'f':
1092858Speter 				full++;
1102858Speter 				continue;
1112858Speter 			case 'j':
1122858Speter 				justify++;
1132858Speter 				continue;
1142858Speter 			case 'l':
1152858Speter 			case 'n':
1162858Speter 				togopt(c);
1172858Speter 				continue;
1182858Speter 			case 'o':
1192858Speter 				onefile++;
1202858Speter 				continue;
1212858Speter 			case 's':
1222858Speter 				stripcomm++;
1232858Speter 				continue;
1242858Speter 			case 't':
1252858Speter 				table++;
1262858Speter 				continue;
1272858Speter 			case 'u':
1282858Speter 			case 'w':
1292858Speter 				togopt(c);
1302858Speter 				continue;
1312858Speter 			case 'z':
1322858Speter 				profile++;
1332858Speter 				pflist = argv + 1;
1342858Speter 				pflstc = 0;
1352858Speter 				while (argc > 1) {
1362858Speter 					if (dotted(argv[1], 'p'))
1372858Speter 						break;
1382858Speter 					pflstc++, argc--, argv++;
1392858Speter 				}
1402858Speter 				if (pflstc == 0)
1412858Speter 					togopt(c);
1422858Speter 				else
1432858Speter 					nojunk++;
1442858Speter 				continue;
1452858Speter 			case '_':
1462858Speter 				underline++;
1472858Speter 				continue;
14812411Speter #			ifdef RMOTHERS
14912411Speter 			case 'O':
15012411Speter 				rmothers++;
15112411Speter 				continue;
15212411Speter #			endif RMOTHERS
1532858Speter 			default:
1542858Speter 				if (c >= '2' && c <= '9') {
1552858Speter 					unit = c - '0';
1562858Speter 					continue;
1572858Speter 				}
1582858Speter usage:
1592858Speter 				Perror("Usage", usagestr);
1602858Speter 				exit(1);
1612858Speter 		}
1622858Speter 		argc--, argv++;
1632858Speter 	}
1642858Speter 	if (core && !profile && !table)
1652858Speter 		profile++;
1662858Speter 	if (argc == 0 || argc > 2)
1672858Speter 		goto usage;
1682858Speter 	if (profile || table) {
1692858Speter 		noinclude = 0;
1702858Speter 		if (argc == 2) {
1712858Speter 			argc--;
1722858Speter 			getit(argv[1]);
1732858Speter 		} else
1742858Speter 			getit(core ? "core" : "pmon.out");
1752858Speter 	} else
1762858Speter 		noinclude++;
1772858Speter 	if (argc != 1)
1782858Speter 		goto usage;
1792858Speter 	firstname = filename = argv[0];
1802858Speter 	if (dotted(filename, 'i')) {
1812858Speter 		if (profile || table)
1822858Speter 			goto usage;
1832858Speter 		noinclude = 1;
1842858Speter 		bracket++;
1852858Speter 	} else if (!dotted(filename, 'p')) {
1862858Speter 		Perror(filename, "Name must end in '.p'");
1872858Speter 		exit(1);
1882858Speter 	}
1892858Speter 	if ((ibuf = fopen(filename, "r")) == NULL)
1902858Speter 		perror(filename), pexit(NOSTART);
1912858Speter 	ibp = ibuf;
1922858Speter 	if (onefile) {
1932858Speter 		int onintr();
1942858Speter 
1952858Speter 		cp = (stdoutn = "/tmp/pxp00000") + 13;
1962858Speter 		signal(2, onintr);
1972858Speter 		for (c = getpid(); c; c =/ 10)
1982858Speter 			*--cp =| (c % 10);
1992858Speter 		if (freopen(stdoutn, "w", stdout) == NULL)
2002858Speter bad:
2012858Speter 			perror(stdoutn), exit(1);
2022858Speter 	} else {
2032858Speter 		extern char _sobuf[BUFSIZ];
2042858Speter 		setbuf(stdout, _sobuf);
2052858Speter 	}
2062858Speter 	if (profile || opt('l')) {
2072858Speter 		opt('n')++;
2082858Speter 		yysetfile(filename);
2092858Speter 		opt('n')--;
2102858Speter 	} else
2112858Speter 		lastname = filename;
2122858Speter 	errout = 2;
2132858Speter 	yymain();
2142858Speter 	/* No return */
2152858Speter }
2162858Speter 
2172858Speter /*
2182858Speter  * Put a header on a top of a page
2192858Speter  */
2202858Speter header()
2212858Speter {
2222858Speter 	extern char version[];
2232858Speter 	static char reenter;
2242858Speter 	extern int outcol;
2252858Speter 
22617684Smckusick 	gettime(filename);
2272858Speter 	if (reenter) {
2282858Speter 		if (outcol)
2292858Speter 			putchar('\n');
2302858Speter 		putchar('\f');
2312858Speter 	}
2322858Speter 	reenter++;
2332858Speter 	if (profile || table) {
2347743Speter 		printf("Berkeley Pascal PXP -- Version %s\n\n%s  %s\n\n",
2357743Speter 			version, myctime(&tvec), filename);
2362858Speter 		printf("Profiled %s\n\n", myctime(&ptvec));
2372858Speter 	}
2382858Speter }
2392858Speter 
2402858Speter char	ugh[] =	"Fatal error in pxp\n";
2412858Speter /*
2422858Speter  * Exit from the Pascal system.
2432858Speter  * We throw in an ungraceful termination
2442858Speter  * message if c > 1 indicating a severe
2452858Speter  * error such as running out of memory
2462858Speter  * or an internal inconsistency.
2472858Speter  */
2482858Speter pexit(c)
2492858Speter 	int c;
2502858Speter {
2512858Speter 	register char *cp;
2522858Speter 	extern int outcol;
2532858Speter 
2542858Speter 	if (stdoutn[0] == '/')
2552858Speter 		unlink(stdoutn);
2562858Speter 	if (outcol)
2572858Speter 		putchar('\n');
2582858Speter 	flush();
2592858Speter 	if (c == DIED)
2602858Speter 		write(2, ugh, sizeof ugh);
2612858Speter 	exit(c);
2622858Speter }
2632858Speter 
2642858Speter onintr()
2652858Speter {
2662858Speter 
2672858Speter 	pexit(DIED);
2682858Speter }
2692858Speter 
2702858Speter puthedr()
2712858Speter {
2722858Speter 
2732858Speter 	yysetfile(filename);
2742858Speter }
275