BSD 2 development

Work on file src/pi0/nl.c
Work on file src/pi0/opcode.h
Work on file src/pi0/rec.c

Synthesized-from: 2bsd

diff --git a/src/pi0/nl.c b/src/pi0/nl.c
new file mode 100644 (file)
index 0000000..4f632df
--- /dev/null
+++ b/src/pi0/nl.c
@@ -0,0 +1,690 @@
+/* Copyright (c) 1979 Regents of the University of California */
+#
+/*
+ * pi - Pascal interpreter code translator
+ *
+ * Charles Haley, Bill Joy UCB
+ * Version 1.2 January 1979
+ */
+
+#include "0.h"
+#include "opcode.h"
+
+#ifdef PI
+/*
+ * Array of information about pre-defined, block 0 symbols.
+ */
+int    *biltins[] {
+
+       /*
+        * Types
+        */
+       "boolean",
+       "char",
+       "integer",
+       "real",
+       "_nil",         /* dummy name */
+       0,
+
+       /*
+        * Ranges
+        */
+       TINT,           0177777, 0177600, 0, 0177,
+       TINT,           0177777, 0100000, 0, 077777,
+       TINT,           0100000, 0, 077777, 0177777,
+       TCHAR,          0, 0, 0, 127,
+       TBOOL,          0, 0, 0, 1,
+       TDOUBLE,        0, 0, 0, 0,             /* fake for reals */
+       0,
+
+       /*
+        * Built-in composite types
+        */
+       "Boolean",
+       "intset",
+       "alfa",
+       "text",
+       "input", 
+       "output", 
+
+       /*
+        * Built-in constants
+        */
+       "true",         TBOOL,  1, 0,
+       "false",        TBOOL,  0, 0,
+       "minchar",      T1CHAR, 0, 0,
+       "maxchar",      T1CHAR, 0177, 0,
+       "bell",         T1CHAR, 07, 0,
+       "tab",          T1CHAR, 011, 0,
+       "minint",       T4INT,  0100000, 0,             /* Must be last 2! */
+       "maxint",       T4INT,  077777, 0177777,
+       0,
+
+       /*
+        * Built-in functions
+        */
+#ifndef PI0
+       "abs",          O_ABS2,
+       "arctan",       O_ATAN,
+       "card",         O_CARD|NSTAND,
+       "chr",          O_CHR2,
+       "clock",        O_CLCK|NSTAND,
+       "cos",          O_COS,
+       "eof",          O_EOF,
+       "eoln",         O_EOLN,
+       "eos",          0,
+       "exp",          O_EXP,
+       "expo",         O_EXPO|NSTAND,
+       "ln",           O_LN,
+       "odd",          O_ODD2,
+       "ord",          O_ORD2,
+       "pred",         O_PRED2,
+       "round",        O_ROUND,
+       "sin",          O_SIN,
+       "sqr",          O_SQR2,
+       "sqrt",         O_SQRT,
+       "succ",         O_SUCC2,
+       "trunc",        O_TRUNC,
+       "undefined",    O_UNDEF|NSTAND,
+       /*
+        * Extensions
+        */
+       "argc",         O_ARGC|NSTAND,
+       "random",       O_RANDOM|NSTAND,
+       "seed",         O_SEED|NSTAND,
+       "wallclock",    O_WCLCK|NSTAND,
+       "sysclock",     O_SCLCK|NSTAND,
+       0,
+
+       /*
+        * Built-in procedures
+        */
+       "date",         O_DATE|NSTAND,
+       "flush",        O_FLUSH|NSTAND,
+       "get",          O_GET,
+       "getseg",       0,
+       "halt",         O_HALT|NSTAND,
+       "linelimit",    O_LLIMIT|NSTAND,
+       "message",      O_MESSAGE|NSTAND,
+       "new",          O_NEW,
+       "pack",         O_PACK,
+       "page",         O_PAGE,
+       "put",          O_PUT,
+       "putseg",       0,
+       "read",         O_READ4,
+       "readln",       O_READLN,
+       "remove",       O_REMOVE|NSTAND,
+       "reset",        O_RESET,
+       "rewrite",      O_REWRITE,
+       "time",         O_TIME|NSTAND,
+       "unpack",       O_UNPACK,
+       "write",        O_WRIT2,
+       "writeln",      O_WRITLN,
+       /*
+        * Extensions
+        */
+       "argv",         O_ARGV|NSTAND,
+       "null",         O_NULL|NSTAND,
+       "stlimit",      O_STLIM|NSTAND,
+       0,
+#else
+       "abs",
+       "arctan",
+       "card",
+       "chr",
+       "clock",
+       "cos",
+       "eof",
+       "eoln",
+       "eos",
+       "exp",
+       "expo",
+       "ln",
+       "odd",
+       "ord",
+       "pred",
+       "round",
+       "sin",
+       "sqr",
+       "sqrt",
+       "succ",
+       "trunc",
+       "undefined",
+       /*
+        * Extensions
+        */
+       "argc",
+       "random",
+       "seed",
+       "wallclock",
+       "sysclock",
+       0,
+
+       /*
+        * Built-in procedures
+        */
+       "date",
+       "flush",
+       "get",
+       "getseg",
+       "halt",
+       "linelimit",
+       "message",
+       "new",
+       "pack",
+       "page",
+       "put",
+       "putseg",
+       "read",
+       "readln",
+       "remove",
+       "reset",
+       "rewrite",
+       "time",
+       "unpack",
+       "write",
+       "writeln",
+       /*
+        * Extensions
+        */
+       "argv",
+       "null",
+       "stlimit",
+       0,
+#endif
+};
+\f
+/*
+ * NAMELIST SEGMENT DEFINITIONS
+ */
+struct nls {
+       struct nl *nls_low;
+       struct nl *nls_high;
+} ntab[MAXNL], *nlact;
+
+struct nl nl[INL];
+struct nl *nlp nl;
+struct nls *nlact ntab;
+/*
+ * Initnl initializes the first namelist segment and then
+ * uses the array biltins to initialize the name list for
+ * block 0.
+ */
+initnl()
+{
+       register int *q;
+       register struct nl *p;
+       register int i;
+
+#ifdef DEBUG
+       if (hp21mx) {
+               MININT = -32768.;
+               MAXINT = 32767.;
+#ifndef PI0
+               genmx();
+#endif
+       }
+#endif
+       ntab[0].nls_low = nl;
+       ntab[0].nls_high = &nl[INL];
+       defnl(0, 0, 0, 0);
+       /*
+        * Fundamental types
+        */
+       for (q = biltins; *q != 0; q++)
+               hdefnl(*q, TYPE, nlp, 0);
+       q++;
+
+       /*
+        * Ranges
+        */
+       while (*q) {
+               p = defnl(0, RANGE, nl+*q, 0);
+               nl[*q++].type = p;
+               for (i = 0; i < 4; i++)
+                       p->value[i] = *q++;
+       }
+       q++;
+
+#ifdef DEBUG
+       if (hp21mx) {
+               nl[T4INT].range[0] = MININT;
+               nl[T4INT].range[1] = MAXINT;
+       }
+#endif
+
+       /*
+        * Pre-defined composite types
+        */
+       hdefnl(*q++, TYPE, nl+T1BOOL, 0);
+       enter(defnl((intset = *q++), TYPE, nlp+1, 0));
+       defnl(0, SET, nlp+1, 0);
+       defnl(0, RANGE, nl+TINT, 0)->value[3] = 127;
+     p=        defnl(0, RANGE, nl+TINT, 0);
+       p->value[1] = 1;
+       p->value[3] = 10;
+       defnl(0, ARRAY, nl+T1CHAR, 1)->chain = p;
+       hdefnl(*q++, TYPE, nlp-1, 0);   /* "alfa" */
+       hdefnl(*q++, TYPE, nlp+1, 0);   /* "text" */
+     p=        defnl(0, FILE, nl+T1CHAR, 0);
+       p->nl_flags =| NFILES;
+#ifndef PI0
+       input = hdefnl(*q++, VAR, p, -2);       /* "input" */
+       output = hdefnl(*q++, VAR, p, -4);      /* "output" */
+#else
+       input = hdefnl(*q++, VAR, p, 0);        /* "input" */
+       output = hdefnl(*q++, VAR, p, 0);       /* "output" */
+#endif
+
+       /*
+        * Pre-defined constants
+        */
+       for (; *q; q =+ 4)
+               hdefnl(q[0], CONST, nl+q[1], q[2])->value[1] = q[3];
+
+#ifdef DEBUG
+       if (hp21mx) {
+               nlp[-2].range[0] = MININT;
+               nlp[-1].range[0] = MAXINT;
+       }
+#endif
+
+       /*
+        * Built-in procedures and functions
+        */
+#ifndef PI0
+       for (q++; *q; q =+ 2)
+               hdefnl(q[0], FUNC, 0, q[1]);
+       for (q++; *q; q =+ 2)
+               hdefnl(q[0], PROC, 0, q[1]);
+#else
+       for (q++; *q;)
+               hdefnl(*q++, FUNC, 0, 0);
+       for (q++; *q;)
+               hdefnl(*q++, PROC, 0, 0);
+#endif
+}
+
+hdefnl(sym, cls, typ, val)
+{
+       register struct nl *p;
+
+#ifndef PI1
+       if (sym)
+               hash(sym, 0);
+#endif
+       p = defnl(sym, cls, typ, val);
+       if (sym)
+               enter(p);
+       return (p);
+}
+
+/*
+ * Free up the name list segments
+ * at the end of a statement/proc/func
+ * All segments are freed down to the one in which
+ * p points.
+ */
+nlfree(p)
+       struct nl *p;
+{
+
+       nlp = p;
+       while (nlact->nls_low > nlp || nlact->nls_high < nlp) {
+               free(nlact->nls_low);
+               nlact->nls_low = NIL;
+               nlact->nls_high = NIL;
+               --nlact;
+               if (nlact < &ntab[0])
+                       panic("nlfree");
+       }
+}
+#endif
+\f
+char   VARIABLE[]      "variable";
+
+char   *classes[] {
+       "undefined",
+       "constant",
+       "type",
+       VARIABLE,
+       "array",
+       "pointer or file",
+       "record",
+       "field",
+       "procedure",
+       "function",
+       VARIABLE,
+       VARIABLE,
+       "pointer",
+       "file",
+       "set",
+       "subrange",
+       "label",
+       "withptr",
+       "scalar",
+       "string",
+       "program",
+       "improper",
+#ifdef DEBUG
+       "variant",
+#endif
+};
+
+char   snark[] "SNARK";
+
+#ifdef PI
+#ifdef DEBUG
+char   *ctext[]
+{
+       "BADUSE",
+       "CONST",
+       "TYPE",
+       "VAR",
+       "ARRAY",
+       "PTRFILE",
+       "RECORD",
+       "FIELD",
+       "PROC",
+       "FUNC",
+       "FVAR",
+       "REF",
+       "PTR",
+       "FILE",
+       "SET",
+       "RANGE",
+       "LABEL",
+       "WITHPTR",
+       "SCAL",
+       "STR",
+       "PROG",
+       "IMPROPER",
+       "VARNT"
+};
+
+char   *stars  "\t***";
+
+/*
+ * Dump the namelist from the
+ * current nlp down to 'to'.
+ * All the namelist is dumped if
+ * to is NIL.
+ */
+dumpnl(to, rout)
+       struct nl *to;
+{
+       register struct nl *p;
+       register int j;
+       struct nls *nlsp;
+       int i, v, head;
+
+       if (opt('y') == 0)
+               return;
+       if (to != NIL)
+               printf("\n\"%s\" Block=%d\n", rout, cbn);
+       nlsp = nlact;
+       head = NIL;
+       for (p = nlp; p != to;) {
+               if (p == nlsp->nls_low) {
+                       if (nlsp == &ntab[0])
+                               break;
+                       nlsp--;
+                       p = nlsp->nls_high;
+               }
+               p--;
+               if (head == NIL) {
+                       printf("\tName\tClass  Bn+Flags\tType\tVal\tChn\n");
+                       head++;
+               }
+               printf("%3d:", nloff(p));
+               if (p->symbol)
+                       printf("\t%.7s", p->symbol);
+               else
+                       printf(stars);
+               if (p->class)
+                       printf("\t%s", ctext[p->class]);
+               else
+                       printf(stars);
+               if (p->nl_flags) {
+                       putchar('\t');
+                       if (p->nl_flags & 037)
+                               printf("%d ", p->nl_flags & 037);
+#ifndef PI0
+                       if (p->nl_flags & NMOD)
+                               putchar('M');
+                       if (p->nl_flags & NUSED)
+                               putchar('U');
+#endif
+                       if (p->nl_flags & NFILES)
+                               putchar('F');
+               } else
+                       printf(stars);
+               if (p->type)
+                       printf("\t[%d]", nloff(p->type));
+               else
+                       printf(stars);
+               v = p->value[0];
+               switch (p->class) {
+                       case TYPE:
+                               break;
+                       case VARNT:
+                               goto con;
+                       case CONST:
+                               switch (nloff(p->type)) {
+                                       default:
+                                               printf("\t%d", v);
+                                               break;
+                                       case TDOUBLE:
+                                               printf("\t%f", p->real);
+                                               break;
+                                       case TINT:
+con:
+                                               printf("\t%ld", p->range[0]);
+                                               break;
+                                       case TSTR:
+                                               printf("\t'%s'", v);
+                                               break;
+                                       }
+                               break;
+                       case VAR:
+                       case REF:
+                       case WITHPTR:
+                               printf("\t%d,%d", cbn, v);
+                               break;
+                       case SCAL:
+                       case RANGE:
+                               printf("\t%ld..%ld", p->range[0], p->range[1]);
+                               break;
+                       case RECORD:
+                               printf("\t%d(%d)", v, p->value[NL_FLDSZ]);
+                               break;
+                       case FIELD:
+                               printf("\t%d", v);
+                               break;
+                       case STR:
+                               printf("\t\"%s\"", p->value[1]);
+                               goto casedef;
+                       case FVAR:
+                       case FUNC:
+                       case PROC:
+                       case PROG:
+                               if (cbn == 0) {
+                                       printf("\t<%o>", p->value[0] & 0377);
+#ifndef PI0
+                                       if (p->value[0] & NSTAND)
+                                               printf("\tNSTAND");
+#endif
+                                       break;
+                               }
+                               v = p->value[1];
+                       default:
+casedef:
+                               if (v)
+                                       printf("\t<%d>", v);
+                               else
+                                       printf(stars);
+               }
+               if (p->chain)
+                       printf("\t[%d]", nloff(p->chain));
+               switch (p->class) {
+                       case RECORD:
+                               if (p->value[NL_VARNT])
+                                       printf("\tVARNT=[%d]", nloff(p->value[NL_VARNT]));
+                               if (p->value[NL_TAG])
+                                       printf(" TAG=[%d]", nloff(p->value[NL_TAG]));
+                               break;
+                       case VARNT:
+                               printf("\tVTOREC=[%d]", nloff(p->value[NL_VTOREC]));
+                               break;
+               }
+               putchar('\n');
+       }
+       if (head == 0)
+               printf("\tNo entries\n");
+}
+#endif
+
+\f
+/*
+ * Define a new name list entry
+ * with initial symbol, class, type
+ * and value[0] as given.  A new name
+ * list segment is allocated to hold
+ * the next name list slot if necessary.
+ */
+defnl(sym, cls, typ, val)
+       char *sym;
+       int cls;
+       struct nl *typ;
+       int val;
+{
+       register struct nl *p;
+       register int *q, i;
+       char *cp;
+
+       p = nlp;
+
+       /*
+        * Zero out this entry
+        */
+       q = p;
+       i = (sizeof *p)/2;
+       do
+               *q++ = 0;
+       while (--i);
+
+       /*
+        * Insert the values
+        */
+       p->symbol = sym;
+       p->class = cls;
+       p->type = typ;
+       p->nl_block = cbn;
+       p->value[0] = val;
+
+       /*
+        * Insure that the next namelist
+        * entry actually exists. This is
+        * really not needed here, it would
+        * suffice to do it at entry if we
+        * need the slot.  It is done this
+        * way because, historically, nlp
+        * always pointed at the next namelist
+        * slot.
+        */
+       nlp++;
+       if (nlp >= nlact->nls_high) {
+               i = NLINC;
+               cp = alloc(NLINC * sizeof *nlp);
+               if (cp == -1) {
+                       i = NLINC / 2;
+                       cp = alloc((NLINC / 2) * sizeof *nlp);
+               }
+               if (cp == -1) {
+                       error("Ran out of memory (defnl)");
+                       pexit(DIED);
+               }
+               nlact++;
+               if (nlact >= &ntab[MAXNL]) {
+                       error("Ran out of name list tables");
+                       pexit(DIED);
+               }
+               nlp = cp;
+               nlact->nls_low = nlp;
+               nlact->nls_high = nlact->nls_low + i;
+       }
+       return (p);
+}
+
+/*
+ * Make a duplicate of the argument
+ * namelist entry for, e.g., type
+ * declarations of the form 'type a = b'
+ * and array indicies.
+ */
+nlcopy(p)
+       struct nl *p;
+{
+       register int *p1, *p2, i;
+
+       p1 = p;
+       p = p2 = defnl(0, 0, 0, 0);
+       i = (sizeof *p)/2;
+       do
+               *p2++ = *p1++;
+       while (--i);
+       return (p);
+}
+
+/*
+ * Compute a namelist offset
+ */
+nloff(p)
+       struct nl *p;
+{
+
+       return (p - nl);
+}
+\f
+/*
+ * Enter a symbol into the block
+ * symbol table.  Symbols are hashed
+ * 64 ways based on low 6 bits of the
+ * character pointer into the string
+ * table.
+ */
+enter(np)
+       struct nl *np;
+{
+       register struct nl *rp, *hp;
+       register struct nl *p;
+       int i;
+
+       rp = np;
+       if (rp == NIL)
+               return (NIL);
+#ifndef PI1
+       if (cbn > 0)
+               if (rp->symbol == input->symbol || rp->symbol == output->symbol)
+                       error("Pre-defined files input and output must not be redefined");
+#endif
+       i = rp->symbol;
+       i =& 077;
+       hp = disptab[i];
+       if (rp->class != BADUSE && rp->class != FIELD)
+       for (p = hp; p != NIL && (p->nl_block & 037) == cbn; p = p->nl_next)
+               if (p->symbol == rp->symbol && p->class != BADUSE && p->class != FIELD) {
+#ifndef PI1
+                       error("%s is already defined in this block", rp->symbol);
+#endif
+                       break;
+
+               }
+       rp->nl_next = hp;
+       disptab[i] = rp;
+       return (rp);
+}
+#endif
+
+double MININT          -2147483648.;
+double MAXINT          2147483647.;

diff --git a/src/pi0/opcode.h b/src/pi0/opcode.h
new file mode 100644 (file)
index 0000000..c54f7ce
--- /dev/null
+++ b/src/pi0/opcode.h
@@ -0,0 +1,2 @@
+/* Copyright (c) 1979 Regents of the University of California */
+/* surrogate */

diff --git a/src/pi0/rec.c b/src/pi0/rec.c
new file mode 100644 (file)
index 0000000..49d0b08
--- /dev/null
+++ b/src/pi0/rec.c
@@ -0,0 +1,241 @@
+/* Copyright (c) 1979 Regents of the University of California */
+#
+/*
+ * pi - Pascal interpreter code translator
+ *
+ * Charles Haley, Bill Joy UCB
+ * Version 1.2 January 1979
+ */
+
+#include "0.h"
+#include "tree.h"
+#include "opcode.h"
+
+/*
+ * 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.
+ *
+ * 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.
+ *
+ * The involved processing here is in computing the NL_OFFS entry
+ * by maxing over the variants.  This works as follows.
+ *
+ * Each RECORD has two size counters.  NL_OFFS is the maximum size
+ * so far of any variant of this record;  NL_FLDSZ gives the size
+ * of just the FIELDs to this point as a base for further variants.
+ *
+ * As we process each variant record, we start its size with the
+ * NL_FLDSZ we have so far.  After processing it, if its NL_OFFS
+ * is the largest so far, we update the NL_OFFS of this subrecord.
+ * This will eventually propagate back and update the NL_OFFS of the
+ * entire record.
+ */
+
+/*
+ * P0 points to the outermost RECORD for name searches.
+ */
+struct nl *P0;
+
+tyrec(r, off)
+       int *r, off;
+{
+
+       tyrec1(r, off, 1);
+}
+
+/*
+ * Define a record namelist entry.
+ * R is the tree for the record to be built.
+ * Off is the offset for the first item in this (sub)record.
+ */
+tyrec1(r, off, first)
+       register int *r;
+       int off;
+       char first;
+{
+       register struct nl *p, *P0was;
+
+       p = defnl(0, RECORD, 0, 0);
+       P0was = P0;
+       if (first)
+               P0 = p;
+#ifndef PI0
+       p->value[NL_FLDSZ] = p->value[NL_OFFS] = off;
+#endif
+       if (r != NIL) {
+               fields(p, r[2]);
+               variants(p, r[3]);
+       }
+       P0 = P0was;
+       return (p);
+}
+
+/*
+ * Define the fixed part fields for p.
+ */
+fields(p, r)
+       struct nl *p;
+       int *r;
+{
+       register int *fp, *tp, *ip;
+       struct nl *jp;
+
+       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])
+                       deffld(p, ip[1], jp);
+       }
+}
+
+/*
+ * Define the variants for RECORD p.
+ */
+variants(p, r)
+       struct nl *p;
+       register int *r;
+{
+       register int *vc, *v;
+       int *vr;
+       struct nl *ct;
+
+       if (r == NIL)
+               return;
+       ct = gtype(r[3]);
+       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->value[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], p->value[NL_FLDSZ], 0);
+#ifndef PI0
+               if (vr->value[NL_OFFS] > p->value[NL_OFFS])
+                       p->value[NL_OFFS] = vr->value[NL_OFFS];
+#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.
+ */
+deffld(p, s, t)
+       struct nl *p;
+       register char *s;
+       register struct nl *t;
+{
+       register struct nl *fp;
+
+       if (reclook(P0, s) != NIL) {
+#ifndef PI1
+               error("%s is a duplicate field name in this record", s);
+#endif
+               s = NIL;
+       }
+#ifndef PI0
+       fp = enter(defnl(s, FIELD, t, p->value[NL_OFFS]));
+#else
+       fp = enter(defnl(s, FIELD, t, 0));
+#endif
+       if (s != NIL) {
+               fp->chain = P0->chain;
+               P0->chain = fp;
+#ifndef PI0
+               p->value[NL_FLDSZ] = p->value[NL_OFFS] =+ even(width(t));
+#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.
+ */
+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)) {
+#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
+       av->chain = p->value[NL_VARNT];
+       p->value[NL_VARNT] = av;
+       av->value[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->value[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.
+ */
+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);
+}