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