Commit | Line | Data |
---|---|---|
6172cbb3 CH |
1 | /* Copyright (c) 1979 Regents of the University of California */ |
2 | # | |
3 | /* | |
4 | * pi - Pascal interpreter code translator | |
5 | * | |
6 | * Charles Haley, Bill Joy UCB | |
7 | * Version 1.2 Novmeber 1978 | |
8 | */ | |
9 | ||
10 | #include "whoami" | |
11 | #include "0.h" | |
12 | #include "tree.h" | |
13 | #include "opcode.h" | |
14 | ||
15 | /* | |
16 | * Build a record namelist entry. | |
17 | * Some of the processing here is somewhat involved. | |
18 | * The basic structure we are building is as follows. | |
19 | * | |
20 | * Each record has a main RECORD entry, with an attached | |
21 | * chain of fields as ->chain; these include all the fields in all | |
22 | * the variants of this record. | |
23 | * | |
24 | * Attached to NL_VARNT is a chain of VARNT structures | |
25 | * describing each of the variants. These are further linked | |
26 | * through ->chain. Each VARNT has, in ->range[0] the value of | |
27 | * the associated constant, and each points at a RECORD describing | |
28 | * the subrecord through NL_VTOREC. These pointers are not unique, | |
29 | * more than one VARNT may reference the same RECORD. | |
30 | * | |
31 | * The involved processing here is in computing the NL_OFFS entry | |
32 | * by maxing over the variants. This works as follows. | |
33 | * | |
34 | * Each RECORD has two size counters. NL_OFFS is the maximum size | |
35 | * so far of any variant of this record; NL_FLDSZ gives the size | |
36 | * of just the FIELDs to this point as a base for further variants. | |
37 | * | |
38 | * As we process each variant record, we start its size with the | |
39 | * NL_FLDSZ we have so far. After processing it, if its NL_OFFS | |
40 | * is the largest so far, we update the NL_OFFS of this subrecord. | |
41 | * This will eventually propagate back and update the NL_OFFS of the | |
42 | * entire record. | |
43 | */ | |
44 | ||
45 | /* | |
46 | * P0 points to the outermost RECORD for name searches. | |
47 | */ | |
48 | struct nl *P0; | |
49 | ||
50 | tyrec(r, off) | |
51 | int *r, off; | |
52 | { | |
53 | ||
54 | return tyrec1(r, off, 1); | |
55 | } | |
56 | ||
57 | /* | |
58 | * Define a record namelist entry. | |
59 | * R is the tree for the record to be built. | |
60 | * Off is the offset for the first item in this (sub)record. | |
61 | */ | |
62 | struct nl * | |
63 | tyrec1(r, off, first) | |
64 | register int *r; | |
65 | int off; | |
66 | char first; | |
67 | { | |
68 | register struct nl *p, *P0was; | |
69 | ||
70 | p = defnl(0, RECORD, 0, 0); | |
71 | P0was = P0; | |
72 | if (first) | |
73 | P0 = p; | |
74 | #ifndef PI0 | |
75 | p->value[NL_FLDSZ] = p->value[NL_OFFS] = off; | |
76 | #endif | |
77 | if (r != NIL) { | |
78 | fields(p, r[2]); | |
79 | variants(p, r[3]); | |
80 | } | |
81 | P0 = P0was; | |
82 | return (p); | |
83 | } | |
84 | ||
85 | /* | |
86 | * Define the fixed part fields for p. | |
87 | */ | |
88 | struct nl * | |
89 | fields(p, r) | |
90 | struct nl *p; | |
91 | int *r; | |
92 | { | |
93 | register int *fp, *tp, *ip; | |
94 | struct nl *jp; | |
95 | ||
96 | for (fp = r; fp != NIL; fp = fp[2]) { | |
97 | tp = fp[1]; | |
98 | if (tp == NIL) | |
99 | continue; | |
100 | jp = gtype(tp[3]); | |
101 | line = tp[1]; | |
102 | for (ip = tp[2]; ip != NIL; ip = ip[2]) | |
103 | deffld(p, ip[1], jp); | |
104 | } | |
105 | } | |
106 | ||
107 | /* | |
108 | * Define the variants for RECORD p. | |
109 | */ | |
110 | struct nl * | |
111 | variants(p, r) | |
112 | struct nl *p; | |
113 | register int *r; | |
114 | { | |
115 | register int *vc, *v; | |
116 | int *vr; | |
117 | struct nl *ct; | |
118 | ||
119 | if (r == NIL) | |
120 | return; | |
121 | ct = gtype(r[3]); | |
122 | line = r[1]; | |
123 | /* | |
124 | * Want it even if r[2] is NIL so | |
125 | * we check its type in "new" and "dispose" | |
126 | * calls -- link it to NL_TAG. | |
127 | */ | |
128 | p->ptr[NL_TAG] = deffld(p, r[2], ct); | |
129 | for (vc = r[4]; vc != NIL; vc = vc[2]) { | |
130 | v = vc[1]; | |
131 | if (v == NIL) | |
132 | continue; | |
133 | vr = tyrec1(v[3], p->value[NL_FLDSZ], 0); | |
134 | #ifndef PI0 | |
135 | if (vr->value[NL_OFFS] > p->value[NL_OFFS]) | |
136 | p->value[NL_OFFS] = vr->value[NL_OFFS]; | |
137 | #endif | |
138 | line = v[1]; | |
139 | for (v = v[2]; v != NIL; v = v[2]) | |
140 | defvnt(p, v[1], vr, ct); | |
141 | } | |
142 | } | |
143 | ||
144 | /* | |
145 | * Define a field in subrecord p of record P0 | |
146 | * with name s and type t. | |
147 | */ | |
148 | struct nl * | |
149 | deffld(p, s, t) | |
150 | struct nl *p; | |
151 | register char *s; | |
152 | register struct nl *t; | |
153 | { | |
154 | register struct nl *fp; | |
155 | ||
156 | if (reclook(P0, s) != NIL) { | |
157 | #ifndef PI1 | |
158 | error("%s is a duplicate field name in this record", s); | |
159 | #endif | |
160 | s = NIL; | |
161 | } | |
162 | #ifndef PI0 | |
163 | fp = enter(defnl(s, FIELD, t, p->value[NL_OFFS])); | |
164 | #else | |
165 | fp = enter(defnl(s, FIELD, t, 0)); | |
166 | #endif | |
167 | if (s != NIL) { | |
168 | fp->chain = P0->chain; | |
169 | P0->chain = fp; | |
170 | #ifndef PI0 | |
171 | p->value[NL_FLDSZ] = p->value[NL_OFFS] += even(width(t)); | |
172 | #endif | |
173 | if (t != NIL) { | |
174 | P0->nl_flags |= t->nl_flags & NFILES; | |
175 | p->nl_flags |= t->nl_flags & NFILES; | |
176 | } | |
177 | } | |
178 | return (fp); | |
179 | } | |
180 | ||
181 | /* | |
182 | * Define a variant from the constant tree of t | |
183 | * in subrecord p of record P0 where the casetype | |
184 | * is ct and the variant record to be associated is vr. | |
185 | */ | |
186 | struct nl * | |
187 | defvnt(p, t, vr, ct) | |
188 | struct nl *p, *vr; | |
189 | int *t; | |
190 | register struct nl *ct; | |
191 | { | |
192 | register struct nl *av; | |
193 | ||
194 | gconst(t); | |
195 | if (ct != NIL && incompat(con.ctype, ct)) { | |
196 | #ifndef PI1 | |
197 | cerror("Variant label type incompatible with selector type"); | |
198 | #endif | |
199 | ct = NIL; | |
200 | } | |
201 | av = defnl(0, VARNT, ct, 0); | |
202 | #ifndef PI1 | |
203 | if (ct != NIL) | |
204 | uniqv(p); | |
205 | #endif | |
206 | av->chain = p->ptr[NL_VARNT]; | |
207 | p->ptr[NL_VARNT] = av; | |
208 | av->ptr[NL_VTOREC] = vr; | |
209 | av->range[0] = con.crval; | |
210 | return (av); | |
211 | } | |
212 | ||
213 | #ifndef PI1 | |
214 | /* | |
215 | * Check that the constant label value | |
216 | * is unique among the labels in this variant. | |
217 | */ | |
218 | uniqv(p) | |
219 | struct nl *p; | |
220 | { | |
221 | register struct nl *vt; | |
222 | ||
223 | for (vt = p->ptr[NL_VARNT]; vt != NIL; vt = vt->chain) | |
224 | if (vt->range[0] == con.crval) { | |
225 | error("Duplicate variant case label in record"); | |
226 | return; | |
227 | } | |
228 | } | |
229 | #endif | |
230 | ||
231 | /* | |
232 | * See if the field name s is defined | |
233 | * in the record p, returning a pointer | |
234 | * to it namelist entry if it is. | |
235 | */ | |
236 | struct nl * | |
237 | reclook(p, s) | |
238 | register struct nl *p; | |
239 | char *s; | |
240 | { | |
241 | ||
242 | if (p == NIL || s == NIL) | |
243 | return (NIL); | |
244 | for (p = p->chain; p != NIL; p = p->chain) | |
245 | if (p->symbol == s) | |
246 | return (p); | |
247 | return (NIL); | |
248 | } |