xref: /csrg-svn/usr.bin/pascal/pxp/rec.c (revision 2863)
1*2863Speter static	char *sccsid = "@(#)rec.c	1.1 (Berkeley) 03/02/81";
2*2863Speter /* Copyright (c) 1979 Regents of the University of California */
3*2863Speter #
4*2863Speter /*
5*2863Speter  * pxp - Pascal execution profiler
6*2863Speter  *
7*2863Speter  * Bill Joy UCB
8*2863Speter  * Version 1.2 January 1979
9*2863Speter  */
10*2863Speter 
11*2863Speter #include "0.h"
12*2863Speter 
13*2863Speter tyrec(r, p0)
14*2863Speter 	int *r, p0;
15*2863Speter {
16*2863Speter 
17*2863Speter 	if (r != NIL)
18*2863Speter 		setinfo(r[1]);
19*2863Speter 	if (p0 == NIL) {
20*2863Speter 		ppgoin(DECL);
21*2863Speter 		ppnl();
22*2863Speter 		indent();
23*2863Speter 		ppkw("record");
24*2863Speter 		ppspac();
25*2863Speter 	} else {
26*2863Speter 		ppspac();
27*2863Speter 		ppbra("(");
28*2863Speter 	}
29*2863Speter 	ppgoin(DECL);
30*2863Speter 	if (r) {
31*2863Speter 		field(r[2], r[3]);
32*2863Speter 		variant(r[3]);
33*2863Speter 	}
34*2863Speter 	if (r != NIL)
35*2863Speter 		setinfo(r[1]);
36*2863Speter 	putcml();
37*2863Speter 	ppgoout(DECL);
38*2863Speter 	if (p0 == NIL) {
39*2863Speter 		ppnl();
40*2863Speter 		indent();
41*2863Speter 		ppkw("end");
42*2863Speter 		ppgoout(DECL);
43*2863Speter 	} else {
44*2863Speter 		ppitem();
45*2863Speter 		ppket(")");
46*2863Speter 	}
47*2863Speter }
48*2863Speter 
49*2863Speter field(r, v)
50*2863Speter 	int *r, *v;
51*2863Speter {
52*2863Speter 	register int *fp, *tp, *ip;
53*2863Speter 
54*2863Speter 	fp = r;
55*2863Speter 	if (fp != NIL)
56*2863Speter 		for (;;) {
57*2863Speter 			tp = fp[1];
58*2863Speter 			if (tp != NIL) {
59*2863Speter 				setline(tp[1]);
60*2863Speter 				ip = tp[2];
61*2863Speter 				ppitem();
62*2863Speter 				if (ip != NIL)
63*2863Speter 					for (;;) {
64*2863Speter 						ppid(ip[1]);
65*2863Speter 						ip = ip[2];
66*2863Speter 						if (ip == NIL)
67*2863Speter 							break;
68*2863Speter 						ppsep(", ");
69*2863Speter 					}
70*2863Speter 				else
71*2863Speter 					ppid("{field id list}");
72*2863Speter 				ppsep(":");
73*2863Speter 				gtype(tp[3]);
74*2863Speter 				setinfo(tp[1]);
75*2863Speter 				putcm();
76*2863Speter 			}
77*2863Speter 			fp = fp[2];
78*2863Speter 			if (fp == NIL)
79*2863Speter 				break;
80*2863Speter 			ppsep(";");
81*2863Speter 		}
82*2863Speter 	if (v != NIL && r != NIL)
83*2863Speter 		ppsep(";");
84*2863Speter }
85*2863Speter 
86*2863Speter variant(r)
87*2863Speter 	register int *r;
88*2863Speter {
89*2863Speter 	register int *v, *vc;
90*2863Speter 
91*2863Speter 	if (r == NIL)
92*2863Speter 		return;
93*2863Speter 	setline(r[1]);
94*2863Speter 	ppitem();
95*2863Speter 	ppkw("case");
96*2863Speter 	v = r[2];
97*2863Speter 	if (v != NIL) {
98*2863Speter 		ppspac();
99*2863Speter 		ppid(v);
100*2863Speter 		ppsep(":");
101*2863Speter 	}
102*2863Speter 	gtype(r[3]);
103*2863Speter 	ppspac();
104*2863Speter 	ppkw("of");
105*2863Speter 	for (vc = r[4]; vc != NIL;) {
106*2863Speter 		v = vc[1];
107*2863Speter 		if (v == NIL)
108*2863Speter 			continue;
109*2863Speter 		ppgoin(DECL);
110*2863Speter 		setline(v[1]);
111*2863Speter 		ppnl();
112*2863Speter 		indent();
113*2863Speter 		ppbra(NIL);
114*2863Speter 		v = v[2];
115*2863Speter 		if (v != NIL) {
116*2863Speter 			for (;;) {
117*2863Speter 				gconst(v[1]);
118*2863Speter 				v = v[2];
119*2863Speter 				if (v == NIL)
120*2863Speter 					break;
121*2863Speter 				ppsep(", ");
122*2863Speter 			}
123*2863Speter 		} else
124*2863Speter 			ppid("{case label list}");
125*2863Speter 		ppket(":");
126*2863Speter 		v = vc[1];
127*2863Speter 		tyrec(v[3], 1);
128*2863Speter 		setinfo(v[1]);
129*2863Speter 		putcml();
130*2863Speter 		ppgoout(DECL);
131*2863Speter 		vc = vc[2];
132*2863Speter 		if (vc == NIL)
133*2863Speter 			break;
134*2863Speter 		ppsep(";");
135*2863Speter 	}
136*2863Speter 	setinfo(r[1]);
137*2863Speter 	putcm();
138*2863Speter }
139