xref: /original-bsd/usr.bin/pascal/src/rec.c (revision 26e4b21d)
1 /* Copyright (c) 1979 Regents of the University of California */
2 
3 static char sccsid[] = "@(#)rec.c 1.5 10/19/82";
4 
5 #include "whoami.h"
6 #include "0.h"
7 #include "tree.h"
8 #include "opcode.h"
9 #include "align.h"
10 
11     /*
12      *	set this to TRUE with adb to turn on record alignment/offset debugging.
13      */
14 bool	debug_records = FALSE;
15 #define	DEBUG_RECORDS(x)	if (debug_records) { x ; } else
16 
17 /*
18  * Build a record namelist entry.
19  * Some of the processing here is somewhat involved.
20  * The basic structure we are building is as follows.
21  *
22  * Each record has a main RECORD entry,
23  * with an attached chain of fields as ->chain;
24  * these include all the fields in all the variants of this record.
25  * Fields are cons'ed to the front of the ->chain list as they are discovered.
26  * This is for reclook(), but not for sizing and aligning offsets.
27  *
28  * If there are variants to the record, NL_TAG points to the field which
29  * is the tag.  If its name is NIL, the tag field is unnamed, and is not
30  * allocated any space in the record.
31  * Attached to NL_VARNT is a chain of VARNT structures
32  * describing each of the variants.  These are further linked
33  * through ->chain.  Each VARNT has, in ->range[0] the value of
34  * the associated constant, and each points at a RECORD describing
35  * the subrecord through NL_VTOREC.  These pointers are not unique,
36  * more than one VARNT may reference the same RECORD.
37  *
38  * On the first pass, we traverse the parse tree and construct the namelist
39  * entries.  This pass fills in the alignment of each record (including
40  * subrecords (the alignment of a record is the maximum of the alignments
41  * of any of its fields).
42  * A second pass over the namelist entries fills in the offsets of each field
43  * based on the alignments required.  This second pass uses the NL_FIELDLIST
44  * chaining of fields, and the NL_TAG pointer and the NL_VARNT pointer to get
45  * to fields in the order in which they were declared.
46  * This second pass can not be folded into the first pass,
47  * as the starting offset of all variants is the same,
48  * so we must see all the variants (and especially must know their alignments)
49  * before assigning offsets.  With the alignments calculated (by the first
50  * pass) this can be done in one top down pass, max'ing over the alignment of
51  * variants before assigning offsets to any of them.
52  */
53 
54 /*
55  * P0 points to the outermost RECORD for name searches.
56  */
57 struct	nl *P0;
58 
59 struct nl *
60 tyrec(r, off)
61 	int *r, off;
62 {
63 	struct nl	*recp;
64 
65 	DEBUG_RECORDS(fprintf(stderr,"[tyrec] off=%d\n", off));
66 	    /*
67 	     *	build namelist structure for the outermost record type.
68 	     *	then calculate offsets (starting at 0) of the fields
69 	     *	in this record and its variant subrecords.
70 	     */
71 	recp = tyrec1(r, TRUE);
72 	rec_offsets(recp, 0);
73 	return recp;
74 }
75 
76 /*
77  * Define a record namelist entry.
78  * r is the tree for the record to be built.
79  * first is a boolean indicating whether this is an outermost record,
80  * for name lookups.
81  * p is the record we define here.
82  * P0was is a local which stacks the enclosing value of P0 in the stack frame,
83  * since tyrec1() is recursive.
84  */
85 struct nl *
86 tyrec1(r, first)
87 	register int *r;
88 	bool first;
89 {
90 	register struct nl *p, *P0was;
91 
92 	DEBUG_RECORDS(fprintf(stderr,"[tyrec1] first=%d\n", first));
93 	p = defnl(0, RECORD, 0, 0);
94 	P0was = P0;
95 	if (first)
96 		P0 = p;
97 #ifndef PI0
98 	p->align_info = A_MIN;
99 #endif
100 	if (r != NIL) {
101 		fields(p, r[2]);
102 		variants(p, r[3]);
103 	}
104 	P0 = P0was;
105 	return (p);
106 }
107 
108 /*
109  * Define the fixed part fields for p.
110  * hang them, in order, from the record entry, through ->ptr[NL_FIELDLIST].
111  * the fieldlist is a tconc structure, and is manipulated
112  * just like newlist(), addlist(), fixlist() in the parser.
113  */
114 fields(p, r)
115 	struct nl *p;
116 	int *r;
117 {
118 	register int	*fp, *tp, *ip;
119 	struct nl	*jp;
120 	struct nl	*fieldnlp;
121 
122 	DEBUG_RECORDS(fprintf(stderr,"[fields]\n"));
123 	for (fp = r; fp != NIL; fp = fp[2]) {
124 		tp = fp[1];
125 		if (tp == NIL)
126 			continue;
127 		jp = gtype(tp[3]);
128 		line = tp[1];
129 		for (ip = tp[2]; ip != NIL; ip = ip[2]) {
130 		    fieldnlp = deffld(p, ip[1], jp);
131 		    if ( p->ptr[NL_FIELDLIST] == NIL ) {
132 			    /* newlist */
133 			p->ptr[NL_FIELDLIST] = fieldnlp;
134 			fieldnlp->ptr[NL_FIELDLIST] = fieldnlp;
135 		    } else {
136 			    /* addlist */
137 			fieldnlp->ptr[NL_FIELDLIST] =
138 				p->ptr[NL_FIELDLIST]->ptr[NL_FIELDLIST];
139 			p->ptr[NL_FIELDLIST]->ptr[NL_FIELDLIST] = fieldnlp;
140 			p->ptr[NL_FIELDLIST] = fieldnlp;
141 		    }
142 		}
143 	}
144 	if ( p->ptr[NL_FIELDLIST] != NIL ) {
145 		/* fixlist */
146 	    fieldnlp = p->ptr[NL_FIELDLIST]->ptr[NL_FIELDLIST];
147 	    p->ptr[NL_FIELDLIST]->ptr[NL_FIELDLIST] = NIL;
148 	    p->ptr[NL_FIELDLIST] = fieldnlp;
149 	}
150 }
151 
152 /*
153  * Define the variants for RECORD p.
154  */
155 variants(p, r)
156 	struct nl *p;
157 	register int *r;
158 {
159 	register int *vc, *v;
160 	int *vr;
161 	struct nl *ct;
162 
163 	DEBUG_RECORDS(fprintf(stderr,"[variants]\n"));
164 	if (r == NIL)
165 		return;
166 	ct = gtype(r[3]);
167 	if ( ( ct != NIL ) && ( isnta( ct , "bcsi" ) ) ) {
168 	    error("Tag fields cannot be %ss" , nameof( ct ) );
169 	}
170 	line = r[1];
171 	/*
172 	 * Want it even if r[2] is NIL so
173 	 * we check its type in "new" and "dispose"
174 	 * calls -- link it to NL_TAG.
175 	 */
176 	p->ptr[NL_TAG] = deffld(p, r[2], ct);
177 	for (vc = r[4]; vc != NIL; vc = vc[2]) {
178 		v = vc[1];
179 		if (v == NIL)
180 			continue;
181 		vr = tyrec1(v[3], FALSE);
182 #ifndef PI0
183 		DEBUG_RECORDS(
184 		    fprintf(stderr,
185 			"[variants] p->align_info %d vr->align_info %d\n",
186 			p->align_info, vr->align_info));
187 		if (vr->align_info > p->align_info) {
188 		    p->align_info = vr->align_info;
189 		}
190 #endif
191 		line = v[1];
192 		for (v = v[2]; v != NIL; v = v[2])
193 			defvnt(p, v[1], vr, ct);
194 	}
195 }
196 
197 /*
198  * Define a field in subrecord p of record P0
199  * with name s and type t.
200  */
201 struct nl *
202 deffld(p, s, t)
203 	struct nl *p;
204 	register char *s;
205 	register struct nl *t;
206 {
207 	register struct nl *fp;
208 
209 	DEBUG_RECORDS(fprintf(stderr,"[deffld] s=<%s>\n", s));
210 	if (reclook(P0, s) != NIL) {
211 #ifndef PI1
212 		error("%s is a duplicate field name in this record", s);
213 #endif
214 		s = NIL;
215 	}
216 	    /*
217 	     *	enter the field with its type
218 	     */
219 	fp = enter(defnl(s, FIELD, t, 0));
220 	    /*
221 	     *	if no name, then this is an unnamed tag,
222 	     *	so don't link it into reclook()'s chain.
223 	     */
224 	if (s != NIL) {
225 		fp->chain = P0->chain;
226 		P0->chain = fp;
227 #ifndef PI0
228 		    /*
229 		     * and the alignment is propagated back.
230 		     */
231 		fp->align_info = align(t);
232 		DEBUG_RECORDS(
233 		    fprintf(stderr,
234 			"[deffld] fp->align_info %d p->align_info %d \n",
235 			fp->align_info, p->align_info));
236 		if (fp->align_info > p->align_info) {
237 		    p->align_info = fp->align_info;
238 		}
239 #endif
240 		if (t != NIL) {
241 			P0->nl_flags |= t->nl_flags & NFILES;
242 			p->nl_flags |= t->nl_flags & NFILES;
243 		}
244 	}
245 	return (fp);
246 }
247 
248 /*
249  * Define a variant from the constant tree of t
250  * in subrecord p of record P0 where the casetype
251  * is ct and the variant record to be associated is vr.
252  */
253 struct nl *
254 defvnt(p, t, vr, ct)
255 	struct nl *p, *vr;
256 	int *t;
257 	register struct nl *ct;
258 {
259 	register struct nl *av;
260 
261 	gconst(t);
262 	if (ct != NIL && incompat(con.ctype, ct , t )) {
263 #ifndef PI1
264 		cerror("Variant label type incompatible with selector type");
265 #endif
266 		ct = NIL;
267 	}
268 	av = defnl(0, VARNT, ct, 0);
269 #ifndef PI1
270 	if (ct != NIL)
271 		uniqv(p);
272 #endif not PI1
273 	av->chain = p->ptr[NL_VARNT];
274 	p->ptr[NL_VARNT] = av;
275 	av->ptr[NL_VTOREC] = vr;
276 	av->range[0] = con.crval;
277 	return (av);
278 }
279 
280 #ifndef PI1
281 /*
282  * Check that the constant label value
283  * is unique among the labels in this variant.
284  */
285 uniqv(p)
286 	struct nl *p;
287 {
288 	register struct nl *vt;
289 
290 	for (vt = p->ptr[NL_VARNT]; vt != NIL; vt = vt->chain)
291 		if (vt->range[0] == con.crval) {
292 			error("Duplicate variant case label in record");
293 			return;
294 		}
295 }
296 #endif
297 
298 /*
299  * See if the field name s is defined
300  * in the record p, returning a pointer
301  * to it namelist entry if it is.
302  */
303 struct nl *
304 reclook(p, s)
305 	register struct nl *p;
306 	char *s;
307 {
308 
309 	if (p == NIL || s == NIL)
310 		return (NIL);
311 	for (p = p->chain; p != NIL; p = p->chain)
312 		if (p->symbol == s)
313 			return (p);
314 	return (NIL);
315 }
316 
317     /*
318      *	descend namelist entry for a record and assign offsets.
319      *	fields go at the next higher offset that suits their alignment.
320      *	all variants of a record start at the same offset, which is suitable
321      *	for the alignment of their worst aligned field.  thus the size of a
322      *	record is independent of whether or not it is a variant
323      *	(a desirable property).
324      *	records come to us in the namelist, where they have been annotated
325      *	with the maximum alignment their fields require.
326      *	the starting offset is passed to us, and is passed recursively for
327      *	variant records within records.
328      *	the final maximum size of each record is recorded in the namelist
329      *	in the value[NL_OFFS] field of the namelist for the record.
330      *
331      *	this is supposed to match the offsets used by the c compiler
332      *	so people can share records between modules in both languages.
333      */
334 rec_offsets(recp, offset)
335     struct nl	*recp;		/* pointer to the namelist record */
336     long	offset;		/* starting offset for this record/field */
337 {
338     long	origin;		/* offset of next field */
339     struct nl	*fieldnlp;	/* the current field */
340     struct nl	*varntnlp;	/* the current variant */
341     struct nl	*vrecnlp;	/* record for the current variant */
342     long	alignment;	/* maximum alignment for any variant */
343 
344     if ( recp == NIL ) {
345 	return;
346     }
347     origin = roundup(offset,recp->align_info);
348     if (origin != offset) {
349 	fprintf(stderr,
350 		"[rec_offsets] offset=%d recp->align_info=%d origin=%d\n",
351 		offset, recp->align_info, origin);
352 	panic("rec_offsets");
353     }
354     DEBUG_RECORDS(
355 	fprintf(stderr,
356 	    "[rec_offsets] offset %d recp->align %d origin %d\n",
357 	    offset, recp->align_info, origin));
358 	/*
359 	 *	fixed fields are forward linked though ->ptr[NL_FIELDLIST]
360 	 *	give them all suitable offsets.
361 	 */
362     for (   fieldnlp = recp->ptr[NL_FIELDLIST];
363 	    fieldnlp != NIL;
364 	    fieldnlp = fieldnlp->ptr[NL_FIELDLIST] ) {
365 	origin = roundup(origin,align(fieldnlp->type));
366 	fieldnlp->value[NL_OFFS] = origin;
367 	DEBUG_RECORDS(
368 	    fprintf(stderr,"[rec_offsets] symbol %s origin %d\n",
369 		    fieldnlp->symbol, origin));
370 	origin += lwidth(fieldnlp->type);
371     }
372 	/*
373 	 *	this is the extent of the record, so far
374 	 */
375     recp->value[NL_OFFS] = origin;
376 	/*
377 	 *	if we have a tag field, we have variants to deal with
378 	 */
379     if ( recp->ptr[NL_TAG] ) {
380 	    /*
381 	     *	if tag field is unnamed, then don't allocate space for it.
382 	     */
383 	fieldnlp = recp->ptr[NL_TAG];
384 	if ( fieldnlp->symbol != NIL ) {
385 	    origin = roundup(origin,align(fieldnlp->type));
386 	    fieldnlp->value[NL_OFFS] = origin;
387 	    DEBUG_RECORDS(fprintf(stderr,"[rec_offsets] tag %s origin\n",
388 				    fieldnlp->symbol, origin));
389 	    origin += lwidth(fieldnlp->type);
390 	}
391 	    /*
392 	     *	find maximum alignment of records of variants
393 	     */
394 	for (	varntnlp = recp->ptr[NL_VARNT];
395 		varntnlp != NIL;
396 		varntnlp = varntnlp -> chain ) {
397 	    vrecnlp = varntnlp->ptr[NL_VTOREC];
398 	    DEBUG_RECORDS(
399 		fprintf(stderr,
400 			"[rec_offsets] maxing variant %d align_info %d\n",
401 			varntnlp->value[0], vrecnlp->align_info));
402 	    origin = roundup(origin,vrecnlp->align_info);
403 	}
404 	DEBUG_RECORDS(
405 	    fprintf(stderr, "[rec_offsets] origin of variants %d\n", origin));
406 	    /*
407 	     *	assign offsets to fields of records of the variants
408 	     *	keep maximum length of the current record.
409 	     */
410 	for (	varntnlp = recp->ptr[NL_VARNT];
411 		varntnlp != NIL;
412 		varntnlp = varntnlp -> chain ) {
413 	    vrecnlp = varntnlp->ptr[NL_VTOREC];
414 		/*
415 		 *	assign offsets to fields of the variant.
416 		 *	recursive call on rec_offsets.
417 		 */
418 	    rec_offsets(vrecnlp,origin);
419 		/*
420 		 *	extent of the record is the
421 		 *	maximum extent of all variants
422 		 */
423 	    if ( vrecnlp->value[NL_OFFS] > recp->value[NL_OFFS] ) {
424 		recp->value[NL_OFFS] = vrecnlp->value[NL_OFFS];
425 	    }
426 	}
427     }
428 	/*
429 	 *	roundup the size of the record to its alignment
430 	 */
431     DEBUG_RECORDS(
432 	fprintf(stderr,
433 		"[rec_offsets] recp->value[NL_OFFS] %d ->align_info %d\n",
434 		recp->value[NL_OFFS], recp->align_info));
435     recp->value[NL_OFFS] = roundup(recp->value[NL_OFFS],recp->align_info);
436 }
437