4.1cBSD/usr/src/ucb/pascal/src/rec.c
/* Copyright (c) 1979 Regents of the University of California */
static char sccsid[] = "@(#)rec.c 1.5 10/19/82";
#include "whoami.h"
#include "0.h"
#include "tree.h"
#include "opcode.h"
#include "align.h"
/*
* set this to TRUE with adb to turn on record alignment/offset debugging.
*/
bool debug_records = FALSE;
#define DEBUG_RECORDS(x) if (debug_records) { x ; } else
/*
* Build a record namelist entry.
* Some of the processing here is somewhat involved.
* The basic structure we are building is as follows.
*
* Each record has a main RECORD entry,
* with an attached chain of fields as ->chain;
* these include all the fields in all the variants of this record.
* Fields are cons'ed to the front of the ->chain list as they are discovered.
* This is for reclook(), but not for sizing and aligning offsets.
*
* If there are variants to the record, NL_TAG points to the field which
* is the tag. If its name is NIL, the tag field is unnamed, and is not
* allocated any space in the record.
* Attached to NL_VARNT is a chain of VARNT structures
* describing each of the variants. These are further linked
* through ->chain. Each VARNT has, in ->range[0] the value of
* the associated constant, and each points at a RECORD describing
* the subrecord through NL_VTOREC. These pointers are not unique,
* more than one VARNT may reference the same RECORD.
*
* On the first pass, we traverse the parse tree and construct the namelist
* entries. This pass fills in the alignment of each record (including
* subrecords (the alignment of a record is the maximum of the alignments
* of any of its fields).
* A second pass over the namelist entries fills in the offsets of each field
* based on the alignments required. This second pass uses the NL_FIELDLIST
* chaining of fields, and the NL_TAG pointer and the NL_VARNT pointer to get
* to fields in the order in which they were declared.
* This second pass can not be folded into the first pass,
* as the starting offset of all variants is the same,
* so we must see all the variants (and especially must know their alignments)
* before assigning offsets. With the alignments calculated (by the first
* pass) this can be done in one top down pass, max'ing over the alignment of
* variants before assigning offsets to any of them.
*/
/*
* P0 points to the outermost RECORD for name searches.
*/
struct nl *P0;
struct nl *
tyrec(r, off)
int *r, off;
{
struct nl *recp;
DEBUG_RECORDS(fprintf(stderr,"[tyrec] off=%d\n", off));
/*
* build namelist structure for the outermost record type.
* then calculate offsets (starting at 0) of the fields
* in this record and its variant subrecords.
*/
recp = tyrec1(r, TRUE);
rec_offsets(recp, 0);
return recp;
}
/*
* Define a record namelist entry.
* r is the tree for the record to be built.
* first is a boolean indicating whether this is an outermost record,
* for name lookups.
* p is the record we define here.
* P0was is a local which stacks the enclosing value of P0 in the stack frame,
* since tyrec1() is recursive.
*/
struct nl *
tyrec1(r, first)
register int *r;
bool first;
{
register struct nl *p, *P0was;
DEBUG_RECORDS(fprintf(stderr,"[tyrec1] first=%d\n", first));
p = defnl(0, RECORD, 0, 0);
P0was = P0;
if (first)
P0 = p;
#ifndef PI0
p->align_info = A_MIN;
#endif
if (r != NIL) {
fields(p, r[2]);
variants(p, r[3]);
}
P0 = P0was;
return (p);
}
/*
* Define the fixed part fields for p.
* hang them, in order, from the record entry, through ->ptr[NL_FIELDLIST].
* the fieldlist is a tconc structure, and is manipulated
* just like newlist(), addlist(), fixlist() in the parser.
*/
fields(p, r)
struct nl *p;
int *r;
{
register int *fp, *tp, *ip;
struct nl *jp;
struct nl *fieldnlp;
DEBUG_RECORDS(fprintf(stderr,"[fields]\n"));
for (fp = r; fp != NIL; fp = fp[2]) {
tp = fp[1];
if (tp == NIL)
continue;
jp = gtype(tp[3]);
line = tp[1];
for (ip = tp[2]; ip != NIL; ip = ip[2]) {
fieldnlp = deffld(p, ip[1], jp);
if ( p->ptr[NL_FIELDLIST] == NIL ) {
/* newlist */
p->ptr[NL_FIELDLIST] = fieldnlp;
fieldnlp->ptr[NL_FIELDLIST] = fieldnlp;
} else {
/* addlist */
fieldnlp->ptr[NL_FIELDLIST] =
p->ptr[NL_FIELDLIST]->ptr[NL_FIELDLIST];
p->ptr[NL_FIELDLIST]->ptr[NL_FIELDLIST] = fieldnlp;
p->ptr[NL_FIELDLIST] = fieldnlp;
}
}
}
if ( p->ptr[NL_FIELDLIST] != NIL ) {
/* fixlist */
fieldnlp = p->ptr[NL_FIELDLIST]->ptr[NL_FIELDLIST];
p->ptr[NL_FIELDLIST]->ptr[NL_FIELDLIST] = NIL;
p->ptr[NL_FIELDLIST] = fieldnlp;
}
}
/*
* Define the variants for RECORD p.
*/
variants(p, r)
struct nl *p;
register int *r;
{
register int *vc, *v;
int *vr;
struct nl *ct;
DEBUG_RECORDS(fprintf(stderr,"[variants]\n"));
if (r == NIL)
return;
ct = gtype(r[3]);
if ( ( ct != NIL ) && ( isnta( ct , "bcsi" ) ) ) {
error("Tag fields cannot be %ss" , nameof( ct ) );
}
line = r[1];
/*
* Want it even if r[2] is NIL so
* we check its type in "new" and "dispose"
* calls -- link it to NL_TAG.
*/
p->ptr[NL_TAG] = deffld(p, r[2], ct);
for (vc = r[4]; vc != NIL; vc = vc[2]) {
v = vc[1];
if (v == NIL)
continue;
vr = tyrec1(v[3], FALSE);
#ifndef PI0
DEBUG_RECORDS(
fprintf(stderr,
"[variants] p->align_info %d vr->align_info %d\n",
p->align_info, vr->align_info));
if (vr->align_info > p->align_info) {
p->align_info = vr->align_info;
}
#endif
line = v[1];
for (v = v[2]; v != NIL; v = v[2])
defvnt(p, v[1], vr, ct);
}
}
/*
* Define a field in subrecord p of record P0
* with name s and type t.
*/
struct nl *
deffld(p, s, t)
struct nl *p;
register char *s;
register struct nl *t;
{
register struct nl *fp;
DEBUG_RECORDS(fprintf(stderr,"[deffld] s=<%s>\n", s));
if (reclook(P0, s) != NIL) {
#ifndef PI1
error("%s is a duplicate field name in this record", s);
#endif
s = NIL;
}
/*
* enter the field with its type
*/
fp = enter(defnl(s, FIELD, t, 0));
/*
* if no name, then this is an unnamed tag,
* so don't link it into reclook()'s chain.
*/
if (s != NIL) {
fp->chain = P0->chain;
P0->chain = fp;
#ifndef PI0
/*
* and the alignment is propagated back.
*/
fp->align_info = align(t);
DEBUG_RECORDS(
fprintf(stderr,
"[deffld] fp->align_info %d p->align_info %d \n",
fp->align_info, p->align_info));
if (fp->align_info > p->align_info) {
p->align_info = fp->align_info;
}
#endif
if (t != NIL) {
P0->nl_flags |= t->nl_flags & NFILES;
p->nl_flags |= t->nl_flags & NFILES;
}
}
return (fp);
}
/*
* Define a variant from the constant tree of t
* in subrecord p of record P0 where the casetype
* is ct and the variant record to be associated is vr.
*/
struct nl *
defvnt(p, t, vr, ct)
struct nl *p, *vr;
int *t;
register struct nl *ct;
{
register struct nl *av;
gconst(t);
if (ct != NIL && incompat(con.ctype, ct , t )) {
#ifndef PI1
cerror("Variant label type incompatible with selector type");
#endif
ct = NIL;
}
av = defnl(0, VARNT, ct, 0);
#ifndef PI1
if (ct != NIL)
uniqv(p);
#endif not PI1
av->chain = p->ptr[NL_VARNT];
p->ptr[NL_VARNT] = av;
av->ptr[NL_VTOREC] = vr;
av->range[0] = con.crval;
return (av);
}
#ifndef PI1
/*
* Check that the constant label value
* is unique among the labels in this variant.
*/
uniqv(p)
struct nl *p;
{
register struct nl *vt;
for (vt = p->ptr[NL_VARNT]; vt != NIL; vt = vt->chain)
if (vt->range[0] == con.crval) {
error("Duplicate variant case label in record");
return;
}
}
#endif
/*
* See if the field name s is defined
* in the record p, returning a pointer
* to it namelist entry if it is.
*/
struct nl *
reclook(p, s)
register struct nl *p;
char *s;
{
if (p == NIL || s == NIL)
return (NIL);
for (p = p->chain; p != NIL; p = p->chain)
if (p->symbol == s)
return (p);
return (NIL);
}
/*
* descend namelist entry for a record and assign offsets.
* fields go at the next higher offset that suits their alignment.
* all variants of a record start at the same offset, which is suitable
* for the alignment of their worst aligned field. thus the size of a
* record is independent of whether or not it is a variant
* (a desirable property).
* records come to us in the namelist, where they have been annotated
* with the maximum alignment their fields require.
* the starting offset is passed to us, and is passed recursively for
* variant records within records.
* the final maximum size of each record is recorded in the namelist
* in the value[NL_OFFS] field of the namelist for the record.
*
* this is supposed to match the offsets used by the c compiler
* so people can share records between modules in both languages.
*/
rec_offsets(recp, offset)
struct nl *recp; /* pointer to the namelist record */
long offset; /* starting offset for this record/field */
{
long origin; /* offset of next field */
struct nl *fieldnlp; /* the current field */
struct nl *varntnlp; /* the current variant */
struct nl *vrecnlp; /* record for the current variant */
long alignment; /* maximum alignment for any variant */
if ( recp == NIL ) {
return;
}
origin = roundup(offset,recp->align_info);
if (origin != offset) {
fprintf(stderr,
"[rec_offsets] offset=%d recp->align_info=%d origin=%d\n",
offset, recp->align_info, origin);
panic("rec_offsets");
}
DEBUG_RECORDS(
fprintf(stderr,
"[rec_offsets] offset %d recp->align %d origin %d\n",
offset, recp->align_info, origin));
/*
* fixed fields are forward linked though ->ptr[NL_FIELDLIST]
* give them all suitable offsets.
*/
for ( fieldnlp = recp->ptr[NL_FIELDLIST];
fieldnlp != NIL;
fieldnlp = fieldnlp->ptr[NL_FIELDLIST] ) {
origin = roundup(origin,align(fieldnlp->type));
fieldnlp->value[NL_OFFS] = origin;
DEBUG_RECORDS(
fprintf(stderr,"[rec_offsets] symbol %s origin %d\n",
fieldnlp->symbol, origin));
origin += lwidth(fieldnlp->type);
}
/*
* this is the extent of the record, so far
*/
recp->value[NL_OFFS] = origin;
/*
* if we have a tag field, we have variants to deal with
*/
if ( recp->ptr[NL_TAG] ) {
/*
* if tag field is unnamed, then don't allocate space for it.
*/
fieldnlp = recp->ptr[NL_TAG];
if ( fieldnlp->symbol != NIL ) {
origin = roundup(origin,align(fieldnlp->type));
fieldnlp->value[NL_OFFS] = origin;
DEBUG_RECORDS(fprintf(stderr,"[rec_offsets] tag %s origin\n",
fieldnlp->symbol, origin));
origin += lwidth(fieldnlp->type);
}
/*
* find maximum alignment of records of variants
*/
for ( varntnlp = recp->ptr[NL_VARNT];
varntnlp != NIL;
varntnlp = varntnlp -> chain ) {
vrecnlp = varntnlp->ptr[NL_VTOREC];
DEBUG_RECORDS(
fprintf(stderr,
"[rec_offsets] maxing variant %d align_info %d\n",
varntnlp->value[0], vrecnlp->align_info));
origin = roundup(origin,vrecnlp->align_info);
}
DEBUG_RECORDS(
fprintf(stderr, "[rec_offsets] origin of variants %d\n", origin));
/*
* assign offsets to fields of records of the variants
* keep maximum length of the current record.
*/
for ( varntnlp = recp->ptr[NL_VARNT];
varntnlp != NIL;
varntnlp = varntnlp -> chain ) {
vrecnlp = varntnlp->ptr[NL_VTOREC];
/*
* assign offsets to fields of the variant.
* recursive call on rec_offsets.
*/
rec_offsets(vrecnlp,origin);
/*
* extent of the record is the
* maximum extent of all variants
*/
if ( vrecnlp->value[NL_OFFS] > recp->value[NL_OFFS] ) {
recp->value[NL_OFFS] = vrecnlp->value[NL_OFFS];
}
}
}
/*
* roundup the size of the record to its alignment
*/
DEBUG_RECORDS(
fprintf(stderr,
"[rec_offsets] recp->value[NL_OFFS] %d ->align_info %d\n",
recp->value[NL_OFFS], recp->align_info));
recp->value[NL_OFFS] = roundup(recp->value[NL_OFFS],recp->align_info);
}