add hoc

src/cmd/hoc/code.c

@@ -0,0 +1,651 @@
+#include <u.h>
+#include <libc.h>
+#include <bio.h>
+#include "hoc.h"
+#include "y.tab.h"
+
+#define	NSTACK	256
+
+static Datum stack[NSTACK];	/* the stack */
+static Datum *stackp;		/* next free spot on stack */
+
+#define	NPROG	2000
+Inst	prog[NPROG];	/* the machine */
+Inst	*progp;		/* next free spot for code generation */
+Inst	*pc;		/* program counter during execution */
+Inst	*progbase = prog; /* start of current subprogram */
+int	returning;	/* 1 if return stmt seen */
+int	indef;	/* 1 if parsing a func or proc */
+
+typedef struct Frame {	/* proc/func call stack frame */
+	Symbol	*sp;	/* symbol table entry */
+	Inst	*retpc;	/* where to resume after return */
+	Datum	*argn;	/* n-th argument on stack */
+	int	nargs;	/* number of arguments */
+} Frame;
+#define	NFRAME	100
+Frame	frame[NFRAME];
+Frame	*fp;		/* frame pointer */
+
+void
+initcode(void)
+{
+	progp = progbase;
+	stackp = stack;
+	fp = frame;
+	returning = 0;
+	indef = 0;
+}
+
+void
+push(Datum d)
+{
+	if (stackp >= &stack[NSTACK])
+		execerror("stack too deep", 0);
+	*stackp++ = d;
+}
+
+Datum
+pop(void)
+{
+	if (stackp == stack)
+		execerror("stack underflow", 0);
+	return *--stackp;
+}
+
+void
+xpop(void)	/* for when no value is wanted */
+{
+	if (stackp == stack)
+		execerror("stack underflow", (char *)0);
+	--stackp;
+}
+
+void
+constpush(void)
+{
+	Datum d;
+	d.val = ((Symbol *)*pc++)->u.val;
+	push(d);
+}
+
+void
+varpush(void)
+{
+	Datum d;
+	d.sym = (Symbol *)(*pc++);
+	push(d);
+}
+
+void
+whilecode(void)
+{
+	Datum d;
+	Inst *savepc = pc;
+
+	execute(savepc+2);	/* condition */
+	d = pop();
+	while (d.val) {
+		execute(*((Inst **)(savepc)));	/* body */
+		if (returning)
+			break;
+		execute(savepc+2);	/* condition */
+		d = pop();
+	}
+	if (!returning)
+		pc = *((Inst **)(savepc+1)); /* next stmt */
+}
+
+void
+forcode(void)
+{
+	Datum d;
+	Inst *savepc = pc;
+
+	execute(savepc+4);		/* precharge */
+	pop();
+	execute(*((Inst **)(savepc)));	/* condition */
+	d = pop();
+	while (d.val) {
+		execute(*((Inst **)(savepc+2)));	/* body */
+		if (returning)
+			break;
+		execute(*((Inst **)(savepc+1)));	/* post loop */
+		pop();
+		execute(*((Inst **)(savepc)));	/* condition */
+		d = pop();
+	}
+	if (!returning)
+		pc = *((Inst **)(savepc+3)); /* next stmt */
+}
+
+void
+ifcode(void) 
+{
+	Datum d;
+	Inst *savepc = pc;	/* then part */
+
+	execute(savepc+3);	/* condition */
+	d = pop();
+	if (d.val)
+		execute(*((Inst **)(savepc)));	
+	else if (*((Inst **)(savepc+1))) /* else part? */
+		execute(*((Inst **)(savepc+1)));
+	if (!returning)
+		pc = *((Inst **)(savepc+2)); /* next stmt */
+}
+
+void
+define(Symbol* sp, Formal *f)	/* put func/proc in symbol table */
+{
+	Fndefn *fd;
+	int n;
+
+	fd = emalloc(sizeof(Fndefn));
+	fd->code = progbase;	/* start of code */
+	progbase = progp;	/* next code starts here */
+	fd->formals = f;
+	for(n=0; f; f=f->next)
+		n++;
+	fd->nargs = n;
+	sp->u.defn = fd;
+}
+
+void
+call(void) 		/* call a function */
+{
+	Formal *f;
+	Datum *arg;
+	Saveval *s;
+	int i;
+
+	Symbol *sp = (Symbol *)pc[0]; /* symbol table entry */
+				      /* for function */
+	if (fp >= &frame[NFRAME])
+		execerror(sp->name, "call nested too deeply");
+	fp++;
+	fp->sp = sp;
+	fp->nargs = (int)pc[1];
+	fp->retpc = pc + 2;
+	fp->argn = stackp - 1;	/* last argument */
+	if(fp->nargs != sp->u.defn->nargs)
+		execerror(sp->name, "called with wrong number of arguments");
+	/* bind formals */
+	f = sp->u.defn->formals;
+	arg = stackp - fp->nargs;
+	while(f){
+		s = emalloc(sizeof(Saveval));
+		s->val = f->sym->u;
+		s->type = f->sym->type;
+		s->next = f->save;
+		f->save = s;
+		f->sym->u.val = arg->val;
+		f->sym->type = VAR;
+		f = f->next;
+		arg++;
+	}
+	for (i = 0; i < fp->nargs; i++)
+		pop();	/* pop arguments; no longer needed */
+	execute(sp->u.defn->code);
+	returning = 0;
+}
+
+void
+restore(Symbol *sp)	/* restore formals associated with symbol */
+{
+	Formal *f;
+	Saveval *s;
+
+	f = sp->u.defn->formals;
+	while(f){
+		s = f->save;
+		if(s == 0)	/* more actuals than formals */
+			break;
+		f->sym->u = s->val;
+		f->sym->type = s->type;
+		f->save = s->next;
+		free(s);
+		f = f->next;
+	}
+}
+
+void
+restoreall(void)	/* restore all variables in case of error */
+{
+	while(fp>=frame && fp->sp){
+		restore(fp->sp);
+		--fp;
+	}
+	fp = frame;
+}
+
+static void
+ret(void) 		/* common return from func or proc */
+{
+	/* restore formals */
+	restore(fp->sp);
+	pc = (Inst *)fp->retpc;
+	--fp;
+	returning = 1;
+}
+
+void
+funcret(void) 	/* return from a function */
+{
+	Datum d;
+	if (fp->sp->type == PROCEDURE)
+		execerror(fp->sp->name, "(proc) returns value");
+	d = pop();	/* preserve function return value */
+	ret();
+	push(d);
+}
+
+void
+procret(void) 	/* return from a procedure */
+{
+	if (fp->sp->type == FUNCTION)
+		execerror(fp->sp->name,
+			"(func) returns no value");
+	ret();
+}
+
+void
+bltin(void) 
+{
+
+	Datum d;
+	d = pop();
+	d.val = (*(double (*)(double))*pc++)(d.val);
+	push(d);
+}
+
+void
+add(void)
+{
+	Datum d1, d2;
+	d2 = pop();
+	d1 = pop();
+	d1.val += d2.val;
+	push(d1);
+}
+
+void
+sub(void)
+{
+	Datum d1, d2;
+	d2 = pop();
+	d1 = pop();
+	d1.val -= d2.val;
+	push(d1);
+}
+
+void
+mul(void)
+{
+	Datum d1, d2;
+	d2 = pop();
+	d1 = pop();
+	d1.val *= d2.val;
+	push(d1);
+}
+
+void
+div(void)
+{
+	Datum d1, d2;
+	d2 = pop();
+	if (d2.val == 0.0)
+		execerror("division by zero", (char *)0);
+	d1 = pop();
+	d1.val /= d2.val;
+	push(d1);
+}
+
+void
+mod(void)
+{
+	Datum d1, d2;
+	d2 = pop();
+	if (d2.val == 0.0)
+		execerror("division by zero", (char *)0);
+	d1 = pop();
+	/* d1.val %= d2.val; */
+	d1.val = fmod(d1.val, d2.val);
+	push(d1);
+}
+
+void
+negate(void)
+{
+	Datum d;
+	d = pop();
+	d.val = -d.val;
+	push(d);
+}
+
+void
+verify(Symbol* s)
+{
+	if (s->type != VAR && s->type != UNDEF)
+		execerror("attempt to evaluate non-variable", s->name);
+	if (s->type == UNDEF)
+		execerror("undefined variable", s->name);
+}
+
+void
+eval(void)		/* evaluate variable on stack */
+{
+	Datum d;
+	d = pop();
+	verify(d.sym);
+	d.val = d.sym->u.val;
+	push(d);
+}
+
+void
+preinc(void)
+{
+	Datum d;
+	d.sym = (Symbol *)(*pc++);
+	verify(d.sym);
+	d.val = d.sym->u.val += 1.0;
+	push(d);
+}
+
+void
+predec(void)
+{
+	Datum d;
+	d.sym = (Symbol *)(*pc++);
+	verify(d.sym);
+	d.val = d.sym->u.val -= 1.0;
+	push(d);
+}
+
+void
+postinc(void)
+{
+	Datum d;
+	double v;
+	d.sym = (Symbol *)(*pc++);
+	verify(d.sym);
+	v = d.sym->u.val;
+	d.sym->u.val += 1.0;
+	d.val = v;
+	push(d);
+}
+
+void
+postdec(void)
+{
+	Datum d;
+	double v;
+	d.sym = (Symbol *)(*pc++);
+	verify(d.sym);
+	v = d.sym->u.val;
+	d.sym->u.val -= 1.0;
+	d.val = v;
+	push(d);
+}
+
+void
+gt(void)
+{
+	Datum d1, d2;
+	d2 = pop();
+	d1 = pop();
+	d1.val = (double)(d1.val > d2.val);
+	push(d1);
+}
+
+void
+lt(void)
+{
+	Datum d1, d2;
+	d2 = pop();
+	d1 = pop();
+	d1.val = (double)(d1.val < d2.val);
+	push(d1);
+}
+
+void
+ge(void)
+{
+	Datum d1, d2;
+	d2 = pop();
+	d1 = pop();
+	d1.val = (double)(d1.val >= d2.val);
+	push(d1);
+}
+
+void
+le(void)
+{
+	Datum d1, d2;
+	d2 = pop();
+	d1 = pop();
+	d1.val = (double)(d1.val <= d2.val);
+	push(d1);
+}
+
+void
+eq(void)
+{
+	Datum d1, d2;
+	d2 = pop();
+	d1 = pop();
+	d1.val = (double)(d1.val == d2.val);
+	push(d1);
+}
+
+void
+ne(void)
+{
+	Datum d1, d2;
+	d2 = pop();
+	d1 = pop();
+	d1.val = (double)(d1.val != d2.val);
+	push(d1);
+}
+
+void
+and(void)
+{
+	Datum d1, d2;
+	d2 = pop();
+	d1 = pop();
+	d1.val = (double)(d1.val != 0.0 && d2.val != 0.0);
+	push(d1);
+}
+
+void
+or(void)
+{
+	Datum d1, d2;
+	d2 = pop();
+	d1 = pop();
+	d1.val = (double)(d1.val != 0.0 || d2.val != 0.0);
+	push(d1);
+}
+
+void
+not(void)
+{
+	Datum d;
+	d = pop();
+	d.val = (double)(d.val == 0.0);
+	push(d);
+}
+
+void
+power(void)
+{
+	Datum d1, d2;
+	d2 = pop();
+	d1 = pop();
+	d1.val = Pow(d1.val, d2.val);
+	push(d1);
+}
+
+void
+assign(void)
+{
+	Datum d1, d2;
+	d1 = pop();
+	d2 = pop();
+	if (d1.sym->type != VAR && d1.sym->type != UNDEF)
+		execerror("assignment to non-variable",
+			d1.sym->name);
+	d1.sym->u.val = d2.val;
+	d1.sym->type = VAR;
+	push(d2);
+}
+
+void
+addeq(void)
+{
+	Datum d1, d2;
+	d1 = pop();
+	d2 = pop();
+	if (d1.sym->type != VAR && d1.sym->type != UNDEF)
+		execerror("assignment to non-variable",
+			d1.sym->name);
+	d2.val = d1.sym->u.val += d2.val;
+	d1.sym->type = VAR;
+	push(d2);
+}
+
+void
+subeq(void)
+{
+	Datum d1, d2;
+	d1 = pop();
+	d2 = pop();
+	if (d1.sym->type != VAR && d1.sym->type != UNDEF)
+		execerror("assignment to non-variable",
+			d1.sym->name);
+	d2.val = d1.sym->u.val -= d2.val;
+	d1.sym->type = VAR;
+	push(d2);
+}
+
+void
+muleq(void)
+{
+	Datum d1, d2;
+	d1 = pop();
+	d2 = pop();
+	if (d1.sym->type != VAR && d1.sym->type != UNDEF)
+		execerror("assignment to non-variable",
+			d1.sym->name);
+	d2.val = d1.sym->u.val *= d2.val;
+	d1.sym->type = VAR;
+	push(d2);
+}
+
+void
+diveq(void)
+{
+	Datum d1, d2;
+	d1 = pop();
+	d2 = pop();
+	if (d1.sym->type != VAR && d1.sym->type != UNDEF)
+		execerror("assignment to non-variable",
+			d1.sym->name);
+	d2.val = d1.sym->u.val /= d2.val;
+	d1.sym->type = VAR;
+	push(d2);
+}
+
+void
+modeq(void)
+{
+	Datum d1, d2;
+	long x;
+	d1 = pop();
+	d2 = pop();
+	if (d1.sym->type != VAR && d1.sym->type != UNDEF)
+		execerror("assignment to non-variable",
+			d1.sym->name);
+	/* d2.val = d1.sym->u.val %= d2.val; */
+	x = d1.sym->u.val;
+	x %= (long) d2.val;
+	d2.val = d1.sym->u.val = x;
+	d1.sym->type = VAR;
+	push(d2);
+}
+
+void
+printtop(void)	/* pop top value from stack, print it */
+{
+	Datum d;
+	static Symbol *s;	/* last value computed */
+	if (s == 0)
+		s = install("_", VAR, 0.0);
+	d = pop();
+	print("%.12g\n", d.val);
+	s->u.val = d.val;
+}
+
+void
+prexpr(void)	/* print numeric value */
+{
+	Datum d;
+	d = pop();
+	print("%.12g ", d.val);
+}
+
+void
+prstr(void)		/* print string value */ 
+{
+	print("%s", (char *) *pc++);
+}
+
+void
+varread(void)	/* read into variable */
+{
+	Datum d;
+	extern Biobuf *bin;
+	Symbol *var = (Symbol *) *pc++;
+	int c;
+
+  Again:
+	do
+		c = Bgetc(bin);
+	while(c==' ' || c=='\t');
+	if(c == Beof){
+  Iseof:
+		if(moreinput())
+			goto Again;
+		d.val = var->u.val = 0.0;
+		goto Return;
+	}
+
+	if(strchr("+-.0123456789", c) == 0)
+		execerror("non-number read into", var->name);
+	Bungetc(bin);
+	if(Bgetd(bin, &var->u.val) == Beof)
+		goto Iseof;
+	else
+		d.val = 1.0;
+  Return:
+	var->type = VAR;
+	push(d);
+}
+
+Inst*
+code(Inst f)	/* install one instruction or operand */
+{
+	Inst *oprogp = progp;
+	if (progp >= &prog[NPROG])
+		execerror("program too big", (char *)0);
+	*progp++ = f;
+	return oprogp;
+}
+
+void
+execute(Inst* p)
+{
+	for (pc = p; *pc != STOP && !returning; )
+		(*((++pc)[-1]))();
+}

src/cmd/hoc/hoc.h

@@ -0,0 +1,83 @@
+typedef void (*Inst)(void);
+#define	STOP	(Inst) 0
+
+typedef struct Symbol	Symbol;
+typedef union Datum 	Datum;
+typedef struct Formal	Formal;
+typedef struct Saveval	Saveval;
+typedef struct Fndefn	Fndefn;
+typedef union Symval	Symval;
+
+union Symval { /* value of a symbol */
+	double	val;		/* VAR */
+	double	(*ptr)(double);	/* BLTIN */
+	Fndefn	*defn;		/* FUNCTION, PROCEDURE */
+	char	*str;		/* STRING */
+};
+
+struct Symbol {	/* symbol table entry */
+	char	*name;
+	long	type;
+	Symval u;
+	struct Symbol	*next;	/* to link to another */
+};
+Symbol	*install(char*, int, double), *lookup(char*);
+
+union Datum {	/* interpreter stack type */
+	double	val;
+	Symbol	*sym;
+};
+
+struct Saveval {	/* saved value of variable */
+	Symval	val;
+	long		type;
+	Saveval	*next;
+};
+
+struct Formal {	/* formal parameter */
+	Symbol	*sym;
+	Saveval	*save;
+	Formal	*next;
+};
+
+struct Fndefn {	/* formal parameter */
+	Inst	*code;
+	Formal	*formals;
+	int	nargs;
+};
+
+extern	Formal *formallist(Symbol*, Formal*);
+extern	double Fgetd(int);
+extern	int moreinput(void);
+extern	void restore(Symbol*);
+extern	void restoreall(void);
+extern	void execerror(char*, char*);
+extern	void define(Symbol*, Formal*), verify(Symbol*);
+extern	Datum pop(void);
+extern	void initcode(void), push(Datum), xpop(void), constpush(void);
+extern	void varpush(void);
+#define div hocdiv
+extern	void eval(void), add(void), sub(void), mul(void), div(void), mod(void);
+extern	void negate(void), power(void);
+extern	void addeq(void), subeq(void), muleq(void), diveq(void), modeq(void);
+
+extern	Inst *progp, *progbase, prog[], *code(Inst);
+extern	void assign(void), bltin(void), varread(void);
+extern	void prexpr(void), prstr(void);
+extern	void gt(void), lt(void), eq(void), ge(void), le(void), ne(void);
+extern	void and(void), or(void), not(void);
+extern	void ifcode(void), whilecode(void), forcode(void);
+extern	void call(void), arg(void), argassign(void);
+extern	void funcret(void), procret(void);
+extern	void preinc(void), predec(void), postinc(void), postdec(void);
+extern	void execute(Inst*);
+extern	void printtop(void);
+
+extern double	Log(double), Log10(double), Gamma(double), Sqrt(double), Exp(double);
+extern double	Asin(double), Acos(double), Sinh(double), Cosh(double), integer(double);
+extern double	Pow(double, double);
+
+extern	void init(void);
+extern	int yyparse(void);
+extern	void execerror(char*, char*);
+extern	void *emalloc(unsigned);

src/cmd/hoc/hoc.y

@@ -0,0 +1,398 @@
+%{
+#include <u.h>
+#include <libc.h>
+#include <bio.h>
+#include <ctype.h>
+#include "hoc.h"
+#define	code2(c1,c2)	code(c1); code(c2)
+#define	code3(c1,c2,c3)	code(c1); code(c2); code(c3)
+%}
+%union {
+	Symbol	*sym;	/* symbol table pointer */
+	Inst	*inst;	/* machine instruction */
+	int	narg;	/* number of arguments */
+	Formal	*formals;	/* list of formal parameters */
+}
+%token	<sym>	NUMBER STRING PRINT VAR BLTIN UNDEF WHILE FOR IF ELSE
+%token	<sym>	FUNCTION PROCEDURE RETURN FUNC PROC READ
+%type	<formals>	formals
+%type	<inst>	expr stmt asgn prlist stmtlist
+%type	<inst>	cond while for if begin end 
+%type	<sym>	procname
+%type	<narg>	arglist
+%right	'=' ADDEQ SUBEQ MULEQ DIVEQ MODEQ
+%left	OR
+%left	AND
+%left	GT GE LT LE EQ NE
+%left	'+' '-'
+%left	'*' '/' '%'
+%left	UNARYMINUS NOT INC DEC
+%right	'^'
+%%
+list:	  /* nothing */
+	| list '\n'
+	| list defn '\n'
+	| list asgn '\n'  { code2(xpop, STOP); return 1; }
+	| list stmt '\n'  { code(STOP); return 1; } 
+	| list expr '\n'  { code2(printtop, STOP); return 1; }
+	| list error '\n' { yyerrok; }
+	;
+asgn:	  VAR '=' expr { code3(varpush,(Inst)$1,assign); $$=$3; }
+	| VAR ADDEQ expr	{ code3(varpush,(Inst)$1,addeq); $$=$3; }
+	| VAR SUBEQ expr	{ code3(varpush,(Inst)$1,subeq); $$=$3; }
+	| VAR MULEQ expr	{ code3(varpush,(Inst)$1,muleq); $$=$3; }
+	| VAR DIVEQ expr	{ code3(varpush,(Inst)$1,diveq); $$=$3; }
+	| VAR MODEQ expr	{ code3(varpush,(Inst)$1,modeq); $$=$3; }
+	;
+stmt:	  expr	{ code(xpop); }
+	| RETURN { defnonly("return"); code(procret); }
+	| RETURN expr
+	        { defnonly("return"); $$=$2; code(funcret); }
+	| PROCEDURE begin '(' arglist ')'
+		{ $$ = $2; code3(call, (Inst)$1, (Inst)$4); }
+	| PRINT prlist	{ $$ = $2; }
+	| while '(' cond ')' stmt end {
+		($1)[1] = (Inst)$5;	/* body of loop */
+		($1)[2] = (Inst)$6; }	/* end, if cond fails */
+	| for '(' cond ';' cond ';' cond ')' stmt end {
+		($1)[1] = (Inst)$5;	/* condition */
+		($1)[2] = (Inst)$7;	/* post loop */
+		($1)[3] = (Inst)$9;	/* body of loop */
+		($1)[4] = (Inst)$10; }	/* end, if cond fails */
+	| if '(' cond ')' stmt end {	/* else-less if */
+		($1)[1] = (Inst)$5;	/* thenpart */
+		($1)[3] = (Inst)$6; }	/* end, if cond fails */
+	| if '(' cond ')' stmt end ELSE stmt end {	/* if with else */
+		($1)[1] = (Inst)$5;	/* thenpart */
+		($1)[2] = (Inst)$8;	/* elsepart */
+		($1)[3] = (Inst)$9; }	/* end, if cond fails */
+	| '{' stmtlist '}'	{ $$ = $2; }
+	;
+cond:	   expr 	{ code(STOP); }
+	;
+while:	  WHILE	{ $$ = code3(whilecode,STOP,STOP); }
+	;
+for:	  FOR	{ $$ = code(forcode); code3(STOP,STOP,STOP); code(STOP); }
+	;
+if:	  IF	{ $$ = code(ifcode); code3(STOP,STOP,STOP); }
+	;
+begin:	  /* nothing */		{ $$ = progp; }
+	;
+end:	  /* nothing */		{ code(STOP); $$ = progp; }
+	;
+stmtlist: /* nothing */		{ $$ = progp; }
+	| stmtlist '\n'
+	| stmtlist stmt
+	;
+expr:	  NUMBER { $$ = code2(constpush, (Inst)$1); }
+	| VAR	 { $$ = code3(varpush, (Inst)$1, eval); }
+	| asgn
+	| FUNCTION begin '(' arglist ')'
+		{ $$ = $2; code3(call,(Inst)$1,(Inst)$4); }
+	| READ '(' VAR ')' { $$ = code2(varread, (Inst)$3); }
+	| BLTIN '(' expr ')' { $$=$3; code2(bltin, (Inst)$1->u.ptr); }
+	| '(' expr ')'	{ $$ = $2; }
+	| expr '+' expr	{ code(add); }
+	| expr '-' expr	{ code(sub); }
+	| expr '*' expr	{ code(mul); }
+	| expr '/' expr	{ code(div); }
+	| expr '%' expr	{ code(mod); }
+	| expr '^' expr	{ code (power); }
+	| '-' expr   %prec UNARYMINUS   { $$=$2; code(negate); }
+	| expr GT expr	{ code(gt); }
+	| expr GE expr	{ code(ge); }
+	| expr LT expr	{ code(lt); }
+	| expr LE expr	{ code(le); }
+	| expr EQ expr	{ code(eq); }
+	| expr NE expr	{ code(ne); }
+	| expr AND expr	{ code(and); }
+	| expr OR expr	{ code(or); }
+	| NOT expr	{ $$ = $2; code(not); }
+	| INC VAR	{ $$ = code2(preinc,(Inst)$2); }
+	| DEC VAR	{ $$ = code2(predec,(Inst)$2); }
+	| VAR INC	{ $$ = code2(postinc,(Inst)$1); }
+	| VAR DEC	{ $$ = code2(postdec,(Inst)$1); }
+	;
+prlist:	  expr			{ code(prexpr); }
+	| STRING		{ $$ = code2(prstr, (Inst)$1); }
+	| prlist ',' expr	{ code(prexpr); }
+	| prlist ',' STRING	{ code2(prstr, (Inst)$3); }
+	;
+defn:	  FUNC procname { $2->type=FUNCTION; indef=1; }
+	    '(' formals ')' stmt { code(procret); define($2, $5); indef=0; }
+	| PROC procname { $2->type=PROCEDURE; indef=1; }
+	    '(' formals ')' stmt { code(procret); define($2, $5); indef=0; }
+	;
+formals:	{ $$ = 0; }
+	| VAR			{ $$ = formallist($1, 0); }
+	| VAR ',' formals	{ $$ = formallist($1, $3); }
+	;
+procname: VAR
+	| FUNCTION
+	| PROCEDURE
+	;
+arglist:  /* nothing */ 	{ $$ = 0; }
+	| expr			{ $$ = 1; }
+	| arglist ',' expr	{ $$ = $1 + 1; }
+	;
+%%
+	/* end of grammar */
+char	*progname;
+int	lineno = 1;
+jmp_buf	begin;
+int	indef;
+char	*infile;	/* input file name */
+Biobuf	*bin;		/* input file descriptor */
+Biobuf	binbuf;
+char	**gargv;	/* global argument list */
+int	gargc;
+
+int c = '\n';	/* global for use by warning() */
+
+int	backslash(int), follow(int, int, int);
+void	defnonly(char*), run(void);
+void	warning(char*, char*);
+
+int
+yylex(void)		/* hoc6 */
+{
+	while ((c=Bgetc(bin)) == ' ' || c == '\t')
+		;
+	if (c < 0)
+		return 0;
+	if (c == '\\') {
+		c = Bgetc(bin);
+		if (c == '\n') {
+			lineno++;
+			return yylex();
+		}
+	}
+	if (c == '#') {		/* comment */
+		while ((c=Bgetc(bin)) != '\n' && c >= 0)
+			;
+		if (c == '\n')
+			lineno++;
+		return c;
+	}
+	if (c == '.' || isdigit(c)) {	/* number */
+		double d;
+		Bungetc(bin);
+		Bgetd(bin, &d);
+		yylval.sym = install("", NUMBER, d);
+		return NUMBER;
+	}
+	if (isalpha(c) || c == '_') {
+		Symbol *s;
+		char sbuf[100], *p = sbuf;
+		do {
+			if (p >= sbuf + sizeof(sbuf) - 1) {
+				*p = '\0';
+				execerror("name too long", sbuf);
+			}
+			*p++ = c;
+		} while ((c=Bgetc(bin)) >= 0 && (isalnum(c) || c == '_'));
+		Bungetc(bin);
+		*p = '\0';
+		if ((s=lookup(sbuf)) == 0)
+			s = install(sbuf, UNDEF, 0.0);
+		yylval.sym = s;
+		return s->type == UNDEF ? VAR : s->type;
+	}
+	if (c == '"') {	/* quoted string */
+		char sbuf[100], *p;
+		for (p = sbuf; (c=Bgetc(bin)) != '"'; p++) {
+			if (c == '\n' || c == Beof)
+				execerror("missing quote", "");
+			if (p >= sbuf + sizeof(sbuf) - 1) {
+				*p = '\0';
+				execerror("string too long", sbuf);
+			}
+			*p = backslash(c);
+		}
+		*p = 0;
+		yylval.sym = (Symbol *)emalloc(strlen(sbuf)+1);
+		strcpy((char*)yylval.sym, sbuf);
+		return STRING;
+	}
+	switch (c) {
+	case '+':	return follow('+', INC, follow('=', ADDEQ, '+'));
+	case '-':	return follow('-', DEC, follow('=', SUBEQ, '-'));
+	case '*':	return follow('=', MULEQ, '*');
+	case '/':	return follow('=', DIVEQ, '/');
+	case '%':	return follow('=', MODEQ, '%');
+	case '>':	return follow('=', GE, GT);
+	case '<':	return follow('=', LE, LT);
+	case '=':	return follow('=', EQ, '=');
+	case '!':	return follow('=', NE, NOT);
+	case '|':	return follow('|', OR, '|');
+	case '&':	return follow('&', AND, '&');
+	case '\n':	lineno++; return '\n';
+	default:	return c;
+	}
+}
+
+int
+backslash(int c)	/* get next char with \'s interpreted */
+{
+	static char transtab[] = "b\bf\fn\nr\rt\t";
+	if (c != '\\')
+		return c;
+	c = Bgetc(bin);
+	if (islower(c) && strchr(transtab, c))
+		return strchr(transtab, c)[1];
+	return c;
+}
+
+int
+follow(int expect, int ifyes, int ifno)	/* look ahead for >=, etc. */
+{
+	int c = Bgetc(bin);
+
+	if (c == expect)
+		return ifyes;
+	Bungetc(bin);
+	return ifno;
+}
+
+void
+yyerror(char* s)	/* report compile-time error */
+{
+/*rob
+	warning(s, (char *)0);
+	longjmp(begin, 0);
+rob*/
+	execerror(s, (char *)0);
+}
+
+void
+execerror(char* s, char* t)	/* recover from run-time error */
+{
+	warning(s, t);
+	Bseek(bin, 0L, 2);		/* flush rest of file */
+	restoreall();
+	longjmp(begin, 0);
+}
+
+void
+fpecatch(void)	/* catch floating point exceptions */
+{
+	execerror("floating point exception", (char *) 0);
+}
+
+void
+intcatch(void)	/* catch interrupts */
+{
+	execerror("interrupt", 0);
+}
+
+void
+run(void)	/* execute until EOF */
+{
+	setjmp(begin);
+	for (initcode(); yyparse(); initcode())
+		execute(progbase);
+}
+
+void
+main(int argc, char* argv[])	/* hoc6 */
+{
+	static int first = 1;
+#ifdef YYDEBUG
+	extern int yydebug;
+	yydebug=3;
+#endif
+	progname = argv[0];
+	init();
+	if (argc == 1) {	/* fake an argument list */
+		static char *stdinonly[] = { "-" };
+
+		gargv = stdinonly;
+		gargc = 1;
+	} else if (first) {	/* for interrupts */
+		first = 0;
+		gargv = argv+1;
+		gargc = argc-1;
+	}
+	Binit(&binbuf, 0, OREAD);
+	bin = &binbuf;
+	while (moreinput())
+		run();
+	exits(0);
+}
+
+int
+moreinput(void)
+{
+	char *expr;
+	static char buf[64];
+	int fd;
+	static Biobuf b;
+
+	if (gargc-- <= 0)
+		return 0;
+	if (bin && bin != &binbuf)
+		Bterm(bin);
+	infile = *gargv++;
+	lineno = 1;
+	if (strcmp(infile, "-") == 0) {
+		bin = &binbuf;
+		infile = 0;
+		return 1;
+	}
+	if(strncmp(infile, "-e", 2) == 0) {
+		if(infile[2]==0){
+			if(gargc == 0){
+				fprint(2, "%s: no argument for -e\n", progname);
+				return 0;
+			}
+			gargc--;
+			expr = *gargv++;
+		}else
+			expr = infile+2;
+		sprint(buf, "/tmp/hocXXXXXXX");
+		fd = mkstemp(buf);
+		remove(buf);
+/*
+		infile = mktemp(buf);
+		fd = create(infile, ORDWR|ORCLOSE, 0600);
+		if(fd < 0){
+			fprint(2, "%s: can't create temp. file: %r\n", progname);
+			return 0;
+		}
+*/
+		fprint(fd, "%s\n", expr);
+		/* leave fd around; file will be removed on exit */
+		/* the following looks weird but is required for unix version */
+		bin = &b;
+		seek(fd, 0, 0);
+		Binit(bin, fd, OREAD);
+	} else {
+		bin=Bopen(infile, OREAD);
+		if (bin == 0) {
+			fprint(2, "%s: can't open %s\n", progname, infile);
+			return moreinput();
+		}
+	}
+	return 1;
+}
+
+void
+warning(char* s, char* t)	/* print warning message */
+{
+	fprint(2, "%s: %s", progname, s);
+	if (t)
+		fprint(2, " %s", t);
+	if (infile)
+		fprint(2, " in %s", infile);
+	fprint(2, " near line %d\n", lineno);
+	while (c != '\n' && c != Beof)
+		if((c = Bgetc(bin)) == '\n')	/* flush rest of input line */
+			lineno++;
+}
+
+void
+defnonly(char *s)	/* warn if illegal definition */
+{
+	if (!indef)
+		execerror(s, "used outside definition");
+}

src/cmd/hoc/init.c

@@ -0,0 +1,69 @@
+#include <u.h>
+#include <libc.h>
+#include "hoc.h"
+#include "y.tab.h"
+
+static struct {		/* Keywords */
+	char	*name;
+	int	kval;
+} keywords[] = {
+	"proc",		PROC,
+	"func",		FUNC,
+	"return",	RETURN,
+	"if",		IF,
+	"else",		ELSE,
+	"while",	WHILE,
+	"for",		FOR,
+	"print",	PRINT,
+	"read",		READ,
+	0,		0,
+};
+
+static struct {		/* Constants */
+	char *name;
+	double cval;
+} consts[] = {
+	"PI",	 3.14159265358979323846,
+	"E",	 2.71828182845904523536,
+	"GAMMA", 0.57721566490153286060,  /* Euler */
+	"DEG",	57.29577951308232087680,  /* deg/radian */
+	"PHI",   1.61803398874989484820,  /* golden ratio */
+	0,	 0
+};
+
+static struct {		/* Built-ins */
+	char *name;
+	double	(*func)(double);
+} builtins[] = {
+	"sin",	sin,
+	"cos",	cos,
+	"tan",	tan,
+	"atan",	atan,
+	"asin",	Asin,	/* checks range */
+	"acos", Acos,	/* checks range */
+	"sinh",	Sinh,	/* checks range */
+	"cosh",	Cosh,	/* checks range */
+	"tanh",	tanh,
+	"log",	Log,	/* checks range */
+	"log10", Log10,	/* checks range */
+	"exp",	Exp,	/* checks range */
+	"sqrt",	Sqrt,	/* checks range */
+	"int",	integer,
+	"abs",	fabs,
+	0,	0
+};
+
+void
+init(void)	/* install constants and built-ins in table */
+{
+	int i;
+	Symbol *s;
+	for (i = 0; keywords[i].name; i++)
+		install(keywords[i].name, keywords[i].kval, 0.0);
+	for (i = 0; consts[i].name; i++)
+		install(consts[i].name, VAR, consts[i].cval);
+	for (i = 0; builtins[i].name; i++) {
+		s = install(builtins[i].name, BLTIN, 0.0);
+		s->u.ptr = builtins[i].func;
+	}
+}

src/cmd/hoc/math.c

@@ -0,0 +1,75 @@
+#include <u.h>
+#include <libc.h>
+
+#include "hoc.h"
+
+double	errcheck(double, char*);
+
+double
+Log(double x)
+{
+	return errcheck(log(x), "log");
+}
+double
+Log10(double x)
+{
+	return errcheck(log10(x), "log10");
+}
+
+double
+Sqrt(double x)
+{
+	return errcheck(sqrt(x), "sqrt");
+}
+
+double
+Exp(double x)
+{
+	return errcheck(exp(x), "exp");
+}
+
+double
+Asin(double x)
+{
+	return errcheck(asin(x), "asin");
+}
+
+double
+Acos(double x)
+{
+	return errcheck(acos(x), "acos");
+}
+
+double
+Sinh(double x)
+{
+	return errcheck(sinh(x), "sinh");
+}
+double
+Cosh(double x)
+{
+	return errcheck(cosh(x), "cosh");
+}
+double
+Pow(double x, double y)
+{
+	return errcheck(pow(x,y), "exponentiation");
+}
+
+double
+integer(double x)
+{
+	if(x<-2147483648.0 || x>2147483647.0)
+		execerror("argument out of domain", 0);
+	return (double)(long)x;
+}
+
+double
+errcheck(double d, char* s)	/* check result of library call */
+{
+	if(isNaN(d))
+		execerror(s, "argument out of domain");
+	if(isInf(d, 0))
+		execerror(s, "result out of range");
+	return d;
+}

src/cmd/hoc/mkfile

@@ -0,0 +1,20 @@
+PLAN9=../../..
+<$PLAN9/src/mkhdr
+
+TARG=hoc
+HFILES=\
+	y.tab.h\
+	hoc.h\
+
+OFILES=\
+	y.tab.$O\
+	code.$O\
+	init.$O\
+	math.$O\
+	symbol.$O\
+
+YFILES=hoc.y\
+
+<$PLAN9/src/mkone
+
+LDFLAGS=$LDFLAGS -lbio -l9 -lfmt -lutf

src/cmd/hoc/symbol.c

@@ -0,0 +1,55 @@
+#include <u.h>
+#include <libc.h>
+#include "hoc.h"
+#include "y.tab.h"
+
+static Symbol *symlist = 0;  /* symbol table: linked list */
+
+Symbol*
+lookup(char* s)	/* find s in symbol table */
+{
+	Symbol *sp;
+
+	for (sp = symlist; sp != (Symbol *) 0; sp = sp->next)
+		if (strcmp(sp->name, s) == 0)
+			return sp;
+	return 0;	/* 0 ==> not found */	
+}
+
+Symbol*
+install(char* s, int t, double d)  /* install s in symbol table */
+{
+	Symbol *sp;
+
+	sp = emalloc(sizeof(Symbol));
+	sp->name = emalloc(strlen(s)+1); /* +1 for '\0' */
+	strcpy(sp->name, s);
+	sp->type = t;
+	sp->u.val = d;
+	sp->next = symlist; /* put at front of list */
+	symlist = sp;
+	return sp;
+}
+
+void*
+emalloc(unsigned n)	/* check return from malloc */
+{
+	char *p;
+
+	p = malloc(n);
+	if (p == 0)
+		execerror("out of memory", (char *) 0);
+	return p;
+}
+
+Formal*
+formallist(Symbol *formal, Formal *list)	/* add formal to list */
+{
+	Formal *f;
+
+	f = emalloc(sizeof(Formal));
+	f->sym = formal;
+	f->save = 0;
+	f->next = list;
+	return f;
+}

src/cmd/yacc.c

@@ -13,8 +13,8 @@
 #define SETBIT(a,i)	((a)[(i)>>5] |= (1<<((i)&037)))
 #define NWORDS(n)	(((n)+32)/32)
 
-#define PARSER		"/sys/lib/yaccpar"
+#define PARSER		"lib/yaccpar"
-#define PARSERS		"/sys/lib/yaccpars"
+#define PARSERS		"lib/yaccpars"
 #define TEMPNAME	"y.tmp.XXXXXX"
 #define ACTNAME		"y.acts.XXXXXX"
 #define OFILE		"tab.c"
@@ -398,10 +398,19 @@ void
 others(void)
 {
 	int c, i, j;
+	char *s, *root;
 
-	finput = Bopen(parser, OREAD);
+	root = getenv("PLAN9");
+	if(root == nil)
+		root = "/usr/local/plan9";
+	s = malloc(strlen(root)+1+strlen(parser)+1);
+	strcpy(s, root);
+	strcat(s, "/");
+	strcat(s, parser);
+	finput = Bopen(s, OREAD);
 	if(finput == 0)
-		error("cannot find parser %s", parser);
+		error("cannot find parser %s", s);
+	free(s);
 	warray("yyr1", levprd, nprod);
 	aryfil(temp1, nprod, 0);
 	PLOOP(1, i)