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[] = "@(#)type.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 #include "tree.h"
21
22 STATIC int typecnt = -1;
23 /*
24 * Type declaration part
25 */
typebeg(l,tline)26 typebeg(l, tline)
27 int l, tline;
28 {
29
30 line = l;
31 if (nodecl)
32 printoff();
33 puthedr();
34 putcm();
35 ppnl();
36 indent();
37 ppkw("type");
38 ppgoin(DECL);
39 typecnt = 0;
40 setline(tline);
41 }
42
type(tline,tid,tdecl)43 type(tline, tid, tdecl)
44 int tline;
45 char *tid;
46 int *tdecl;
47 {
48
49 if (typecnt)
50 putcm();
51 setline(tline);
52 ppitem();
53 ppid(tid);
54 ppsep(" =");
55 gtype(tdecl);
56 ppsep(";");
57 setinfo(tline);
58 putcml();
59 typecnt++;
60 }
61
typeend()62 typeend()
63 {
64
65 if (typecnt == -1)
66 return;
67 if (typecnt == 0)
68 ppid("{type decls}");
69 ppgoout(DECL);
70 typecnt = -1;
71 }
72
73 /*
74 * A single type declaration
75 */
gtype(r)76 gtype(r)
77 register int *r;
78 {
79
80 if (r == NIL) {
81 ppid("{type}");
82 return;
83 }
84 if (r[0] != T_ID && r[0] != T_TYPACK)
85 setline(r[1]);
86 switch (r[0]) {
87 default:
88 panic("type");
89 case T_ID:
90 ppspac();
91 ppid(r[1]);
92 return;
93 case T_TYID:
94 ppspac();
95 ppid(r[2]);
96 break;
97 case T_TYSCAL:
98 ppspac();
99 tyscal(r);
100 break;
101 case T_TYCRANG:
102 ppspac();
103 tycrang(r);
104 break;
105 case T_TYRANG:
106 ppspac();
107 tyrang(r);
108 break;
109 case T_TYPTR:
110 ppspac();
111 ppop("^");
112 gtype(r[2]);
113 break;
114 case T_TYPACK:
115 ppspac();
116 ppkw("packed");
117 gtype(r[2]);
118 break;
119 case T_TYCARY:
120 case T_TYARY:
121 ppspac();
122 tyary(r);
123 break;
124 case T_TYREC:
125 ppspac();
126 tyrec(r[2], NIL);
127 break;
128 case T_TYFILE:
129 ppspac();
130 ppkw("file");
131 ppspac();
132 ppkw("of");
133 gtype(r[2]);
134 break;
135 case T_TYSET:
136 ppspac();
137 ppkw("set");
138 ppspac();
139 ppkw("of");
140 gtype(r[2]);
141 break;
142 }
143 setline(r[1]);
144 putcml();
145 }
146
147 /*
148 * Scalar type declaration
149 */
tyscal(r)150 tyscal(r)
151 register int *r;
152 {
153 register int i;
154
155 ppsep("(");
156 r = r[2];
157 if (r != NIL) {
158 i = 0;
159 ppgoin(DECL);
160 for (;;) {
161 ppid(r[1]);
162 r = r[2];
163 if (r == NIL)
164 break;
165 ppsep(", ");
166 i++;
167 if (i == 7) {
168 ppitem();
169 i = 0;
170 }
171 }
172 ppgoout(DECL);
173 } else
174 ppid("{constant list}");
175 ppsep(")");
176 }
177
178 /*
179 * Conformant array subrange.
180 */
tycrang(r)181 tycrang(r)
182 register int *r;
183 {
184
185 ppid(r[2]);
186 ppsep("..");
187 ppid(r[3]);
188 ppsep(":");
189 gtype(r[4]);
190 }
191
192 /*
193 * Subrange type declaration
194 */
tyrang(r)195 tyrang(r)
196 register int *r;
197 {
198
199 gconst(r[2]);
200 ppsep("..");
201 gconst(r[3]);
202 }
203
204 /*
205 * Array type declaration
206 */
tyary(r)207 tyary(r)
208 register int *r;
209 {
210 register int *tl;
211
212 ppkw("array");
213 ppspac();
214 ppsep("[");
215 tl = r[2];
216 if (tl != NIL) {
217 ppunspac();
218 for (;;) {
219 gtype(tl[1]);
220 tl = tl[2];
221 if (tl == NIL)
222 break;
223 ppsep(",");
224 }
225 } else
226 ppid("{subscr list}");
227 ppsep("]");
228 ppspac();
229 ppkw("of");
230 gtype(r[3]);
231 }
232