From 49e8dbd7a6bbd6284b91f11b0e95ac9d92e3d9a6 Mon Sep 17 00:00:00 2001 From: Bill Joy Date: Fri, 19 Oct 1979 03:09:01 -0800 Subject: [PATCH] BSD 3 development Work on file usr/src/cmd/pxp/Version.c Work on file usr/src/cmd/pxp/call.c Work on file usr/src/cmd/pxp/const.c Work on file usr/src/cmd/pxp/case.c Work on file usr/src/cmd/pxp/cset.c Work on file usr/src/cmd/pxp/gram Work on file usr/src/cmd/pxp/func.c Work on file usr/src/cmd/pxp/lab.c Work on file usr/src/cmd/pxp/lval.c Work on file usr/src/cmd/pxp/make.script Work on file usr/src/cmd/pxp/opcode.h Work on file usr/src/cmd/pxp/pas.y Work on file usr/src/cmd/pxp/proc.c Work on file usr/src/cmd/pxp/rec.c Work on file usr/src/cmd/pxp/rval.c Synthesized-from: 3bsd --- usr/src/cmd/pxp/Version.c | 2 + usr/src/cmd/pxp/call.c | 48 ++ usr/src/cmd/pxp/case.c | 85 ++++ usr/src/cmd/pxp/const.c | 107 +++++ usr/src/cmd/pxp/cset.c | 40 ++ usr/src/cmd/pxp/func.c | 21 + usr/src/cmd/pxp/gram | 44 ++ usr/src/cmd/pxp/lab.c | 71 +++ usr/src/cmd/pxp/lval.c | 65 +++ usr/src/cmd/pxp/make.script | 50 ++ usr/src/cmd/pxp/opcode.h | 2 + usr/src/cmd/pxp/pas.y | 901 ++++++++++++++++++++++++++++++++++++ usr/src/cmd/pxp/proc.c | 18 + usr/src/cmd/pxp/rec.c | 137 ++++++ usr/src/cmd/pxp/rval.c | 139 ++++++ 15 files changed, 1730 insertions(+) create mode 100644 usr/src/cmd/pxp/Version.c create mode 100644 usr/src/cmd/pxp/call.c create mode 100644 usr/src/cmd/pxp/case.c create mode 100644 usr/src/cmd/pxp/const.c create mode 100644 usr/src/cmd/pxp/cset.c create mode 100644 usr/src/cmd/pxp/func.c create mode 100755 usr/src/cmd/pxp/gram create mode 100644 usr/src/cmd/pxp/lab.c create mode 100644 usr/src/cmd/pxp/lval.c create mode 100644 usr/src/cmd/pxp/make.script create mode 100644 usr/src/cmd/pxp/opcode.h create mode 100644 usr/src/cmd/pxp/pas.y create mode 100644 usr/src/cmd/pxp/proc.c create mode 100644 usr/src/cmd/pxp/rec.c create mode 100644 usr/src/cmd/pxp/rval.c diff --git a/usr/src/cmd/pxp/Version.c b/usr/src/cmd/pxp/Version.c new file mode 100644 index 0000000000..e4997a98da --- /dev/null +++ b/usr/src/cmd/pxp/Version.c @@ -0,0 +1,2 @@ +/* Copyright (c) 1979 Regents of the University of California */ +char version[] "May 7, 1979"; diff --git a/usr/src/cmd/pxp/call.c b/usr/src/cmd/pxp/call.c new file mode 100644 index 0000000000..6fe2eb2ea8 --- /dev/null +++ b/usr/src/cmd/pxp/call.c @@ -0,0 +1,48 @@ +/* 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" + +/* + * Procedure or function call + */ +call(p, argv) + register int *argv; +{ + register *al; + + ppid(p); + if (argv != NIL) { + ppbra("(("+1); /* xaproposstrange */ + for (;;) { + al = argv[1]; + if (al[0] == T_WEXP) { + rvalue(al[1], NIL); + if (al[2] != NIL) { + ppsep(": "); + rvalue(al[2], NIL); + } + if (al[3] == OCT || al[3] == HEX) { + ppspac(); + ppkw(al[3] == OCT ? "oct" : "hex"); + } else if (al[3] != NIL) { + ppsep(": "); + rvalue(al[3], NIL); + } + } else + rvalue(argv[1], NIL); + argv = argv[2]; + if (argv == NIL) + break; + ppsep(", "); + } + ppket(")"); + } +} diff --git a/usr/src/cmd/pxp/case.c b/usr/src/cmd/pxp/case.c new file mode 100644 index 0000000000..95bea50584 --- /dev/null +++ b/usr/src/cmd/pxp/case.c @@ -0,0 +1,85 @@ +/* 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" + +/* + * Case statement + */ +caseop(r) + int *r; +{ + register *cl, *cs, i; + struct pxcnt scnt; + + savecnt(&scnt); + ppkw("case"); + ppspac(); + rvalue(r[2], NIL); + ppspac(); + ppkw("of"); + for (cl = r[3]; cl != NIL;) { + cs = cl[1]; + if (cs == NIL) + continue; + baroff(); + ppgoin(DECL); + setline(cs[1]); + ppnl(); + indent(); + ppbra(NIL); + cs = cs[2]; + if (cs != NIL) { + i = 0; + for (;;) { + gconst(cs[1]); + cs = cs[2]; + if (cs == NIL) + break; + i++; + if (i == 7) { + ppsep(","); + ppitem(); + i = 0; + } else + ppsep(", "); + } + } else + ppid("{case label list}"); + ppket(":"); + cs = cl[1]; + cs = cs[3]; + getcnt(); + ppgoin(STAT); + if (cs != NIL && cs[0] == T_BLOCK) { + ppnl(); + indent(); + baron(); + ppstbl1(cs, STAT); + baroff(); + ppstbl2(); + baron(); + } else { + baron(); + statement(cs); + } + ppgoout(STAT); + ppgoout(DECL); + cl = cl[2]; + if (cl == NIL) + break; + ppsep(";"); + } + if (rescnt(&scnt)) + getcnt(); + ppnl(); + indent(); + ppkw("end"); +} diff --git a/usr/src/cmd/pxp/const.c b/usr/src/cmd/pxp/const.c new file mode 100644 index 0000000000..fd53c7542e --- /dev/null +++ b/usr/src/cmd/pxp/const.c @@ -0,0 +1,107 @@ +/* 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" + +STATIC int constcnt -1; + +/* + * The const declaration part + */ +constbeg(l, cline) + int l, cline; +{ + + line = l; + if (nodecl) + printoff(); + puthedr(); + putcm(); + ppnl(); + indent(); + ppkw("const"); + ppgoin(DECL); + constcnt = 0; + setline(cline); +} + +const(cline, cid, cdecl) + int cline; + char *cid; + int *cdecl; +{ + + if (constcnt) + putcm(); + setline(cline); + ppitem(); + ppid(cid); + ppsep(" = "); + gconst(cdecl); + ppsep(";"); + constcnt++; + setinfo(cline); + putcml(); +} + +constend() +{ + + if (constcnt == -1) + return; + if (nodecl) + return; + if (constcnt == 0) + ppid("{const decls}"); + ppgoout(DECL); + constcnt = -1; +} + +/* + * A constant in an expression + * or a declaration. + */ +gconst(r) + int *r; +{ + register *cn; + + cn = r; +loop: + if (cn == NIL) { + ppid("{constant}"); + return; + } + switch (cn[0]) { + default: + panic("gconst"); + case T_PLUSC: + ppop("+"); + cn = cn[1]; + goto loop; + case T_MINUSC: + ppop("-"); + cn = cn[1]; + goto loop; + case T_ID: + ppid(cn[1]); + return; + case T_CBINT: + case T_CINT: + case T_CFINT: + ppnumb(cn[1]); + if (cn[0] == T_CBINT) + ppsep("b"); + return; + case T_CSTRNG: + ppstr(cn[1]); + return; + } +} diff --git a/usr/src/cmd/pxp/cset.c b/usr/src/cmd/pxp/cset.c new file mode 100644 index 0000000000..cfc048a6c4 --- /dev/null +++ b/usr/src/cmd/pxp/cset.c @@ -0,0 +1,40 @@ +/* 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" + +/* + * Constant sets + */ +cset(r) +int *r; +{ + register *e, *el; + + ppbra("["); + el = r[2]; + if (el != NIL) + for (;;) { + e = el[1]; + el = el[2]; + if (e == NIL) + continue; + if (e[0] == T_RANG) { + rvalue(e[1], NIL); + ppsep(".."); + rvalue(e[2], NIL); + } else + rvalue(e, NIL); + if (el == NIL) + break; + ppsep(", "); + } + ppket("]"); +} diff --git a/usr/src/cmd/pxp/func.c b/usr/src/cmd/pxp/func.c new file mode 100644 index 0000000000..dd8cd147c9 --- /dev/null +++ b/usr/src/cmd/pxp/func.c @@ -0,0 +1,21 @@ +/* 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" + +/* + * A function call + */ +funccod(r) + register int *r; +{ + + call(r[2], r[3]); +} diff --git a/usr/src/cmd/pxp/gram b/usr/src/cmd/pxp/gram new file mode 100755 index 0000000000..501006e827 --- /dev/null +++ b/usr/src/cmd/pxp/gram @@ -0,0 +1,44 @@ +/yyval/s//*&/ +/\*yysterm\[]/,$d +1;/yyactr/ka +'a,$s/yypv/yyYpv/g +'aa + register int **yyYpv; + register int *p, *q; + yyYpv = yypv; +. +1;/^##/-w y.tab.h +/^int yylval 0/d +/extern int yychar,/s//extern/ +/yyclearin/d +/yyerrok/d +1;/^##/d +$a + +yyEactr(__np__, var) +int __np__; +char *var; +{ +switch(__np__) { +default: +return (1); +. +g/case.*@/s/@//\ +.m$ +g/@/ka\ +'a;?case?,?case?t$\ +'am$\ +a\ +}\ +break; +$a +} +} +. +1,$s/@// +/int nterms/d +/int nnonter/d +/int nstate/d +/int yyerrval/d +w +q diff --git a/usr/src/cmd/pxp/lab.c b/usr/src/cmd/pxp/lab.c new file mode 100644 index 0000000000..c078ffbac4 --- /dev/null +++ b/usr/src/cmd/pxp/lab.c @@ -0,0 +1,71 @@ +/* Copyright (c) 1979 Regents of the University of California */ +# +/* + * pxp - Pascal execution profiler + * + * Bill Joy UCB + * Version 1.2 January 1979 + */ + +#include "0.h" + +/* + * Label declaration part + */ +label(r, l) + int *r, l; +{ + register *ll; + + if (nodecl) + printoff(); + puthedr(); + setline(l); + ppnl(); + indent(); + ppkw("label"); + ppgoin(DECL); + ppnl(); + indent(); + ppbra(NIL); + ll = r; + if (ll != NIL) + for (;;) { + pplab(ll[1]); + ll = ll[2]; + if (ll == NIL) + break; + ppsep(", "); + } + else + ppid("{label list}"); + ppket(";"); + putcml(); + ppgoout(DECL); +} + +/* + * Goto statement + */ +gotoop(s) + char *s; +{ + + gocnt++; + ppkw("goto"); + ppspac(); + pplab(s); +} + +/* + * A label on a statement + */ +labeled(s) + char *s; +{ + + linopr(); + indentlab(); + pplab(s); + ppsep(":"); +} diff --git a/usr/src/cmd/pxp/lval.c b/usr/src/cmd/pxp/lval.c new file mode 100644 index 0000000000..33b75c6aa0 --- /dev/null +++ b/usr/src/cmd/pxp/lval.c @@ -0,0 +1,65 @@ +/* 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" + +/* + * A "variable" + */ +lvalue(r) + register int *r; +{ + register *c, *co; + + ppid(r[2]); + for (c = r[3]; c != NIL; c = c[2]) { + co = c[1]; + if (co == NIL) + continue; + switch (co[0]) { + case T_PTR: + ppop("^"); + continue; + case T_ARY: + arycod(co[1]); + continue; + case T_FIELD: + ppop("."); + ppid(co[1]); + continue; + case T_ARGL: + ppid("{unexpected argument list}"); + break; + default: + panic("lval2"); + } + } +} + +/* + * Subscripting + */ +arycod(el) + register int *el; +{ + + ppbra("["); + if (el != NIL) + for (;;) { + rvalue(el[1], NIL); + el = el[2]; + if (el == NIL) + break; + ppsep(", "); + } + else + rvalue(NIL, NIL); + ppket("]"); +} diff --git a/usr/src/cmd/pxp/make.script b/usr/src/cmd/pxp/make.script new file mode 100644 index 0000000000..deca6f04d1 --- /dev/null +++ b/usr/src/cmd/pxp/make.script @@ -0,0 +1,50 @@ +cc -O -DPXP -c call.c +cc -O -DPXP -c case.c +cc -O -DPXP -c const.c +cc -O -DPXP -c cset.c +cc -O -DPXP -c error.c +cc -O -DPXP -c fdec.c +cc -O -DPXP -c func.c +cc -O -DPXP -c hash.c +cc -O -DPXP -c lab.c +cc -O -DPXP -c lval.c +cc -O -DPXP -c main.c +cc -O -DPXP -c nl.c +cc -O -DPXP -c pmon.c +cc -O -DPXP -c pp.c +cc -O -DPXP -c proc.c +cc -O -DPXP -c rec.c +cc -O -DPXP -c rval.c +cc -O -DPXP -c stat.c +cc -O -DPXP -c string.c +cc -O -DPXP -c subr.c +cc -O -DPXP -c tree.c +cc -O -DPXP -c type.c +cc -O -DPXP -c var.c +cc -O -DPXP -c y.tab.c +cc -O -DPXP -c yycomm.c +cc -O -DPXP -c yycosts.c +cc -O -DPXP -c yyerror.c +cc -O -DPXP -c yyget.c +cc -O -DPXP -c yyid.c +cc -O -DPXP -c yylex.c +cc -O -DPXP -c yymain.c +cc -O -DPXP -c yypanic.c +cc -O -DPXP -c yyparse.c +cc -O -DPXP -c yyprint.c +cc -O -DPXP -c yyput.c +cc -O -DPXP -c yyrecover.c +cc -O -DPXP -c yyseman.c +cc -O -DPXP -c yytree.c +as -o printf.o printf.s +as -o treen.o treen.s +as -o wait.o wait.s +as -o yycopy.o yycopy.s +echo "version > Version.c" +cc -c Version.c +cc -i -f call.o case.o const.o cset.o error.o fdec.o func.o hash.o lab.o lval.o main.o nl.o pmon.o pp.o proc.o rec.o rval.o stat.o string.o subr.o tree.o type.o var.o y.tab.o yycomm.o yycosts.o yyerror.o yyget.o yyid.o yylex.o yymain.o yypanic.o yyparse.o yyprint.o yyput.o yyrecover.o yyseman.o yytree.o printf.o treen.o wait.o yycopy.o Version.o ../pascal/fpterp/fp.o ../pascal/opcodes/TRdata.o +echo "version > Version.c" +cc -c Version.c +cc -n -f call.o case.o const.o cset.o error.o fdec.o func.o hash.o lab.o lval.o main.o nl.o pmon.o pp.o proc.o rec.o rval.o stat.o string.o subr.o tree.o type.o var.o y.tab.o yycomm.o yycosts.o yyerror.o yyget.o yyid.o yylex.o yymain.o yypanic.o yyparse.o yyprint.o yyput.o yyrecover.o yyseman.o yytree.o Version.o ../pascal/fpdata/*.o ../pascal/opcodes/TRdata.o -o a.outNOID +cp a.out /usr/ucb/pxp +cp a.outNOID /usr/ucb/pxp34 diff --git a/usr/src/cmd/pxp/opcode.h b/usr/src/cmd/pxp/opcode.h new file mode 100644 index 0000000000..c54f7cec39 --- /dev/null +++ b/usr/src/cmd/pxp/opcode.h @@ -0,0 +1,2 @@ +/* Copyright (c) 1979 Regents of the University of California */ +/* surrogate */ diff --git a/usr/src/cmd/pxp/pas.y b/usr/src/cmd/pxp/pas.y new file mode 100644 index 0000000000..f2fcc0ebf9 --- /dev/null +++ b/usr/src/cmd/pxp/pas.y @@ -0,0 +1,901 @@ +/* + * 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 + */ + +/* + * Yacc grammar for UNIX Pascal + * + * This grammar is processed by the commands in the shell script + * "gram" to yield parse tables and semantic routines in the file + * "y.tab.c" and a header defining the lexical tokens in "yy.h". + * + * In order for the syntactic error recovery possible with this + * grammar to work, the grammar must be processed by a yacc which + * has been modified to fully enumerate possibilities in states + * which involve the symbol "error". + * The parser used for Pascal also uses a different encoding of + * the test entries in the action table which speeds the parse. + * A version of yacc which will work for Pascal is included on + * the distribution table as "eyacc". + * + * The "gram" script also makes the following changes to the "y.tab.c" + * file: + * + * 1) Causes yyval to be declared int *. + * + * 2) Loads the variable yypv into a register as yyYpv so that + * the arguments $1, ... are available as yyYpv[1] etc. + * This produces much smaller code in the semantic actions. + * + * 3) Deletes the unused array yysterm. + * + * 4) Moves the declarations up to the flag line containing + * '##' to the file yy.h so that the routines which use + * these "magic numbers" don't have to all be compiled at + * the same time. + * + * 5) Creates the semantic restriction checking routine yyEactr + * by processing action lines containing `@'. + * + * This compiler uses a different version of the yacc parser, a + * different yyerror which is called yerror, and requires more + * lookahead sets than normally provided by yacc. + * + * Source for the yacc used with this grammar is included on + * distribution tapes. + */ + +/* + * TERMINAL DECLARATIONS + * + * Some of the terminal declarations are out of the most natural + * alphabetic order because the error recovery + * will guess the first of equal cost non-terminals. + * This makes, e.g. YTO preferable to YDOWNTO. + */ + +%term + YAND YARRAY YBEGIN YCASE + YCONST YDIV YDO YDOTDOT + YTO YELSE YEND YFILE + YFOR YFORWARD YFUNCTION YGOTO + YID YIF YIN YINT + YLABEL YMOD YNOT YNUMB + YOF YOR YPACKED YNIL + YPROCEDURE YPROG YRECORD YREPEAT + YSET YSTRING YTHEN YDOWNTO + YTYPE YUNTIL YVAR YWHILE + YWITH YBINT YOCT YHEX + YASSERT YCASELAB YILLCH YLAST + +/* + * PRECEDENCE DECLARATIONS + * + * Highest precedence is the unary logical NOT. + * Next are the multiplying operators, signified by '*'. + * Lower still are the binary adding operators, signified by '+'. + * Finally, at lowest precedence and non-associative are the relationals. + */ + +%binary '<' '=' '>' YIN +%left '+' '-' YOR '|' +%left UNARYSIGN +%left '*' '/' YDIV YMOD YAND '&' +%left YNOT + +%{ + +/* + * GLOBALS FOR ACTIONS + */ + +/* + * The following line marks the end of the yacc + * Constant definitions which are removed from + * y.tab.c and placed in the file y.tab.h. + */ +## + +#include "0.h" +#include "yy.h" +#include "tree.h" + +#ifdef PI +#define lineof(l) l +#define line2of(l) l +#endif + +%} + +%% + +/* + * PRODUCTIONS + */ + +goal: + prog_hedr decls procs block '.' + = funcend($1, $4, lineof($5)); + ; + +prog_hedr: + YPROG YID '(' id_list ')' ';' + = $$ = funcbody(funchdr(tree5(T_PROG, lineof($1), $2, fixlist($4), NIL))); + | + YPROG error + = { + yyPerror("Malformed program statement", PPROG); + /* + * Should make a program statement + * with "input" and "output" here. + */ + $$ = funcbody(funchdr(tree5(T_PROG, lineof($1), NIL, NIL, NIL))); + } + ; +block: + YBEGIN stat_list YEND + = { + $$ = tree3(T_BSTL, lineof($1), fixlist($2)); + if ($3.pint < 0) + brerror($1, "begin"); + } + ; + + +/* + * DECLARATION PART + */ +decls: + decls decl + = trfree(); + | + decls error + = { +Derror: + constend(), typeend(), varend(), trfree(); + yyPerror("Malformed declaration", PDECL); + } + | + /* lambda */ + = trfree(); + ; + +decl: + labels + | + const_decl + = constend(); + | + type_decl + = typeend(); + | + var_decl + = varend(); + ; + +/* + * LABEL PART + */ + +labels: + YLABEL label_decl ';' + = label(fixlist($2), lineof($1)); + ; +label_decl: + YINT + = $$ = newlist($1 == NIL ? NIL : *hash($1, 1)); + | + label_decl ',' YINT + = $$ = addlist($1, $3 == NIL ? NIL : *hash($3, 1)); + ; + +/* + * CONST PART + */ + +const_decl: + YCONST YID '=' const ';' + = constbeg($1, line2of($2)), const(lineof($3), $2, $4); + | + const_decl YID '=' const ';' + = const(lineof($3), $2, $4); + | + YCONST error + = { + constbeg($1, line2of($1)); +Cerror: + yyPerror("Malformed const declaration", PDECL); + } + | + const_decl error + = goto Cerror; + ; + +/* + * TYPE PART + */ + +type_decl: + YTYPE YID '=' type ';' + = typebeg($1, line2of($2)), type(lineof($3), $2, $4); + | + type_decl YID '=' type ';' + = type(lineof($3), $2, $4); + | + YTYPE error + = { + typebeg($1, line2of($1)); +Terror: + yyPerror("Malformed type declaration", PDECL); + } + | + type_decl error + = goto Terror; + ; + +/* + * VAR PART + */ + +var_decl: + YVAR id_list ':' type ';' + = varbeg($1, line2of($3)), var(lineof($3), fixlist($2), $4); + | + var_decl id_list ':' type ';' + = var(lineof($3), fixlist($2), $4); + | + YVAR error + = { + varbeg($1, line2of($1)); +Verror: + yyPerror("Malformed var declaration", PDECL); + } + | + var_decl error + = goto Verror; + ; + +/* + * PROCEDURE AND FUNCTION DECLARATION PART + */ + +procs: + /* lambda */ + | + procs proc + = trfree(); + ; +proc: + phead YFORWARD ';' + = funcfwd($1); + | + pheadres decls procs block ';' + = funcend($1, $4, lineof($5)); + ; +pheadres: + phead + = funcbody($1); + ; +phead: + porf YID params ftype ';' + = $$ = funchdr(tree5($1, lineof($5), $2, $3, $4)); + ; +porf: + YPROCEDURE + = $$ = T_PDEC; + | + YFUNCTION + = $$ = T_FDEC; + ; +params: + '(' param_list ')' + = $$ = fixlist($2); + | + /* lambda */ + = $$ = NIL; + ; + +/* + * PARAMETERS + */ + +param: + id_list ':' type + = $$ = tree3(T_PVAL, fixlist($1), $3); + | + YVAR id_list ':' type + = $$ = tree3(T_PVAR, fixlist($2), $4); + | + YFUNCTION id_list ':' type + = $$ = tree3(T_PFUNC, fixlist($2), $4); + | + YPROCEDURE id_list + = $$ = tree2(T_PPROC, fixlist($2)); + ; +ftype: + ':' type + = $$ = $2; + | + /* lambda */ + = $$ = NIL; + ; +param_list: + param + = $$ = newlist($1); + | + param_list ';' param + = $$ = addlist($1, $3); + ; + +/* + * CONSTANTS + */ + +const: + YSTRING + = $$ = tree2(T_CSTRNG, $1); + | + number + | + '+' number + = $$ = tree2(T_PLUSC, $2); + | + '-' number + = $$ = tree2(T_MINUSC, $2); + ; +number: + const_id + = $$ = tree2(T_ID, $1); + | + YINT + = $$ = tree2(T_CINT, $1); + | + YBINT + = $$ = tree2(T_CBINT, $1); + | + YNUMB + = $$ = tree2(T_CFINT, $1); + ; +const_list: + const + = $$ = newlist($1); + | + const_list ',' const + = $$ = addlist($1, $3); + ; + +/* + * TYPES + */ + +type: + simple_type + | + '^' YID + = $$ = tree3(T_TYPTR, lineof($1), tree2(T_ID, $2)); + | + struct_type + | + YPACKED struct_type + = $$ = tree3(T_TYPACK, lineof($1), $2); + ; +simple_type: + type_id + | + '(' id_list ')' + = $$ = tree3(T_TYSCAL, lineof($1), fixlist($2)); + | + const YDOTDOT const + = $$ = tree4(T_TYRANG, lineof($2), $1, $3); + ; +struct_type: + YARRAY '[' simple_type_list ']' YOF type + = $$ = tree4(T_TYARY, lineof($1), fixlist($3), $6); + | + YFILE YOF type + = $$ = tree3(T_TYFILE, lineof($1), $3); + | + YSET YOF simple_type + = $$ = tree3(T_TYSET, lineof($1), $3); + | + YRECORD field_list YEND + = { + $$ = tree3(T_TYREC, lineof($1), $2); + if ($3.pint < 0) + brerror($1, "record"); + } + ; +simple_type_list: + simple_type + = $$ = newlist($1); + | + simple_type_list ',' simple_type + = $$ = addlist($1, $3); + ; + +/* + * RECORD TYPE + */ +field_list: + fixed_part variant_part + = $$ = tree4(T_FLDLST, lineof(NIL), fixlist($1), $2); + ; +fixed_part: + field + = $$ = newlist($1); + | + fixed_part ';' field + = $$ = addlist($1, $3); + | + fixed_part error + = yyPerror("Malformed record declaration", PDECL); + ; +field: + /* lambda */ + = $$ = NIL; + | + id_list ':' type + = $$ = tree4(T_RFIELD, lineof($2), fixlist($1), $3); + ; + +variant_part: + /* lambda */ + = $$ = NIL; + | + YCASE type_id YOF variant_list + = $$ = tree5(T_TYVARPT, lineof($1), NIL, $2, fixlist($4)); + | + YCASE YID ':' type_id YOF variant_list + = $$ = tree5(T_TYVARPT, lineof($1), $2, $4, fixlist($6)); + ; +variant_list: + variant + = $$ = newlist($1); + | + variant_list ';' variant + = $$ = addlist($1, $3); + | + variant_list error + = yyPerror("Malformed record declaration", PDECL); + ; +variant: + /* lambda */ + = $$ = NIL; + | + const_list ':' '(' field_list ')' + = $$ = tree4(T_TYVARNT, lineof($2), fixlist($1), $4); + | + const_list ':' '(' ')' + = $$ = tree4(T_TYVARNT, lineof($2), fixlist($1), NIL); + ; + +/* + * STATEMENT LIST + */ + +stat_list: + stat + = $$ = newlist($1); + | + stat_lsth stat + = { + if ((p = $1) != NIL && (q = p[1])[0] == T_IFX) { + q[0] = T_IFEL; + q[4] = $2; + } else + $$ = addlist($1, $2); + } + ; + +stat_lsth: + stat_list ';' + = if ((q = $1) != NIL && (p = q[1]) != NIL && p[0] == T_IF) { + if (yychar < 0) + yychar = yylex(); + if (yyshifts >= 2 && yychar == YELSE) { + recovered(); + copy(&Y, &OY, sizeof Y); + yerror("Deleted ';' before keyword else"); + yychar = yylex(); + p[0] = T_IFX; + } + } + ; + +/* + * CASE STATEMENT LIST + */ + +cstat_list: + cstat + = $$ = newlist($1); + | + cstat_list ';' cstat + = $$ = addlist($1, $3); + | + error + = { + $$ = NIL; +Kerror: + yyPerror("Malformed statement in case", PSTAT); + } + | + cstat_list error + = goto Kerror; + ; + +cstat: + const_list ':' stat + = $$ = tree4(T_CSTAT, lineof($2), fixlist($1), $3); + | + YCASELAB stat + = $$ = tree4(T_CSTAT, lineof($1), NIL, $2); + | + /* lambda */ + = $$ = NIL; + ; + +/* + * STATEMENT + */ + +stat: + /* lambda */ + = $$ = NIL; + | + YINT ':' stat + = $$ = tree4(T_LABEL, lineof($2), $1 == NIL ? NIL : *hash($1, 1), $3); + | + proc_id + = $$ = tree4(T_PCALL, lineof(yyline), $1, NIL); + | + proc_id '(' wexpr_list ')' + = $$ = tree4(T_PCALL, lineof($2), $1, fixlist($3)); + | + YID error + = goto NSerror; + | + assign + | + YBEGIN stat_list YEND + = { + $$ = tree3(T_BLOCK, lineof($1), fixlist($2)); + if ($3.pint < 0) + brerror($1, "begin"); + } + | + YCASE expr YOF cstat_list YEND + = { + $$ = tree4(T_CASE, lineof($1), $2, fixlist($4)); + if ($5.pint < 0) + brerror($1, "case"); + } + | + YWITH var_list YDO stat + = $$ = tree4(T_WITH, lineof($1), fixlist($2), $4); + | + YWHILE expr YDO stat + = $$ = tree4(T_WHILE, lineof($1), $2, $4); + | + YREPEAT stat_list YUNTIL expr + = $$ = tree4(T_REPEAT, lineof($3), fixlist($2), $4); + | + YFOR assign YTO expr YDO stat + = $$ = tree5(T_FORU, lineof($1), $2, $4, $6); + | + YFOR assign YDOWNTO expr YDO stat + = $$ = tree5(T_FORD, lineof($1), $2, $4, $6); + | + YGOTO YINT + = $$ = tree3(T_GOTO, lineof($1), *hash($2, 1)); + | + YIF expr YTHEN stat + = $$ = tree5(T_IF, lineof($1), $2, $4, NIL); + | + YIF expr YTHEN stat YELSE stat + = $$ = tree5(T_IFEL, lineof($1), $2, $4, $6); + | + YIF expr YTHEN stat YELSE + = $$ = tree5(T_IFEL, lineof($1), $2, $4, NIL); + | + YASSERT '(' expr ')' + = $$ = tree3(T_ASRT, lineof($1), $3); + | + error + = { +NSerror: + $$ = NIL; +Serror: + yyPerror("Malformed statement", PSTAT); + } + ; +assign: + variable ':' '=' expr + = $$ = tree4(T_ASGN, lineof($2), $1, $4); + ; + +/* + * EXPRESSION + */ + +expr: + error + = { +NEerror: + $$ = NIL; +Eerror: + yyPerror("Missing/malformed expression", PEXPR); + } + | + expr relop expr %prec '<' + = $$ = tree4($2, $1[1] == SAWCON ? $3[1] : $1[1], $1, $3); + | + '+' expr %prec UNARYSIGN + = $$ = tree3(T_PLUS, $2[1], $2); + | + '-' expr %prec UNARYSIGN + = $$ = tree3(T_MINUS, $2[1], $2); + | + expr addop expr %prec '+' + = $$ = tree4($2, $1[1] == SAWCON ? $3[1] : $1[1], $1, $3); + | + expr divop expr %prec '*' + = $$ = tree4($2, $1[1] == SAWCON ? $3[1] : $1[1], $1, $3); + | + YNIL + = $$ = tree2(T_NIL, NOCON); + | + YSTRING + = $$ = tree3(T_STRNG, SAWCON, $1); + | + YINT + = $$ = tree3(T_INT, NOCON, $1); + | + YBINT + = $$ = tree3(T_BINT, NOCON, $1); + | + YNUMB + = $$ = tree3(T_FINT, NOCON, $1); + | + variable + | + YID error + = goto NEerror; + | + func_id '(' wexpr_list ')' + = $$ = tree4(T_FCALL, NOCON, $1, fixlist($3)); + | + '(' expr ')' + = $$ = $2; + | + negop expr %prec YNOT + = $$ = tree3(T_NOT, NOCON, $2); + | + '[' element_list ']' + = $$ = tree3(T_CSET, SAWCON, fixlist($2)); + | + '[' ']' + = $$ = tree3(T_CSET, SAWCON, NIL); + ; + +element_list: + element + = $$ = newlist($1); + | + element_list ',' element + = $$ = addlist($1, $3); + ; +element: + expr + | + expr YDOTDOT expr + = $$ = tree3(T_RANG, $1, $3); + ; + +/* + * QUALIFIED VARIABLES + */ + +variable: + YID + = { + @ return (identis(var, VAR)); + $$ = setupvar($1, NIL); + } + | + qual_var + = $1[3] = fixlist($1[3]); + ; +qual_var: + array_id '[' expr_list ']' + = $$ = setupvar($1, tree2(T_ARY, fixlist($3))); + | + qual_var '[' expr_list ']' + = $1[3] = addlist($1[3], tree2(T_ARY, fixlist($3))); + | + record_id '.' field_id + = $$ = setupvar($1, tree3(T_FIELD, $3, NIL)); + | + qual_var '.' field_id + = $1[3] = addlist($1[3], tree3(T_FIELD, $3, NIL)); + | + ptr_id '^' + = $$ = setupvar($1, tree1(T_PTR)); + | + qual_var '^' + = $1[3] = addlist($1[3], tree1(T_PTR)); + ; + +/* + * Expression with write widths + */ +wexpr: + expr + | + expr ':' expr + = $$ = tree4(T_WEXP, $1, $3, NIL); + | + expr ':' expr ':' expr + = $$ = tree4(T_WEXP, $1, $3, $5); + | + expr octhex + = $$ = tree4(T_WEXP, $1, NIL, $2); + | + expr ':' expr octhex + = $$ = tree4(T_WEXP, $1, $3, $4); + ; +octhex: + YOCT + = $$ = OCT; + | + YHEX + = $$ = HEX; + ; + +expr_list: + expr + = $$ = newlist($1); + | + expr_list ',' expr + = $$ = addlist($1, $3); + ; + +wexpr_list: + wexpr + = $$ = newlist($1); + | + wexpr_list ',' wexpr + = $$ = addlist($1, $3); + ; + +/* + * OPERATORS + */ + +relop: + '=' = $$ = T_EQ; + | + '<' = $$ = T_LT; + | + '>' = $$ = T_GT; + | + '<' '>' = $$ = T_NE; + | + '<' '=' = $$ = T_LE; + | + '>' '=' = $$ = T_GE; + | + YIN = $$ = T_IN; + ; +addop: + '+' = $$ = T_ADD; + | + '-' = $$ = T_SUB; + | + YOR = $$ = T_OR; + | + '|' = $$ = T_OR; + ; +divop: + '*' = $$ = T_MULT; + | + '/' = $$ = T_DIVD; + | + YDIV = $$ = T_DIV; + | + YMOD = $$ = T_MOD; + | + YAND = $$ = T_AND; + | + '&' = $$ = T_AND; + ; + +negop: + YNOT + | + '~' + ; + +/* + * LISTS + */ + +var_list: + variable + = $$ = newlist($1); + | + var_list ',' variable + = $$ = addlist($1, $3); + ; + +id_list: + YID + = $$ = newlist($1); + | + id_list ',' YID + = $$ = addlist($1, $3); + ; + +/* + * Identifier productions with semantic restrictions + * + * For these productions, the character @ signifies + * that the associated C statement is to provide + * the semantic restriction for this reduction. + * These lines are made into a procedure yyEactr, similar to + * yyactr, which determines whether the corresponding reduction + * is permitted, or whether an error is to be signaled. + * A zero return from yyEactr is considered an error. + * YyEactr is called with an argument "var" giving the string + * name of the variable in question, essentially $1, although + * $1 will not work because yyEactr is called from loccor in + * the recovery routines. + */ + +const_id: + YID + = @ return (identis(var, CONST)); + ; +type_id: + YID + = { + @ return (identis(var, TYPE)); + $$ = tree3(T_TYID, lineof(yyline), $1); + } + ; +var_id: + YID + = @ return (identis(var, VAR)); + ; +array_id: + YID + = @ return (identis(var, ARRAY)); + ; +ptr_id: + YID + = @ return (identis(var, PTRFILE)); + ; +record_id: + YID + = @ return (identis(var, RECORD)); + ; +field_id: + YID + = @ return (identis(var, FIELD)); + ; +proc_id: + YID + = @ return (identis(var, PROC)); + ; +func_id: + YID + = @ return (identis(var, FUNC)); + ; diff --git a/usr/src/cmd/pxp/proc.c b/usr/src/cmd/pxp/proc.c new file mode 100644 index 0000000000..86398f45f1 --- /dev/null +++ b/usr/src/cmd/pxp/proc.c @@ -0,0 +1,18 @@ +/* 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" + +proc(r) + int *r; +{ + + call(r[2], r[3]); +} diff --git a/usr/src/cmd/pxp/rec.c b/usr/src/cmd/pxp/rec.c new file mode 100644 index 0000000000..5c8102eea6 --- /dev/null +++ b/usr/src/cmd/pxp/rec.c @@ -0,0 +1,137 @@ +/* Copyright (c) 1979 Regents of the University of California */ +# +/* + * pxp - Pascal execution profiler + * + * Bill Joy UCB + * Version 1.2 January 1979 + */ + +#include "0.h" + +tyrec(r, p0) + int *r, p0; +{ + + if (r != NIL) + setinfo(r[1]); + if (p0 == NIL) { + ppgoin(DECL); + ppnl(); + indent(); + ppkw("record"); + ppspac(); + } else { + ppspac(); + ppbra("("); + } + ppgoin(DECL); + if (r) { + field(r[2], r[3]); + variant(r[3]); + } + if (r != NIL) + setinfo(r[1]); + putcml(); + ppgoout(DECL); + if (p0 == NIL) { + ppnl(); + indent(); + ppkw("end"); + ppgoout(DECL); + } else { + ppitem(); + ppket(")"); + } +} + +field(r, v) + int *r, *v; +{ + register int *fp, *tp, *ip; + + fp = r; + if (fp != NIL) + for (;;) { + tp = fp[1]; + if (tp != NIL) { + setline(tp[1]); + ip = tp[2]; + ppitem(); + if (ip != NIL) + for (;;) { + ppid(ip[1]); + ip = ip[2]; + if (ip == NIL) + break; + ppsep(", "); + } + else + ppid("{field id list}"); + ppsep(":"); + gtype(tp[3]); + setinfo(tp[1]); + putcm(); + } + fp = fp[2]; + if (fp == NIL) + break; + ppsep(";"); + } + if (v != NIL && r != NIL) + ppsep(";"); +} + +variant(r) + register int *r; +{ + register int *v, *vc; + + if (r == NIL) + return; + setline(r[1]); + ppitem(); + ppkw("case"); + v = r[2]; + if (v != NIL) { + ppspac(); + ppid(v); + ppsep(":"); + } + gtype(r[3]); + ppspac(); + ppkw("of"); + for (vc = r[4]; vc != NIL;) { + v = vc[1]; + if (v == NIL) + continue; + ppgoin(DECL); + setline(v[1]); + ppnl(); + indent(); + ppbra(NIL); + v = v[2]; + if (v != NIL) { + for (;;) { + gconst(v[1]); + v = v[2]; + if (v == NIL) + break; + ppsep(", "); + } + } else + ppid("{case label list}"); + ppket(":"); + v = vc[1]; + tyrec(v[3], 1); + setinfo(v[1]); + putcml(); + ppgoout(DECL); + vc = vc[2]; + if (vc == NIL) + break; + ppsep(";"); + } + setinfo(r[1]); + putcm(); +} diff --git a/usr/src/cmd/pxp/rval.c b/usr/src/cmd/pxp/rval.c new file mode 100644 index 0000000000..812d2c2af7 --- /dev/null +++ b/usr/src/cmd/pxp/rval.c @@ -0,0 +1,139 @@ +/* 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 char *opnames[]; + +#define alph(c) ((c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z')) +/* + * Rvalue reformats an expression. + * Par is a flag indicating that the expression + * should be parenthesized if it is non-atomic. + */ +rvalue(r, par) + register int *r; + int par; +{ + register int *al; + register char *opname; + + if (r == NIL) { + ppid("{expr}"); + return; + } + if (r[0] <= T_IN) + opname = opnames[r[0]]; + switch (r[0]) { + case T_BINT: + case T_INT: + case T_FINT: + ppnumb(r[2]); + if (r[0] == T_BINT) + ppsep("b"); + return; + case T_NIL: + ppkw("nil"); + return; + case T_FCALL: + funccod(r); + return; + case T_VAR: + lvalue(r); + return; + case T_CSET: + cset(r); + return; + case T_STRNG: + ppstr(r[2]); + return; + } + if (par) + ppbra("("); + switch (r[0]) { + default: + panic("rval"); + case T_PLUS: + case T_MINUS: + ppop(r[0] == T_PLUS ? "+" : "-"); + al = r[2]; + rvalue(r[2], prec(al) > prec(r) || full); + break; + case T_NOT: + ppkw(opname); + ppspac(); + rvalue(r[2], 1); + break; + case T_EQ: + case T_NE: + case T_GE: + case T_LE: + case T_GT: + case T_LT: + al = r[2]; + rvalue(al, prec(al) <= prec(r) || full); + goto rest; + case T_AND: + case T_OR: + case T_MULT: + case T_ADD: + case T_SUB: + case T_DIVD: + case T_MOD: + case T_DIV: + case T_IN: + al = r[2]; + rvalue(al, prec(al) < prec(r) || full); +rest: + ppspac(); + if (alph(opname[0])) + ppkw(opname); + else + ppop(opname); + ppspac(); + al = r[3]; + rvalue(al, prec(al) <= prec(r) || full); + break; + } + if (par) + ppket(")"); +} + +/* + * Prec returns the precedence of an operator, + * with larger numbers indicating stronger binding. + * This is used to determine when parenthesization + * is needed on subexpressions. + */ +prec(r) + register int *r; +{ + + if (r == NIL) + return; + switch (r[0]) { + case T_NOT: + return (3); + case T_MULT: + case T_DIVD: + case T_DIV: + case T_MOD: + case T_AND: + return (2); + case T_ADD: + case T_SUB: + case T_OR: + case T_PLUS: + case T_MINUS: + return (1); + default: + return (0); + } +} -- 2.20.1