Return to rec.c CVS log

Up to [CSRG BSD Unix] / 43BSDReno / pgrm / pascal / src

Annotation of 43BSDReno/pgrm/pascal/src/rec.c, revision 1.1

1.1     ! root        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) 4/6/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: }

This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.