BSD 4 development

Work on file usr/src/cmd/pxp/yypanic.c
Work on file usr/src/cmd/pxp/yyparse.c
Work on file usr/src/cmd/pxp/yyseman.c
Work on file usr/src/cmd/pxp/yytree.c

Synthesized-from: CSRG//cd1/4.0

diff --git a/usr/src/cmd/pxp/yypanic.c b/usr/src/cmd/pxp/yypanic.c
new file mode 100755 (executable)
index 0000000..a1752af
--- /dev/null
+++ b/usr/src/cmd/pxp/yypanic.c
@@ -0,0 +1,159 @@
+/* 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"
+
+struct yytok oldpos;
+/*
+ * The routine yyPerror coordinates the panic when
+ * the correction routines fail. Three types of panics
+ * are possible - those in a declaration part, those
+ * in a statement part, and those in an expression.
+ *
+ * Declaration part panics consider insertion of "begin",
+ * expression part panics will stop on more symbols.
+ * The panics are otherwise the same.
+ *
+ * ERROR MESSAGE SUPPRESSION STRATEGY: August 11, 1977
+ *
+ * If the parser has not made at least 2 moves since the last point of
+ * error then we want to suppress the supplied error message.
+ * Otherwise we print it.
+ * We then skip input up to the next solid symbol.
+ */
+yyPerror(cp, kind)
+       char *cp;
+       register int kind;
+{
+       register int ishifts, brlev;
+
+       copy(&oldpos, &Y, sizeof oldpos);
+       brlev = 0;
+       if (yychar < 0)
+               yychar = yylex();
+       for (ishifts = yyshifts; ; yychar = yylex(), yyshifts++)
+               switch (yychar) {
+                       case YILLCH:
+                               yerror("Illegal character");
+                               if (ishifts == yyshifts)
+                                       yyOshifts = 0;
+                               continue;
+                       case YEOF:
+                               goto quiet;
+                       case ';':
+                               if (kind == PPROG)
+                                       continue;
+                               if (kind == PDECL)
+                                       yychar = yylex();
+                               goto resume;
+                       case YEND:
+                               if (kind == PPROG)
+                                       continue;
+                       case YPROCEDURE:
+                       case YFUNCTION:
+                               goto resume;
+                       case YLABEL:
+                       case YTYPE:
+                       case YCONST:
+                       case YVAR:
+                               if (kind == PSTAT) {
+                                       yerror("Declaration found when statement expected");
+                                       goto quiet;
+                               }
+                       case YBEGIN:
+                               goto resume;
+                       case YFOR:
+                       case YREPEAT:
+                       case YWHILE:
+                       case YGOTO:
+                       case YIF:
+                               if (kind != PDECL)
+                                       goto resume;
+                               yerror("Expected keyword begin after declarations, before statements");
+                               unyylex(&Y);
+                               yychar = YBEGIN;
+                               yylval = nullsem(YBEGIN);
+                               goto quiet;
+                       case YTHEN:
+                       case YELSE:
+                       case YDO:
+                               if (kind == PSTAT) {
+                                       yychar = yylex();
+                                       goto resume;
+                               }
+                               if (kind == PEXPR)
+                                       goto resume;
+                               continue;
+                       case ')':
+                       case ']':
+                               if (kind != PEXPR)
+                                       continue;
+                               if (brlev == 0)
+                                       goto resume;
+                               if (brlev > 0)
+                                       brlev--;
+                               continue;
+                       case '(':
+                       case '[':
+                               brlev++;
+                               continue;
+                       case ',':
+                               if (brlev != 0)
+                                       continue;
+                       case YOF:
+                       case YTO:
+                       case YDOWNTO:
+                               if (kind == PEXPR)
+                                       goto resume;
+                               continue;
+#ifdef PI
+                       /*
+                        * A rough approximation for now
+                        * Should be much more lenient on suppressing
+                        * warnings.
+                        */
+                       case YID:
+                               syneflg++;
+                               continue;
+#endif
+               }
+resume:
+       if (yyOshifts >= 2) {
+               if (yychar != -1)
+                       unyylex(&Y);
+               copy(&Y, &oldpos, sizeof Y);
+               yerror(cp);
+               yychar = yylex();
+       }
+quiet:
+       if (yyshifts - ishifts > 2 && opt('r')) {
+               setpfx('r');
+               yerror("Parsing resumes");
+       }
+       /*
+        * If we paniced in the statement part,
+        * and didn't stop at a ';', then we insert
+        * a ';' to prevent the recovery from immediately
+        * inserting one and complaining about it.
+        */
+       if (kind == PSTAT && yychar != ';') {
+               unyylex(&Y);
+               yyshifts--;
+               yytshifts--;
+               yychar = ';';
+               yylval = nullsem(';');
+       }
+}

diff --git a/usr/src/cmd/pxp/yyparse.c b/usr/src/cmd/pxp/yyparse.c
new file mode 100755 (executable)
index 0000000..83addc9
--- /dev/null
+++ b/usr/src/cmd/pxp/yyparse.c
@@ -0,0 +1,212 @@
+/* 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"
+
+/*
+ * Parser for 'yacc' output.
+ * Specifially Modified for Berkeley 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.
+        */
+#ifdef PI
+       if ((n = *p++) <= 0) {
+               if (yychar < 0)
+                       yychar = yylex();
+               do
+                       if ((n =+ yychar) != 0)
+                               p++;
+               while ((n = *p++) <= 0);
+       }
+#else
+       while ((n = *p++) <= 0)
+               if ((n =+ yychar) != 0)
+                       p++;
+#endif
+       switch (n >> 12) {
+
+               /*
+                * Shift.
+                */
+               case 2:
+#ifdef PXP
+                       yypw[1].Wseqid = yyseqid;
+                       yypw[1].Wcol = yycol;
+#endif
+                       OYcopy();
+                       yystate = n & 07777;
+                       yyval = yylval;
+#ifdef PI
+                       yychar = -1;
+#else
+                       yychar = yylex();
+#endif
+                       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");
+}

diff --git a/usr/src/cmd/pxp/yyseman.c b/usr/src/cmd/pxp/yyseman.c
new file mode 100755 (executable)
index 0000000..10d4bc0
--- /dev/null
+++ b/usr/src/cmd/pxp/yyseman.c
@@ -0,0 +1,46 @@
+/* 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"
+
+/*
+ * Assign semantics to a generated token
+ *
+ * Most terminals have a semantic value the current
+ * input line.  If they are generated they are flagged
+ * by having this number negated.
+ *
+ * The terminals which have true semantics such
+ * as identifiers and strings are instead given
+ * semantic value NIL here - we do not attempt
+ * to do repair, e.g. by giving generated integers
+ * the value 1, etc.
+ */
+nullsem(ch)
+       int ch;
+{
+
+       switch (ch) {
+               case YID:
+               case YINT:
+               case YNUMB:
+               case YBINT:
+               case YSTRING:
+                       return (NIL);
+               default:
+                       return (-yyeline);
+       }
+}

diff --git a/usr/src/cmd/pxp/yytree.c b/usr/src/cmd/pxp/yytree.c
new file mode 100755 (executable)
index 0000000..5cf5cff
--- /dev/null
+++ b/usr/src/cmd/pxp/yytree.c
@@ -0,0 +1,113 @@
+/* Copyright (c) 1979 Regents of the University of California */
+#
+/*
+ * pxp - Pascal execution profiler
+ *
+ * Bill Joy UCB
+ * Version 1.2 January 1979
+ */
+
+#include "0.h"
+#include "tree.h"
+
+extern int *spacep;
+
+/*
+ * LIST MANIPULATION ROUTINES
+ *
+ * The grammar for Pascal is written left recursively.
+ * Because of this, the portions of parse trees which are to resemble
+ * lists are in the somewhat inconvenient position of having
+ * the nodes built from left to right, while we want to eventually
+ * have as semantic value the leftmost node.
+ * We could carry the leftmost node as semantic value, but this
+ * would be inefficient as to add a new node to the list we would
+ * have to chase down to the end.  Other solutions involving a head
+ * and tail pointer waste space.
+ *
+ * The simple solution to this apparent dilemma is to carry along
+ * a pointer to the leftmost node in a list in the rightmost node
+ * which is the current semantic value of the list.
+ * When we have completed building the list, we can retrieve this
+ * left end pointer very easily; neither adding new elements to the list
+ * nor finding the left end is thus expensive.  As the bottommost node
+ * has an unused next pointer in it, no space is wasted either.
+ *
+ * The nodes referred to here are of the T_LISTPP type and have
+ * the form:
+ *
+ *     T_LISTPP        some_pointer            next_element
+ *
+ * Here some_pointer points to the things of interest in the list,
+ * and next_element to the next thing in the list except for the
+ * rightmost node, in which case it points to the leftmost node.
+ * The next_element of the rightmost node is of course zapped to the
+ * NIL pointer when the list is completed.
+ *
+ * Thinking of the lists as tree we heceforth refer to the leftmost
+ * node as the "top", and the rightmost node as the "bottom" or as
+ * the "virtual root".
+ */
+\f
+/*
+ * Make a new list
+ */
+newlist(new)
+       register int *new;
+{
+
+       if (new == NIL)
+               return (NIL);
+       return (tree3(T_LISTPP, new, spacep));
+}
+
+/*
+ * Add a new element to an existing list
+ */
+addlist(vroot, new)
+       register int *vroot;
+       int *new;
+{
+       register int *top;
+
+       if (new == NIL)
+               return (vroot);
+       if (vroot == NIL)
+               return (newlist(new));
+       top = vroot[2];
+       vroot[2] = spacep;
+       return (tree3(T_LISTPP, new, top));
+}
+
+/*
+ * Fix up the list which has virtual root vroot.
+ * We grab the top pointer and return it, zapping the spot
+ * where it was so that the tree is not circular.
+ */
+fixlist(vroot)
+       register int *vroot;
+{
+       register int *top;
+
+       if (vroot == NIL)
+               return (NIL);
+       top = vroot[2];
+       vroot[2] = NIL;
+       return (top);
+}
+\f
+
+/*
+ * Set up a T_VAR node for a qualified variable.
+ * Init is the initial entry in the qualification,
+ * or NIL if there is none.
+ */
+setupvar(var, init)
+       char *var;
+       register int *init;
+{
+
+       if (init != NIL)
+               init = newlist(init);
+       return (tree4(T_VAR, NOCON, var, init));
+}