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