hoc.sh

c programming pearls answer

# To unbundle, sh this file
echo README 1>&2
sed 's/.//' >README <<'//GO.SYSIN DD README'
-/****************************************************************
-Copyright (C) AT&T 1995
-All Rights Reserved
-
-Permission to use, copy, modify, and distribute this software and
-its documentation for any purpose and without fee is hereby
-granted, provided that the above copyright notice appear in all
-copies and that both that the copyright notice and this
-permission notice and warranty disclaimer appear in supporting
-documentation, and that the name of AT&T or any of its entities
-not be used in advertising or publicity pertaining to
-distribution of the software without specific, written prior
-permission.
-
-AT&T DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE,
-INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS.
-IN NO EVENT SHALL AT&T OR ANY OF ITS ENTITIES BE LIABLE FOR ANY
-SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
-WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER
-IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION,
-ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF
-THIS SOFTWARE.
-****************************************************************/
-
-This version of hoc is slightly modified from the one
-found in The Unix Programming Environment, by Brian Kernighan
-and Rob Pike (Addison-Wesley, 1984).
-
-Changes since the book version:
-
-1.  The variable "_" contains the result of the last
-top-level expression evaluation, so you can re-use
-intermediate values without re-typing them.
-
-2.  for statement added, like the one in C,
-except that components may not be empty.
-
-3.  ++ and -- added, but don't work with $i.
-
-4.  Interrupts are caught; use cntrl-D to quit.
-
-5.  % operator added.
-
-6.  +=, -=, etc., added.
-
-7.  \ at end of line eats newline.
-
-8.  results are 15 digits but variable PREC can be
-used to override this.
-
-9.  tabs on output are no longer.
-
-10. asin, acos, sinh, cosh, tanh, erf, erfc
//GO.SYSIN DD README
echo code.c 1>&2
sed 's/.//' >code.c <<'//GO.SYSIN DD code.c'
-#include "hoc.h"
-#include "y.tab.h"
-#include <stdio.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 */
-extern 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)	/* put func/proc in symbol table */
-{
-	sp->u.defn = progbase;	/* start of code */
-	progbase = progp;	/* next code starts here */
-}
-
-void
-call(void) 		/* call a function */
-{
-	Symbol *sp = (Symbol *)pc[0]; /* symbol table entry */
-				      /* for function */
-	if (fp++ >= &frame[NFRAME-1])
-		execerror(sp->name, "call nested too deeply");
-	fp->sp = sp;
-	fp->nargs = (int)pc[1];
-	fp->retpc = pc + 2;
-	fp->argn = stackp - 1;	/* last argument */
-	execute(sp->u.defn);
-	returning = 0;
-}
-
-static void
-ret(void) 		/* common return from func or proc */
-{
-	int i;
-	for (i = 0; i < fp->nargs; i++)
-		pop();	/* pop arguments */
-	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();
-}
-
-double*
-getarg(void) 	/* return pointer to argument */
-{
-	int nargs = (int) *pc++;
-	if (nargs > fp->nargs)
-	    execerror(fp->sp->name, "not enough arguments");
-	return &fp->argn[nargs - fp->nargs].val;
-}
-
-void
-arg(void) 	/* push argument onto stack */
-{
-	Datum d;
-	d.val = *getarg();
-	push(d);
-}
-
-void
-argassign(void) 	/* store top of stack in argument */
-{
-	Datum d;
-	d = pop();
-	push(d);	/* leave value on stack */
-	*getarg() = d.val;
-}
-
-void
-argaddeq(void) 	/* store top of stack in argument */
-{
-	Datum d;
-	d = pop();
-	d.val = *getarg() += d.val;
-	push(d);	/* leave value on stack */
-}
-
-void
-argsubeq(void) 	/* store top of stack in argument */
-{
-	Datum d;
-	d = pop();
-	d.val = *getarg() -= d.val;
-	push(d);	/* leave value on stack */
-}
-
-void
-argmuleq(void) 	/* store top of stack in argument */
-{
-	Datum d;
-	d = pop();
-	d.val = *getarg() *= d.val;
-	push(d);	/* leave value on stack */
-}
-
-void
-argdiveq(void) 	/* store top of stack in argument */
-{
-	Datum d;
-	d = pop();
-	d.val = *getarg() /= d.val;
-	push(d);	/* leave value on stack */
-}
-
-void
-argmodeq(void) 	/* store top of stack in argument */
-{
-	Datum d;
-	double *x;
-	long y;
-	d = pop();
-	/* d.val = *getarg() %= d.val; */
-	x = getarg();
-	y = *x;
-	d.val = *x = y % (long) d.val;
-	push(d);	/* leave value on stack */
-}
-
-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
-divop(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;
-	long x;
-	d2 = pop();
-	if (d2.val == 0.0)
-		execerror("division by zero", (char *)0);
-	d1 = pop();
-	/* d1.val %= d2.val; */
-	x = d1.val;
-	x %= (long) d2.val;
-	d1.val = d2.val = x;
-	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