BSD 2 development

Work on file src/pi0/fdec.c
Work on file src/pi0/hash.c
Work on file src/pi0/lab.c

Synthesized-from: 2bsd

diff --git a/src/pi0/fdec.c b/src/pi0/fdec.c
new file mode 100644 (file)
index 0000000..dc0c159
--- /dev/null
+++ b/src/pi0/fdec.c
@@ -0,0 +1,328 @@
+/* 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"
+
+/*
+ * Funchdr inserts
+ * declaration of a the
+ * prog/proc/func into the
+ * namelist. It also handles
+ * the arguments and puts out
+ * a transfer which defines
+ * the entry point of a procedure.
+ */
+
+funchdr(r)
+       int *r;
+{
+       register struct nl *p;
+       register *il, **rl;
+       int *rll, o;
+       struct nl *cp, *dp, *sp;
+       int *pp;
+
+       send(REVFHDR, r);
+       if (inpflist(r[2])) {
+               opush('l');
+               yyretrieve();   /* kludge */
+       }
+       line = r[1];
+       if (r[3] == NIL && (p=lookup1(r[2])) != NIL && bn == cbn) {
+               /*
+                * Symbol already defined
+                * in this block. it is either
+                * a redeclared symbol (error)
+                * or a forward declaration.
+                */
+               if ((p->class == FUNC || p->class == PROC) && (p->nl_flags & NFORWD) != 0) {
+                       /*
+                        * Grammar doesnt forbid
+                        * types on a resolution
+                        * of a forward function
+                        * declaration.
+                        */
+                       if (p->class == FUNC && r[4])
+                               error("Function type should be given only in forward declaration");
+                       return (p);
+               }
+       }
+       /*
+        * Declare the prog/proc/func
+        */
+       switch (r[0]) {
+               case T_PROG:
+                       program = p = defnl(r[2], PROG, 0, 0);
+                       break;
+               case T_PDEC:
+                       if (r[4] != NIL)
+                               error("Procedures do not have types, only functions do");
+                       p = enter(defnl(r[2], PROC, 0, 0));
+                       break;
+               case T_FDEC:
+                       il = r[4];
+                       if (il == NIL)
+                               error("Function type must be specified");
+                       else if (il[0] != T_TYID) {
+                               il = NIL;
+                               error("Function type can be specified only by using a type identifier");
+                       } else
+                               il = gtype(il);
+                       p = enter(defnl(r[2], FUNC, il, NIL));
+                       /*
+                        * An arbitrary restriction
+                        */
+                       switch (o = classify(p->type)) {
+                               case TFILE:
+                               case TARY:
+                               case TREC:
+                               case TSET:
+                               case TSTR:
+                                       warning();
+                                       if (opt('s'))
+                                               standard();
+                                       error("Functions should not return %ss", clnames[o]);
+                       }
+                       break;
+               default:
+                       panic("funchdr");
+               }
+       if (r[0] != T_PROG) {
+               /*
+                * Mark this proc/func as
+                * begin forward declared
+                */
+               p->nl_flags =| NFORWD;
+               /*
+                * Enter the parameters
+                * in the next block for
+                * the time being
+                */
+               if (++cbn >= DSPLYSZ) {
+                       error("Procedure/function nesting too deep");
+                       pexit(ERRS);
+               }
+               /*
+                * For functions, the function variable
+                */
+               if (p->class == FUNC) {
+                       cp = defnl(r[2], FVAR, p->type, 0);
+                       cp->chain = p;
+                       p->value[NL_FVAR] = cp;
+               }
+               /*
+                * Enter the parameters
+                */
+               cp = sp = p;
+               for (rl = r[3]; rl != NIL; rl = rl[2]) {
+                       p = NIL;
+                       if (rl[1] == NIL)
+                               continue;
+                       /*
+                        * Parametric procedures
+                        * don't have types
+                        */
+                       if (rl[1][0] != T_PPROC) {
+                               rll = rl[1][2];
+                               if (rll[0] != T_TYID) {
+                                       error("Types for arguments can be specified only by using type identifiers");
+                                       p = NIL;
+                               } else
+                                       p = gtype(rll);
+                       }
+                       for (il = rl[1][1]; il != NIL; il = il[2]) {
+                               switch (rl[1][0]) {
+                                       default:
+                                               panic("funchdr2");
+                                       case T_PVAL:
+                                               if (p != NIL) {
+                                                       if (p->class == FILE)
+                                                               error("Files cannot be passed by value");
+                                                       else if (p->nl_flags & NFILES)
+                                                               error("Files cannot be a component of %ss passed by value",
+                                                                       nameof(p));
+                                               }
+                                               dp = defnl(il[1], VAR, p, 0);
+                                               break;
+                                       case T_PVAR:
+                                               dp = defnl(il[1], REF, p, 0);
+                                               break;
+                                       case T_PFUNC:
+                                       case T_PPROC:
+                                               error("Procedure/function parameters not implemented");
+                                               continue;
+                                       }
+                               if (dp != NIL) {
+                                       cp->chain = dp;
+                                       cp = dp;
+                               }
+                       }
+               }
+               cbn--;
+               p = sp;
+       } else { 
+               cp = p;
+               for (rl = r[3]; rl; rl = rl[2]) {
+                       if (rl[1] == NIL)
+                               continue;
+                       dp = defnl(rl[1], VAR, 0, 0);
+                       cp->chain = dp;
+                       cp = dp;
+               }
+       }
+       return (p);
+}
+
+/*
+ * Funcbody is called
+ * when the actual (resolved)
+ * declaration of a procedure is
+ * encountered. It puts the names
+ * of the (function) and parameters
+ * into the symbol table.
+ */
+funcbody(fp)
+       struct nl *fp;
+{
+       register struct nl *q, *p;
+
+       cbn++;
+       if (cbn >= DSPLYSZ) {
+               error("Too many levels of function/procedure nesting");
+               pexit(ERRS);
+       }
+       send(REVFBDY);
+       errcnt[cbn] = syneflg;
+       parts = NIL;
+       if (fp == NIL)
+               return (NIL);
+       /*
+        * Save the virtual name
+        * list stack pointer so
+        * the space can be freed
+        * later (funcend).
+        */
+       fp->value[2] = nlp;
+       if (fp->class != PROG)
+               for (q = fp->chain; q != NIL; q = q->chain)
+                       enter(q);
+       if (fp->class == FUNC) {
+               /*
+                * For functions, enter the fvar
+                */
+               enter(fp->value[NL_FVAR]);
+       }
+       return (fp);
+}
+
+int    pnumcnt;
+struct nl *Fp;
+/*
+ * Funcend is called to
+ * finish a block by generating
+ * the code for the statements.
+ * It then looks for unresolved declarations
+ * of labels, procedures and functions,
+ * and cleans up the name list.
+ * For the program, it checks the
+ * semantics of the program
+ * statement (yuchh).
+ */
+funcend(fp, bundle, endline)
+       struct nl *fp;
+       int *bundle;
+       int endline;
+{
+       register struct nl *p;
+       register int i, b;
+       int *blk;
+       char *cp;
+
+       blk = bundle[2];
+       if (fp == NIL) {
+               cbn--;
+               return;
+       }
+       send(REVFEND, bundle, endline, syneflg == errcnt[cbn]);
+       if (Fp != NIL)
+               Fp = fp;
+       /*
+        * Clean up the symbol table displays and check for unresolves
+        */
+       line = endline;
+       b = cbn;
+       for (i = 0; i <= 077; i++) {
+               for (p = disptab[i]; p != NIL && (p->nl_block & 037) == b; p = p->nl_next)
+               if (p->class == BADUSE) {
+                       cp = "s";
+                       if (p->chain->ud_next == NIL)
+                               cp++;
+                       eholdnl();
+                       if (p->value[NL_KINDS] & ISUNDEF)
+                               nerror("%s undefined on line%s", p->symbol, cp);
+                       else
+                               nerror("%s improperly used on line%s", p->symbol, cp);
+                       pnumcnt = 10;
+                       pnums(p->chain);
+                       putchar('\n');
+               }
+               /*
+                * Pop this symbol
+                * table slot
+                */
+               disptab[i] = p;
+       }
+
+#ifdef DEBUG
+       dumpnl(fp->value[2], fp->symbol);
+#endif
+       /*
+        * Restore the
+        * (virtual) name list
+        * position
+        */
+       nlfree(fp->value[2]);
+       /*
+        * Proc/func has been
+        * resolved
+        */
+       fp->nl_flags =& ~NFORWD;
+       elineon();
+       cbn--;
+       if (inpflist(fp->symbol)) {
+               opop('l');
+       }
+}
+
+pnums(p)
+       struct udinfo *p;
+{
+
+       if (p->ud_next != NIL)
+               pnums(p->ud_next);
+       if (pnumcnt == 0) {
+               printf("\n\t");
+               pnumcnt = 20;
+       }
+       pnumcnt--;
+       printf(" %d", p->ud_line);
+}
+
+nerror(a1, a2, a3)
+{
+
+       if (Fp != NIL) {
+               yySsync();
+               printf("In %s %s:\n", classes[Fp->class], Fp->symbol);
+               Fp = NIL;
+       }
+       elineoff();
+       error(a1, a2, a3);
+}

diff --git a/src/pi0/hash.c b/src/pi0/hash.c
new file mode 100644 (file)
index 0000000..1f534d3
--- /dev/null
+++ b/src/pi0/hash.c
@@ -0,0 +1,189 @@
+/* Copyright (c) 1979 Regents of the University of California */
+#
+/*
+ * pi - Pascal interpreter code translator
+ *
+ * Charles Haley, Bill Joy UCB
+ * Version 1.2 January 1979
+ *
+ *
+ * pxp - Pascal execution profiler
+ *
+ * Bill Joy UCB
+ * Version 1.2 January 1979
+ */
+
+#include "0.h"
+#include "yy.h"
+
+/*
+ * The definition for the segmented hash tables.
+ */
+struct ht {
+       int     *ht_low;
+       int     *ht_high;
+       int     ht_used;
+} htab[MAXHASH];
+
+/*
+ * This is the array of keywords and their
+ * token values, which are hashed into the table
+ * by inithash.
+ */
+struct kwtab yykey[] {
+       "and",          YAND,
+       "array",        YARRAY,
+       "assert",       YASSERT,
+       "begin",        YBEGIN,
+       "case",         YCASE,
+       "const",        YCONST,
+       "div",          YDIV,
+       "do",           YDO,
+       "downto",       YDOWNTO,
+       "else",         YELSE,
+       "end",          YEND,
+       "file",         YFILE,
+       "for",          YFOR,
+       "forward",      YFORWARD,
+       "function",     YFUNCTION,
+       "goto",         YGOTO,
+       "if",           YIF,
+       "in",           YIN,
+       "label",        YLABEL,
+       "mod",          YMOD,
+       "nil",          YNIL,
+       "not",          YNOT,
+       "of",           YOF,
+       "or",           YOR,
+       "packed",       YPACKED,
+       "procedure",    YPROCEDURE,
+       "program",      YPROG,
+       "record",       YRECORD,
+       "repeat",       YREPEAT,
+       "set",          YSET,
+       "then",         YTHEN,
+       "to",           YTO,
+       "type",         YTYPE,
+       "until",        YUNTIL,
+       "var",          YVAR,
+       "while",        YWHILE,
+       "with",         YWITH,
+       "oct",          YOCT,    /* non-standard Pascal */
+       "hex",          YHEX,    /* non-standard Pascal */
+       0
+};
+
+char   *lastkey        &yykey[sizeof yykey/sizeof yykey[0]];
+
+/*
+ * Inithash initializes the hash table routines
+ * by allocating the first hash table segment using
+ * an already existing memory slot.
+ */
+#ifndef PI0
+inithash()
+#else
+inithash(hshtab)
+       int *hshtab;
+#endif
+{
+       register int *ip;
+#ifndef PI0
+       static int hshtab[HASHINC];
+#endif
+
+       htab[0].ht_low = hshtab;
+       htab[0].ht_high = &hshtab[HASHINC];
+       for (ip = yykey; *ip; ip =+ 2)
+               hash(ip[0], 0)[0] = ip;
+}
+
+/*
+ * Hash looks up the s(ymbol) argument
+ * in the string table, entering it if
+ * it is not found. If save is 0, then
+ * the argument string is already in
+ * a safe place. Otherwise, if hash is
+ * entering the symbol for the first time
+ * it will save the symbol in the string
+ * table using savestr.
+ */
+int *hash(s, save)
+       char *s;
+       int save;
+{
+       register int *h;
+       register i;
+       register char *cp;
+       int *sym;
+       struct ht *htp;
+       int sh;
+
+       /*
+        * The hash function is a modular hash of
+        * the sum of the characters with the sum
+        * doubled before each successive character
+        * is added.
+        */
+       cp = s;
+       if (cp == NIL)
+               cp = token;     /* default symbol to be hashed */
+       i = 0;
+       while (*cp)
+               i = i*2 + *cp++;
+       sh = (i&077777) % HASHINC;
+       cp = s;
+       if (cp == NIL)
+               cp = token;
+       /*
+        * There are as many as MAXHASH active
+        * hash tables at any given point in time.
+        * The search starts with the first table
+        * and continues through the active tables
+        * as necessary.
+        */
+       for (htp = htab; htp < &htab[MAXHASH]; htp++) {
+               if (htp->ht_low == NIL) {
+                       cp = calloc(2, HASHINC);
+                       if (cp == -1) {
+                               yerror("Ran out of memory (hash)");
+                               pexit(DIED);
+                       }
+                       htp->ht_low = cp;
+                       htp->ht_high = htp->ht_low + HASHINC;
+                       cp = s;
+                       if (cp == NIL)
+                               cp = token;
+               }
+               h = htp->ht_low + sh;
+               /*
+                * quadratic rehash increment
+                * starts at 1 and incremented
+                * by two each rehash.
+                */
+               i = 1;
+               do {
+                       if (*h == 0) {
+                               if (htp->ht_used > (HASHINC * 3)/4)
+                                       break;
+                               htp->ht_used++;
+                               if (save != 0) {
+                                       *h = savestr(cp);
+                               } else
+                                       *h = s;
+                               return (h);
+                       }
+                       sym = *h;
+                       if (sym < lastkey && sym >= yykey)
+                               sym = *sym;
+                       if (sym->pchar == *cp && strcmp(sym, cp) == 0)
+                               return (h);
+                       h =+ i;
+                       i =+ 2;
+                       if (h >= htp->ht_high)
+                               h =- HASHINC;
+               } while (i < HASHINC);
+       }
+       yerror("Ran out of hash tables");
+       pexit(DIED);
+}

diff --git a/src/pi0/lab.c b/src/pi0/lab.c
new file mode 100644 (file)
index 0000000..2e01336
--- /dev/null
+++ b/src/pi0/lab.c
@@ -0,0 +1,124 @@
+/* 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"
+
+/*
+ * Label enters the definitions
+ * of the label declaration part
+ * into the namelist.
+ */
+label(r, l)
+       int *r, l;
+{
+#ifndef PI0
+       register *ll;
+       register struct nl *p, *lp;
+
+       lp = NIL;
+#else
+       send(REVLAB, r);
+#endif
+       line = l;
+#ifndef PI1
+       if (parts & (CPRT|TPRT|VPRT))
+               error("Label declarations must precede const, type and var declarations");
+       if (parts & LPRT)
+               error("All labels must be declared in one label part");
+       parts =| LPRT;
+#endif
+#ifndef PI0
+       for (ll = r; ll != NIL; ll = ll[2]) {
+               l = getlab();
+               p = enter(defnl(ll[1], LABEL, 0, l));
+               /*
+                * Get the label for the eventual target
+                */
+               p->value[1] = getlab();
+               p->chain = lp;
+               p->nl_flags =| (NFORWD|NMOD);
+               p->value[NL_GOLEV] = NOTYET;
+               lp = p;
+               /*
+                * This operator is between
+                * the bodies of two procedures
+                * and provides a target for
+                * gotos for this label via TRA.
+                */
+               putlab(l);
+               put2(O_GOTO | cbn<<9, p->value[1]);
+       }
+       gotos[cbn] = lp;
+#endif
+}
+
+#ifndef PI0
+/*
+ * Gotoop is called when
+ * we get a statement "goto label"
+ * and generates the needed tra.
+ */
+gotoop(s)
+       char *s;
+{
+       register struct nl *p;
+
+       gocnt++;
+       p = lookup(s);
+       if (p == NIL)
+               return (NIL);
+       put2(O_TRA, p->value[0]);
+       if (bn == cbn)
+               if (p->nl_flags & NFORWD) {
+                       if (p->value[NL_GOLEV] == NOTYET) {
+                               p->value[NL_GOLEV] = level;
+                               p->value[NL_GOLINE] = line;
+                       }
+               } else
+                       if (p->value[NL_GOLEV] == DEAD) {
+                               recovered();
+                               error("Goto %s is into a structured statement", p->symbol);
+                       }
+}
+
+/*
+ * Labeled is called when a label
+ * definition is encountered, and
+ * marks that it has been found and
+ * patches the associated GOTO generated
+ * by gotoop.
+ */
+labeled(s)
+       char *s;
+{
+       register struct nl *p;
+
+       p = lookup(s);
+       if (p == NIL)
+               return (NIL);
+       if (bn != cbn) {
+               error("Label %s not defined in correct block", s);
+               return;
+       }
+       if ((p->nl_flags & NFORWD) == 0) {
+               error("Label %s redefined", s);
+               return;
+       }
+       p->nl_flags =& ~NFORWD;
+       patch(p->value[1]);
+       if (p->value[NL_GOLEV] != NOTYET)
+               if (p->value[NL_GOLEV] < level) {
+                       recovered();
+                       error("Goto %s from line %d is into a structured statement", s, p->value[NL_GOLINE]);
+               }
+       p->value[NL_GOLEV] = level;
+}
+#endif