[unix-history] / usr / src / usr.bin / pascal / pxp / fdec.c

/* Copyright (c) 1979 Regents of the University of California */
#
static	char *sccsid = "@(#)fdec.c	1.3 (Berkeley) %G%";
/*
 * pxp - Pascal execution profiler
 *
 * Bill Joy UCB
 * Version 1.2 January 1979
 */

#include "0.h"
#include "tree.h"

/*
 * Program, procedure or function "header", i.e.:
 *
 *	function sin: real;
 */
funchdr(r)
	int *r;
{
	register **rl, *il;

	if (inpflist(r[2])) {
		optstk['z'-'a'] =<< 1;
		optstk['z'-'a'] =| opts['z'-'a'];
		opts['z'-'a'] = 1;
	}
	cbn++;
	lastbn = cbn;
	getcnt();
	if (nojunk && !inpflist(r[2]))
		setprint();
	else
		printon();
	if (r[0] == T_PROG && noinclude && bracket)
		printoff();
	if (cbn > 1 && !justify)
		ppgoin(PRFN);
	puthedr();
	if (noblank(setline(r[1])))
		ppnl();
	cnttab(r[2], pfcnt++);
	ppnl();
	indent();
	switch (r[0]) {
		case T_PROG:
			ppkw("program");
			break;
		case T_PDEC:
			ppkw("procedure");
			break;
		case T_FDEC:
			ppkw("function");
			break;
		default:
			panic("funchdr");
	}
	ppspac();
	ppid(r[2]);
	if (r[0] != T_PROG) {
		rl = r[3];
		if (rl != NIL) {
			ppbra("(");
			for (;;) {
				if (rl[1] == NIL) {
					rl = rl[2];
					continue;
				}
				switch (rl[1][0]) {
					case T_PVAR:
						ppkw("var");
						ppspac();
						break;
					case T_PPROC:
						ppkw("procedure");
						ppspac();
						break;
					case T_PFUNC:
						ppkw("function");
						ppspac();
						break;
				}
				il = rl[1][1];
				if (il != NIL)
					for (;;) {
						ppid(il[1]);
						il = il[2];
						if (il == NIL)
							break;
						ppsep(", ");
					}
				else
					ppid("{identifier list}");
				if (rl[1][0] != T_PPROC) {
					ppsep(":");
					gtype(rl[1][2]);
				}
				rl = rl[2];
				if (rl == NIL)
					break;
				ppsep(";");
				ppspac();
			}
			ppket(")");
		}
		if (r[0] == T_FDEC && r[4] != NIL) {
			ppsep(":");
			gtype(r[4]);
		}
		ppsep(";");
	} else {
		rl = r[3];
		if (rl != NIL) {
			ppbra("(");
			for (;;) {
				ppid(rl[1]);
				rl = rl[2];
				if (rl == NIL)
					break;
				ppsep(", ");
			}
			ppket(")");
		}
		ppsep(";");
	}
fhout:
	setline(r[1]);
	putcml();
	savecnt(&pfcnts[cbn]);
	setprint();
	--cbn;
	if (cbn && !justify)
		ppgoout(PRFN);
	return (r[2]);
}

/*
 * Forward declaration i.e. the second line of
 *
 *	procedure fum(var i: integer);
 *	    forward;
 */
funcfwd(fp)
	char *fp;
{

	baroff();
	ppgoin(DECL);
	ppnl();
	indent();
	ppkw("forward");
	ppsep(";");
	ppgoout(DECL);
	baron();
	return (fp);
}

/*
 * The "body" of a procedure, function, or program declaration,
 * i.e. a non-forward definition encounter.
 */
funcbody(fp)
	char *fp;
{

	if (cbn && !justify)
		ppgoin(PRFN);
	cbn++;
	lastbn = cbn;
	return (fp);
}

/*
 * The guts of the procedure, function or program, i.e.
 * the part between the begin and the end.
 */
funcend(fp, bundle, binfo)
	char *fp;
	int *bundle, *binfo;
{
	int *blk;
	extern int cntstat;

	cntstat = 0;
	blk = bundle[2];
	rescnt(&pfcnts[cbn]);
	setprint();
	if (cbn == 1 && noinclude && bracket)
		printoff();
	if (lastbn > cbn)
		unprint();
	if (cbn == 1)
		puthedr();
	if (noblank(setline(bundle[1])) && lastbn > cbn)
		ppnl();
	ppnl();
	indent();
	ppkw("begin");
	setline(bundle[1]);
	if (putcml() == 0 && lastbn > cbn)
		ppsname(fp);
	ppgoin(DECL);
	statlist(blk);
	setinfo(bundle[1]);
	putcmp();
	ppgoout(DECL);
	ppnl();
	indent();
	ppkw("end");
	ppsep(cbn == 1 ? "." : ";");
	setinfo(binfo);
	if (putcml() == 0)
		ppsname(fp);
	cbn--;
	if (cbn && !justify)
		ppgoout(PRFN);
	if (inpflist(fp)) {
		opts['z'-'a'] = optstk['z'-'a'] & 1;
		optstk['z'-'a'] =>> 1;
	}
	if (cbn == 0) {
		flushcm();
		printon();
		ppnl();
	}
}

ppsname(fp)
	char *fp;
{
	if (fp == NIL)
		return;
	ppsep(" { ");
	ppid(fp);
	ppsep(" }");
}

/*
 * Segend is called at the end of a routine segment (a separately
 * compiled segment that is not the main program). Since pxp only works
 * with a single pascal file, this routine should never be called.
 */
segend()
{

	if ( profile ) {
	    error("Missing program statement and program body");
	}
}

/*
 * External declaration i.e. the second line of
 *
 *	procedure fum(var i: integer);
 *	    external;
 */
struct nl *
funcext(fp)
	struct nl *fp;
{

	baroff();
	ppgoin(DECL);
	ppnl();
	indent();
	ppkw("external");
	ppsep(";");
	ppgoout(DECL);
	baron();
	return (fp);
}
Commit	Line	Data
09530172 PK	1	/* Copyright (c) 1979 Regents of the University of California */
09530172 PK	2	#
2e2d1991	3	static char *sccsid = "@(#)fdec.c 1.3 (Berkeley) %G%";
09530172 PK	4	/*
	5	* pxp - Pascal execution profiler
	6	*
	7	* Bill Joy UCB
	8	* Version 1.2 January 1979
	9	*/
	10
	11	#include "0.h"
	12	#include "tree.h"
	13
	14	/*
	15	* Program, procedure or function "header", i.e.:
	16	*
	17	* function sin: real;
	18	*/
	19	funchdr(r)
	20	int *r;
	21	{
	22	register *rl, il;
	23
	24	if (inpflist(r[2])) {
	25	optstk['z'-'a'] =<< 1;
	26	optstk['z'-'a'] =\| opts['z'-'a'];
	27	opts['z'-'a'] = 1;
	28	}
	29	cbn++;
	30	lastbn = cbn;
	31	getcnt();
	32	if (nojunk && !inpflist(r[2]))
	33	setprint();
	34	else
	35	printon();
	36	if (r[0] == T_PROG && noinclude && bracket)
	37	printoff();
	38	if (cbn > 1 && !justify)
	39	ppgoin(PRFN);
	40	puthedr();
	41	if (noblank(setline(r[1])))
	42	ppnl();
	43	cnttab(r[2], pfcnt++);
	44	ppnl();
	45	indent();
	46	switch (r[0]) {
	47	case T_PROG:
	48	ppkw("program");
	49	break;
	50	case T_PDEC:
	51	ppkw("procedure");
	52	break;
	53	case T_FDEC:
	54	ppkw("function");
	55	break;
	56	default:
	57	panic("funchdr");
	58	}
	59	ppspac();
	60	ppid(r[2]);
	61	if (r[0] != T_PROG) {
	62	rl = r[3];
	63	if (rl != NIL) {
	64	ppbra("(");
	65	for (;;) {
	66	if (rl[1] == NIL) {
	67	rl = rl[2];
68	continue;
69	}
70	switch (rl[1][0]) {
71	case T_PVAR:
72	ppkw("var");
73	ppspac();
74	break;
75	case T_PPROC:
76	ppkw("procedure");
77	ppspac();
78	break;
79	case T_PFUNC:
80	ppkw("function");
81	ppspac();
82	break;
83	}
84	il = rl[1][1];
85	if (il != NIL)
86	for (;;) {
87	ppid(il[1]);
88	il = il[2];
89	if (il == NIL)
90	break;
91	ppsep(", ");
92	}
93	else
94	ppid("{identifier list}");
95	if (rl[1][0] != T_PPROC) {
96	ppsep(":");
97	gtype(rl[1][2]);
98	}
99	rl = rl[2];
100	if (rl == NIL)
101	break;
102	ppsep(";");
103	ppspac();
104	}
105	ppket(")");
106	}
107	if (r[0] == T_FDEC && r[4] != NIL) {
108	ppsep(":");
109	gtype(r[4]);
110	}
111	ppsep(";");
112	} else {
113	rl = r[3];
114	if (rl != NIL) {
115	ppbra("(");
116	for (;;) {
117	ppid(rl[1]);
118	rl = rl[2];
119	if (rl == NIL)
120	break;
121	ppsep(", ");
122	}
123	ppket(")");
124	}
125	ppsep(";");
126	}
127	fhout:
128	setline(r[1]);
129	putcml();
130	savecnt(&pfcnts[cbn]);
131	setprint();
132	--cbn;
133	if (cbn && !justify)
134	ppgoout(PRFN);
135	return (r[2]);
136	}
137
138	/*
139	* Forward declaration i.e. the second line of
140	*
141	* procedure fum(var i: integer);
142	* forward;
143	*/
144	funcfwd(fp)
145	char *fp;
146	{
147
148	baroff();
149	ppgoin(DECL);
150	ppnl();
151	indent();
152	ppkw("forward");
153	ppsep(";");
154	ppgoout(DECL);
155	baron();
156	return (fp);
157	}
158
159	/*
160	* The "body" of a procedure, function, or program declaration,
161	* i.e. a non-forward definition encounter.
162	*/
163	funcbody(fp)
164	char *fp;
165	{
166
167	if (cbn && !justify)
168	ppgoin(PRFN);
169	cbn++;
170	lastbn = cbn;
171	return (fp);
172	}
173
174	/*
175	* The guts of the procedure, function or program, i.e.
176	* the part between the begin and the end.
177	*/
178	funcend(fp, bundle, binfo)
179	char *fp;
180	int bundle, binfo;
181	{
182	int *blk;
183	extern int cntstat;
184
185	cntstat = 0;
186	blk = bundle[2];
187	rescnt(&pfcnts[cbn]);
188	setprint();
189	if (cbn == 1 && noinclude && bracket)
190	printoff();
191	if (lastbn > cbn)
192	unprint();
193	if (cbn == 1)
194	puthedr();
195	if (noblank(setline(bundle[1])) && lastbn > cbn)
196	ppnl();
197	ppnl();
198	indent();
199	ppkw("begin");
200	setline(bundle[1]);
201	if (putcml() == 0 && lastbn > cbn)
202	ppsname(fp);
203	ppgoin(DECL);
204	statlist(blk);
205	setinfo(bundle[1]);
206	putcmp();
207	ppgoout(DECL);
208	ppnl();
209	indent();
210	ppkw("end");
211	ppsep(cbn == 1 ? "." : ";");
212	setinfo(binfo);
213	if (putcml() == 0)
214	ppsname(fp);
215	cbn--;
216	if (cbn && !justify)
217	ppgoout(PRFN);
218	if (inpflist(fp)) {
219	opts['z'-'a'] = optstk['z'-'a'] & 1;
220	optstk['z'-'a'] =>> 1;
221	}
222	if (cbn == 0) {
223	flushcm();
224	printon();
225	ppnl();
226	}
227	}
228
229	ppsname(fp)
230	char *fp;
231	{
232	if (fp == NIL)
233	return;
234	ppsep(" { ");
235	ppid(fp);
236	ppsep(" }");
237	}
c7cf6e6b KM	238
	239	/*
	240	* Segend is called at the end of a routine segment (a separately
	241	* compiled segment that is not the main program). Since pxp only works
	242	* with a single pascal file, this routine should never be called.
	243	*/
	244	segend()
	245	{
	246
2e2d1991 KM	247	if ( profile ) {
	248	error("Missing program statement and program body");
	249	}
c7cf6e6b KM	250	}
	251
	252	/*
	253	* External declaration i.e. the second line of
	254	*
	255	* procedure fum(var i: integer);
	256	* external;
	257	*/
	258	struct nl *
	259	funcext(fp)
	260	struct nl *fp;
	261	{
	262
	263	baroff();
	264	ppgoin(DECL);
	265	ppnl();
	266	indent();
	267	ppkw("external");
	268	ppsep(";");
	269	ppgoout(DECL);
	270	baron();
	271	return (fp);
	272	}