From 3f1a8e9e7bdb2642c087515bae27101442671c8c Mon Sep 17 00:00:00 2001 From: Bill Joy Date: Wed, 9 May 1979 18:51:42 -0800 Subject: [PATCH] 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 --- src/pi0/nl.c | 690 +++++++++++++++++++++++++++++++++++++++++++++++ src/pi0/opcode.h | 2 + src/pi0/rec.c | 241 +++++++++++++++++ 3 files changed, 933 insertions(+) create mode 100644 src/pi0/nl.c create mode 100644 src/pi0/opcode.h create mode 100644 src/pi0/rec.c diff --git a/src/pi0/nl.c b/src/pi0/nl.c new file mode 100644 index 0000000000..4f632dfb1b --- /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 +}; + +/* + * 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 + +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 + + +/* + * 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); +} + +/* + * 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 index 0000000000..c54f7cec39 --- /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 index 0000000000..49d0b08570 --- /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); +} -- 2.20.1