# 2.11BSD#431 - /usr/src/ucb/pascal/pi/rec.c

##### Functions

    deffld            X
    defvnt            X
    fields            X
    reclook           X
    tyrec             X
    tyrec1            X
    uniqv             X
    variants          X

##### Variables

    P0                X

       1: /*	@(#)rec.c	2.2	SCCS id keyword	*/
       2: /* Copyright (c) 1979 Regents of the University of California */
       3: #
       4: /*
       5:  * pi - Pascal interpreter code translator
       6:  *
       7:  * Charles Haley, Bill Joy UCB
       8:  * Version 1.2 Novmeber 1978
       9:  */
      10:
      11: #include "whoami"
      12: #include "0.h"
      13: #include "tree.h"
      14: #include "opcode.h"
      15:
      16: /*
      17:  * Build a record namelist entry.
      18:  * Some of the processing here is somewhat involved.
      19:  * The basic structure we are building is as follows.
      20:  *
      21:  * Each record has a main RECORD entry, with an attached
      22:  * chain of fields as ->chain;  these include all the fields in all
      23:  * the variants of this record.
      24:  *
      25:  * Attached to NL_VARNT is a chain of VARNT structures
      26:  * describing each of the variants.  These are further linked
      27:  * through ->chain.  Each VARNT has, in ->range[0] the value of
      28:  * the associated constant, and each points at a RECORD describing
      29:  * the subrecord through NL_VTOREC.  These pointers are not unique,
      30:  * more than one VARNT may reference the same RECORD.
      31:  *
      32:  * The involved processing here is in computing the NL_OFFS entry
      33:  * by maxing over the variants.  This works as follows.
      34:  *
      35:  * Each RECORD has two size counters.  NL_OFFS is the maximum size
      36:  * so far of any variant of this record;  NL_FLDSZ gives the size
      37:  * of just the FIELDs to this point as a base for further variants.
      38:  *
      39:  * As we process each variant record, we start its size with the
      40:  * NL_FLDSZ we have so far.  After processing it, if its NL_OFFS
      41:  * is the largest so far, we update the NL_OFFS of this subrecord.
      42:  * This will eventually propagate back and update the NL_OFFS of the
      43:  * entire record.
      44:  */
      45:
      46: /*
      47:  * P0 points to the outermost RECORD for name searches.
      48:  */
      49: struct  nl *P0;
      50:
      51: tyrec(r, off)
      52:     int *r, off;
      53: {
      54:
      55:     tyrec1(r, off, 1);
      56: }
      57:
      58: /*
      59:  * Define a record namelist entry.
      60:  * R is the tree for the record to be built.
      61:  * Off is the offset for the first item in this (sub)record.
      62:  */
      63: struct nl *
      64: tyrec1(r, off, first)
      65:     register int *r;
      66:     int off;
      67:     char first;
      68: {
      69:     register struct nl *p, *P0was;
      70:
      71:     p = defnl(0, RECORD, 0, 0);
      72:     P0was = P0;
      73:     if (first)
      74:         P0 = p;
      75: #ifndef PI0
      76:     p->value[NL_FLDSZ] = p->value[NL_OFFS] = off;
      77: #endif
      78:     if (r != NIL) {
      79:         fields(p, r[2]);
      80:         variants(p, r[3]);
      81:     }
      82:     P0 = P0was;
      83:     return (p);
      84: }
      85:
      86: /*
      87:  * Define the fixed part fields for p.
      88:  */
      89: struct nl *
      90: fields(p, r)
      91:     struct nl *p;
      92:     int *r;
      93: {
      94:     register int *fp, *tp, *ip;
      95:     struct nl *jp;
      96:
      97:     for (fp = r; fp != NIL; fp = fp[2]) {
      98:         tp = fp[1];
      99:         if (tp == NIL)
     100:             continue;
     101:         jp = gtype(tp[3]);
     102:         line = tp[1];
     103:         for (ip = tp[2]; ip != NIL; ip = ip[2])
     104:             deffld(p, ip[1], jp);
     105:     }
     106: }
     107:
     108: /*
     109:  * Define the variants for RECORD p.
     110:  */
     111: struct nl *
     112: variants(p, r)
     113:     struct nl *p;
     114:     register int *r;
     115: {
     116:     register int *vc, *v;
     117:     int *vr;
     118:     struct nl *ct;
     119:
     120:     if (r == NIL)
     121:         return;
     122:     ct = gtype(r[3]);
     123:     line = r[1];
     124:     /*
     125: 	 * Want it even if r[2] is NIL so
     126: 	 * we check its type in "new" and "dispose"
     127: 	 * calls -- link it to NL_TAG.
     128: 	 */
     129:     p->ptr[NL_TAG] = deffld(p, r[2], ct);
     130:     for (vc = r[4]; vc != NIL; vc = vc[2]) {
     131:         v = vc[1];
     132:         if (v == NIL)
     133:             continue;
     134:         vr = tyrec1(v[3], p->value[NL_FLDSZ], 0);
     135: #ifndef PI0
     136:         if (vr->value[NL_OFFS] > p->value[NL_OFFS])
     137:             p->value[NL_OFFS] = vr->value[NL_OFFS];
     138: #endif
     139:         line = v[1];
     140:         for (v = v[2]; v != NIL; v = v[2])
     141:             defvnt(p, v[1], vr, ct);
     142:     }
     143: }
     144:
     145: /*
     146:  * Define a field in subrecord p of record P0
     147:  * with name s and type t.
     148:  */
     149: struct nl *
     150: deffld(p, s, t)
     151:     struct nl *p;
     152:     register char *s;
     153:     register struct nl *t;
     154: {
     155:     register struct nl *fp;
     156:
     157:     if (reclook(P0, s) != NIL) {
     158: #ifndef PI1
     159:         error("%s is a duplicate field name in this record", s);
     160: #endif
     161:         s = NIL;
     162:     }
     163: #ifndef PI0
     164:     fp = enter(defnl(s, FIELD, t, p->value[NL_OFFS]));
     165: #else
     166:     fp = enter(defnl(s, FIELD, t, 0));
     167: #endif
     168:     if (s != NIL) {
     169:         fp->chain = P0->chain;
     170:         P0->chain = fp;
     171: #ifndef PI0
     172:         p->value[NL_FLDSZ] = p->value[NL_OFFS] += even(width(t));
     173: #endif
     174:         if (t != NIL) {
     175:             P0->nl_flags |= t->nl_flags & NFILES;
     176:             p->nl_flags |= t->nl_flags & NFILES;
     177:         }
     178:     }
     179:     return (fp);
     180: }
     181:
     182: /*
     183:  * Define a variant from the constant tree of t
     184:  * in subrecord p of record P0 where the casetype
     185:  * is ct and the variant record to be associated is vr.
     186:  */
     187: struct nl *
     188: defvnt(p, t, vr, ct)
     189:     struct nl *p, *vr;
     190:     int *t;
     191:     register struct nl *ct;
     192: {
     193:     register struct nl *av;
     194:
     195:     gconst(t);
     196:     if (ct != NIL && incompat(con.ctype, ct)) {
     197: #ifndef PI1
     198:         cerror("Variant label type incompatible with selector type");
     199: #endif
     200:         ct = NIL;
     201:     }
     202:     av = defnl(0, VARNT, ct, 0);
     203: #ifndef PI1
     204:     if (ct != NIL)
     205:         uniqv(p);
     206: #endif
     207:     av->chain = p->ptr[NL_VARNT];
     208:     p->ptr[NL_VARNT] = av;
     209:     av->ptr[NL_VTOREC] = vr;
     210:     av->range[0] = con.crval;
     211:     return (av);
     212: }
     213:
     214: #ifndef PI1
     215: /*
     216:  * Check that the constant label value
     217:  * is unique among the labels in this variant.
     218:  */
     219: uniqv(p)
     220:     struct nl *p;
     221: {
     222:     register struct nl *vt;
     223:
     224:     for (vt = p->ptr[NL_VARNT]; vt != NIL; vt = vt->chain)
     225:         if (vt->range[0] == con.crval) {
     226:             error("Duplicate variant case label in record");
     227:             return;
     228:         }
     229: }
     230: #endif
     231:
     232: /*
     233:  * See if the field name s is defined
     234:  * in the record p, returning a pointer
     235:  * to it namelist entry if it is.
     236:  */
     237: struct nl *
     238: reclook(p, s)
     239:     register struct nl *p;
     240:     char *s;
     241: {
     242:
     243:     if (p == NIL || s == NIL)
     244:         return (NIL);
     245:     for (p = p->chain; p != NIL; p = p->chain)
     246:         if (p->symbol == s)
     247:             return (p);
     248:     return (NIL);
     249: }

#### Defined functions

deffld defined in line 149; used 3 times

- in line 104, 129
- in /usr/src/ucb/pascal/pi/0.h line 628

defvnt defined in line 187; used 2 times

- in line 141
- in /usr/src/ucb/pascal/pi/0.h line 629

fields defined in line 89; used 2 times

- in line 79
- in /usr/src/ucb/pascal/pi/0.h line 626

reclook defined in line 237; used 4 times

- in line 157
- in /usr/src/ucb/pascal/pi/0.h line 631
- in /usr/src/ucb/pascal/pi/lookup.c line 81
- in /usr/src/ucb/pascal/pi/lval.c line 180

tyrec defined in line 51; used 1 times

- in /usr/src/ucb/pascal/pi/type.c line 120

tyrec1 defined in line 63; used 3 times

- in line 55, 134
- in /usr/src/ucb/pascal/pi/0.h line 630

uniqv defined in line 219; used 1 times

- in line 205

variants defined in line 111; used 2 times

- in line 80
- in /usr/src/ucb/pascal/pi/0.h line 627

#### Defined variables

P0 defined in line 49; used 7 times

- in line 72-74(2), 82, 157, 169-175(3)

Last modified: 1981-07-10 Generated: 2016-12-26 | Generated by src2html V0.67 page hit count: 790 |