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