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