--- /dev/null
+#
+/*
+ * pi - Pascal interpreter code translator
+ *
+ * Charles Haley, Bill Joy UCB
+ * Version 1.0 August 1977
+ *
+ *
+ * pxp - Pascal execution profiler
+ *
+ * Bill Joy UCB
+ * Version 1.0 August 1977
+ */
+
+#include "whoami"
+#include "0.h"
+#include "yy.h"
+
+/*
+ * Yerror prints an error
+ * message and then returns
+ * NIL for the tree if needed.
+ * The error is flagged on the
+ * current line which is printed
+ * if the listing is turned off.
+#ifdef PXP
+ *
+ * As is obvious from the fooling around
+ * with fout below, the Pascal system should
+ * be changed to use the new library "lS".
+#endif
+ */
+yerror(s, a1, a2, a3, a4, a5)
+ char *s;
+{
+#ifdef PI
+ char buf[256];
+#endif
+ register int i, j;
+ static yySerrs;
+#ifdef PXP
+ int ofout;
+#endif
+
+ if (errpfx == 'w' && opt('w') != 0)
+ return;
+#ifdef PXP
+ xflush();
+ ofout = fout[0];
+ fout[0] = errout;
+#endif
+ yyResume = 0;
+#ifdef PI
+ geterr(s, buf);
+ s = buf;
+#endif
+ yysync();
+ putchar(errpfx);
+ putchar(' ');
+ for (i = 3; i < yyecol; i++)
+ putchar('-');
+ printf("^--- ");
+/*
+ if (yyecol > 60)
+ printf("\n\t");
+*/
+ printf(s, a1, a2, a3, a4, a5);
+ putchar('\n');
+ if (errpfx == 'E')
+#ifdef PI
+ eflg++, cgenflg++;
+#endif
+#ifdef PXP
+ eflg++;
+#endif
+ errpfx = 'E';
+ yySerrs++;
+ if (yySerrs >= MAXSYNERR) {
+ yySerrs = 0;
+ yerror("Too many syntax errors - QUIT");
+ pexit(ERRS);
+ }
+#ifdef PXP
+ xflush();
+ fout[0] = ofout;
+ return (0);
+#endif
+}
+
+/*
+ * A bracketing error message
+ */
+brerror(where, what)
+ int where;
+ char *what;
+{
+
+ if (where == 0) {
+ line = yyeline;
+ setpfx(' ');
+ error("End matched %s on line %d", what, where);
+ return;
+ }
+ if (where < 0)
+ where = -where;
+ yerror("Inserted keyword end matching %s on line %d", what, where);
+}
--- /dev/null
+#
+/*
+ * pi - Pascal interpreter code translator
+ *
+ * Charles Haley, Bill Joy UCB
+ * Version 1.0 August 1977
+ *
+ *
+ * pxp - Pascal execution profiler
+ *
+ * Bill Joy UCB
+ * Version 1.0 August 1977
+ */
+
+#include "whoami"
+#include "0.h"
+#include "yy.h"
+
+#ifdef PI
+extern int *yypv;
+/*
+ * Determine whether the identifier whose name
+ * is "cp" can possibly be a kind, which is a
+ * namelist class. We look through the symbol
+ * table for the first instance of cp as a non-field,
+ * and at all instances of cp as a field.
+ * If any of these are ok, we return true, else false.
+ * It would be much better to handle with's correctly,
+ * even to just know whether we are in a with at all.
+ *
+ * Note that we don't disallow constants on the lhs of assignment.
+ */
+identis(cp, kind)
+ register char *cp;
+ int kind;
+{
+ register struct nl *p;
+ int i;
+
+ /*
+ * Cp is NIL when error recovery inserts it.
+ */
+ if (cp == NIL)
+ return (1);
+
+ /*
+ * Record kind we want for possible later use by yyrecover
+ */
+ yyidwant = kind;
+ yyidhave = NIL;
+ i = cp & 077;
+ for (p = disptab[i]; p != NIL; p = p->nl_next)
+ if (p->symbol == cp) {
+ if (yyidok(p, kind))
+ goto gotit;
+ if (p->class != FIELD && p->class != BADUSE)
+ break;
+ }
+ if (p != NIL)
+ for (p = p->nl_next; p != NIL; p = p->nl_next)
+ if (p->symbol == cp && p->class == FIELD && yyidok(p, kind))
+ goto gotit;
+ return (0);
+gotit:
+ if (p->class == BADUSE && !Recovery) {
+ yybadref(p, OY.Yyeline);
+ yypv[0] = NIL;
+ }
+ return (1);
+}
+\f
+/*
+ * A bad reference to the identifier cp on line
+ * line and use implying the addition of kindmask
+ * to the mask of kind information.
+ */
+yybaduse(cp, line, kindmask)
+ register char *cp;
+ int line, kindmask;
+{
+ register struct nl *p, *oldp;
+ int i;
+
+ i = cp & 077;
+ for (p = disptab[i]; p != NIL; p = p->nl_next)
+ if (p->symbol == cp)
+ break;
+ oldp = p;
+ if (p == NIL || p->class != BADUSE)
+ p = enter(defnl(cp, BADUSE, 0, 0));
+ p->value[NL_KINDS] =| kindmask;
+ yybadref(p, line);
+ return (oldp);
+}
+
+struct udinfo ud { -1, -1, 0};
+/*
+ * Record a reference to an undefined identifier,
+ * or one which is improperly used.
+ */
+yybadref(p, line)
+ register struct nl *p;
+ int line;
+{
+ register struct udinfo *udp;
+
+ if (p->chain != NIL && p->chain->ud_line == line)
+ return;
+ udp = esavestr(&ud);
+ udp->ud_line = line;
+ udp->ud_next = p->chain;
+ p->chain = udp;
+}
+
+#define varkinds ((1<<CONST)|(1<<VAR)|(1<<REF)|(1<<ARRAY)|(1<<PTR)|(1<<RECORD)|(1<<FIELD)|(1<<FUNC)|(1<<FVAR))
+/*
+ * Is the symbol in the p entry of the namelist
+ * even possibly a kind kind? If not, update
+ * what we have based on this encounter.
+ */
+yyidok(p, kind)
+ register struct nl *p;
+ int kind;
+{
+
+ if (p->class == BADUSE) {
+ if (kind == VAR)
+ return (p->value[0] & varkinds);
+ return (p->value[0] & (1 << kind));
+ }
+ if (yyidok1(p, kind))
+ return (1);
+ if (yyidhave != NIL)
+ yyidhave = IMPROPER;
+ else
+ yyidhave = p->class;
+ return (0);
+}
+
+yyidok1(p, kind)
+ register struct nl *p;
+ int kind;
+{
+ int i;
+
+ switch (kind) {
+ case FUNC:
+ if (p->class == FVAR)
+ return(1);
+ case CONST:
+ case TYPE:
+ case PROC:
+ case FIELD:
+ return (p->class == kind);
+ case VAR:
+ return (p->class == CONST || yyisvar(p, NIL));
+ case ARRAY:
+ case RECORD:
+ return (yyisvar(p, kind));
+ case PTRFILE:
+ return (yyisvar(p, PTR) || yyisvar(p, FILE));
+ }
+}
+
+yyisvar(p, class)
+ register struct nl *p;
+ int class;
+{
+
+ switch (p->class) {
+ case FIELD:
+ case VAR:
+ case REF:
+ case FVAR:
+ /*
+ * We would prefer to return
+ * parameterless functions only.
+ */
+ case FUNC:
+ return (class == NIL || (p->type != NIL && p->type->class == class));
+ }
+ return (0);
+}
+#endif
+#ifdef PXP
+#ifndef DEBUG
+identis()
+{
+
+ return (1);
+}
+#endif
+#ifdef DEBUG
+extern char *classes[];
+
+char kindchars[] "UCTVAQRDPF";
+/*
+ * Fake routine "identis" for pxp when testing error recovery.
+ * Looks at letters in variable names to answer questions
+ * about attributes. Mapping is
+ * C const_id
+ * T type_id
+ * V var_id also if any of AQRDF
+ * A array_id
+ * Q ptr_id
+ * R record_id
+ * D field_id D for "dot"
+ * P proc_id
+ * F func_id
+ */
+identis(cp, kind)
+ register char *cp;
+ int kind;
+{
+ register char *dp;
+ char kindch;
+
+ /*
+ * Don't do anything unless -T
+ */
+ if (!typetest)
+ return (1);
+
+ /*
+ * Inserted symbols are always correct
+ */
+ if (cp == NIL)
+ return (1);
+ /*
+ * Set up the names for error messages
+ */
+ yyidwant = classes[kind];
+ for (dp = kindchars; *dp; dp++)
+ if (any(cp, *dp)) {
+ yyidhave = classes[dp - kindchars];
+ break;
+ }
+
+ /*
+ * U in the name means undefined
+ */
+ if (any(cp, 'U'))
+ return (0);
+
+ kindch = kindchars[kind];
+ if (kindch == 'V')
+ for (dp = "AQRDF"; *dp; dp++)
+ if (any(cp, *dp))
+ return (1);
+ return (any(cp, kindch));
+}
+#endif
+#endif
--- /dev/null
+#
+/*
+ * pi - Pascal interpreter code translator
+ *
+ * Charles Haley, Bill Joy UCB
+ * Version 1.0 August 1977
+ *
+ *
+ * pxp - Pascal execution profiler
+ *
+ * Bill Joy UCB
+ * Version 1.0 August 1977
+ */
+
+#include "whoami"
+#include "0.h"
+#include "yy.h"
+
+/*
+ * Parser for 'yacc' output.
+ * Specifially Modified for UNIX Pascal
+ */
+
+int yystate; /* Current parser state */
+int *yypv;
+unsigned yytshifts 1; /* Number of "true" shifts */
+
+/*
+ * Parse Tables
+ */
+int yygo[];
+int yypgo[];
+int yyr1[];
+int yyr2[];
+int yyact[];
+int yypact[];
+
+/*
+ * Parse and parallel semantic stack
+ */
+int yyv[MAXDEPTH];
+int yys[MAXDEPTH];
+
+/*
+ * This routine parses the input stream, and
+ * returns if it accepts, or if an unrecoverable syntax
+ * error is encountered.
+ */
+yyparse()
+{
+ register int *ps, n, *p;
+ int paniced, *panicps, idfail;
+
+ yystate = 0;
+ yychar = yylex();
+ OY.Yychar = -1;
+ yyshifts = 3;
+ paniced = 0;
+ ps = &yys[0]-1;
+ yypv = &yyv[0]-1;
+#ifdef PXP
+ yypw = &yyw[0]-1;
+#endif
+
+stack:
+ /*
+ * Push new state and value.
+ */
+ if (yypv >= &yyv[MAXDEPTH-1]) {
+ yerror("Parse stack overflow");
+ pexit(DIED);
+ }
+ *++ps = yystate;
+ *++yypv = yyval;
+#ifdef PXP
+ yypw++;
+#endif
+newstate:
+ /*
+ * Locate parsing actions for the
+ * new parser state.
+ */
+ p = &yyact[ yypact[yystate+1] ];
+actn:
+ /*
+ * Search the parse actions table
+ * for something useful to do.
+ * While n is non-positive, it is the negation
+ * of the token we are testing for.
+ */
+/*
+ if ((n = *p++) <= 0) {
+ if (yychar < 0)
+ yychar = yylex();
+ do
+ if ((n =+ yychar) != 0)
+ p++;
+ while ((n = *p++) <= 0);
+ }
+*/
+ while ((n = *p++) <= 0)
+ if ((n =+ yychar) != 0)
+ p++;
+ switch (n >> 12) {
+
+ /*
+ * Shift.
+ */
+ case 2:
+#ifdef PXP
+ yypw[1].Wseqid = yyseqid;
+ yypw[1].Wcol = yycol;
+#endif
+ OYcopy();
+ yystate = n & 07777;
+ yyval = yylval;
+/*
+ yychar = -1;
+*/
+ yychar = yylex();
+ yyshifts++;
+ yytshifts++;
+ goto stack;
+
+ /*
+ * Reduce.
+ */
+ case 3:
+ n =& 07777;
+ N = yyr2[n];
+ if (N == 1 && OY.Yychar == YID && !yyEactr(n, yypv[0])) {
+ idfail = 1;
+ goto errin;
+ }
+ OY.Yychar = -1;
+ ps =- N;
+ yypv =- N;
+#ifdef PXP
+ yypw =- N;
+#endif
+ yyval = yypv[1];
+ yyactr(n);
+ /*
+ * Use goto table to find next state.
+ */
+ p = &yygo[yypgo[yyr1[n]]];
+ while (*p != *ps && *p >= 0)
+ p =+ 2;
+ yystate = p[1];
+ goto stack;
+
+ /*
+ * Accept.
+ */
+ case 4:
+ return;
+
+ /*
+ * Error.
+ */
+ case 1:
+ idfail = 0;
+errin:
+ if ((paniced || yyshifts != 0) && yyrecover(ps, idfail)) {
+ paniced = 0;
+ ps = Ps;
+ yystate = *ps;
+ goto newstate;
+ }
+ /*
+ * Find a state where 'error' is a
+ * legal shift action.
+ */
+ if (paniced && yyshifts <= 0 && ps >= panicps) {
+ yypv =- (ps - panicps) + 1;
+#ifdef PXP
+ yypw =- (ps - panicps) + 1;
+#endif
+ ps = panicps - 1;
+ }
+ while (ps >= yys) {
+ for (p = &yyact[ yypact[*ps+1] ] ; *p <= 0; p=+ 2)
+ if (*p == -256) {
+ panicps = ps;
+ yystate= p[1] & 07777;
+ yyOshifts = yyshifts;
+ yyshifts = 0;
+ paniced = 1;
+ goto stack;
+ }
+ --ps;
+ --yypv;
+#ifdef PXP
+ --yypw;
+#endif
+#ifdef PI
+ if (OY.Yychar != YID)
+ syneflg++;
+#endif
+ OY.Yychar = -1;
+ }
+ if (yychar == YEOF)
+ yyunexeof();
+ if (yystate == 1)
+ yyexeof();
+ yerror("Unrecoverable syntax error - QUIT");
+ return;
+ }
+ panic("yyparse");
+}