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