2.9BSD - /usr/src/ucb/pascal/pi/rec.c

   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

Defined variables