hoc.sh

c programming pearls answer

-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();
-	printf("%.*g\n", (int)lookup("PREC")->u.val, d.val);
-	s->u.val = d.val;
-}
-
-void
-prexpr(void)	/* print numeric value */
-{
-	Datum d;
-	d = pop();
-	printf("%.*g ", (int)lookup("PREC")->u.val, d.val);
-}
-
-void
-prstr(void)		/* print string value */ 
-{
-	printf("%s", (char *) *pc++);
-}
-
-void
-varread(void)	/* read into variable */
-{
-	Datum d;
-	extern FILE *fin;
-	Symbol *var = (Symbol *) *pc++;
-  Again:
-	switch (fscanf(fin, "%lf", &var->u.val)) {
-	case EOF:
-		if (moreinput())
-			goto Again;
-		d.val = var->u.val = 0.0;
-		break;
-	case 0:
-		execerror("non-number read into", var->name);
-		break;
-	default:
-		d.val = 1.0;
-		break;
-	}
-	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]))();
-}
//GO.SYSIN DD code.c
echo hoc.1 1>&2
sed 's/.//' >hoc.1 <<'//GO.SYSIN DD hoc.1'
-.TH HOC 1
-.CT 1 numbers
-.SH NAME
-hoc \(mi interactive floating point language
-.SH SYNOPSIS
-.B hoc
-[
-.I file ...
-]
-.SH DESCRIPTION
-.I Hoc
-interprets a simple language for floating point arithmetic,
-at about the level of Basic, with C-like syntax and
-functions.
-.PP
-The named
-.IR file s
-are read and interpreted in order.
-If no
-.I file
-is given or if
-.I file
-is
-.L -
-.I hoc
-interprets the standard input.
-.PP
-.I Hoc
-input consists of
-.I expressions
-and
-.IR statements .
-Expressions are evaluated and their results printed.
-Statements, typically assignments and function or procedure
-definitions, produce no output unless they explicitly call
-.IR print .
-.PP
-Variable names have the usual syntax, including 
-.LR _ ;
-the name 
-.L _
-by itself contains the value of the last expression evaluated.
-Certain variables are already initialized:
-.TP
-.B E
-base of natural logs
-.PD0
-.TP
-.B PI
-.TP
-.B PHI
-golden ratio
-.TP
-.B GAMMA 
-Euler's constant
-.TP
-.B DEG 
-180/PI, degrees per radian
-.TP
-.B PREC
-maximum number of significant digits in output, initially 15;
-.B PREC=0
-gives shortest `exact' values.
-.PD
-.PP
-Expressions are formed with these C-like operators, listed by
-decreasing precedence.
-.TP
-.B ^
-exponentiation
-.TP
-.B ! - ++ --
-.TP
-.B * / %
-.TP
-.B + -
-.TP
-.B > >= < <= == !=
-.TP
-.B &&
-.TP
-.B ||
-.TP
-.B = += -= *= /= %=
-.PP
-Built in functions include
-.BR abs ,
-.BR acos ,
-.B atan
-(one argument),
-.BR cos ,
-.BR cosh ,
-.BR erf ,
-.BR erfc ,
-.BR exp ,
-.BR gamma ,
-.BR int ,
-.BR log ,
-.BR log10 ,
-.BR sin ,
-.BR sinh ,
-.BR sqrt ,
-.BR tan ,
-and
-.BR tanh .
-The function
-.B read(x)
-reads a value into the variable
-.BR x ;
-the statement
-.B print
-prints a list of expressions that may include
-string constants such as
-.B \&\&\&"hello\en".
-.PP
-Control flow statements are
-.BR if - else ,
-.BR while ,
-and
-.BR for ,
-with braces for grouping.
-Newline ends a statement.
-Backslash-newline is equivalent to a space.
-.PP
-Functions and procedures are introduced by the words
-.B func
-and
-.BR proc ;
-.B return
-is used to return with a value from a function.
-Within a function or procedure,
-arguments are referred to as
-.BR $1 ,
-.BR $2 ,
-etc.; all other variables are global.
-.SH EXAMPLES
-.EX
-func gcd() {
-	temp = abs($1) % abs($2)
-	if(temp == 0) return abs($2)
-	return gcd($2, temp)
-}
-for(i=1; i<12; i++) print gcd(i,12)
-.EE
-.SH "SEE ALSO"
-.IR bc (1),
-.IR dc (1)
-.br
-B. W. Kernighan and R. Pike,
-.I
-The Unix Programming Environment,
-Prentice-Hall, 1984
-.SH BUGS
-.br
-All components of a 
-.B for
-statement must be non-empty.
-.br
-Error recovery is imperfect within function and procedure definitions.
-.br
-The treatment of newlines is not exactly user-friendly.
-.br
-Functions and procedures typically have to be declared
-before use, which makes mutual recursion a bit impossible.
-.br
-Arguments $1, etc., are not really variables and thus won't work
-in constructs like, for instance, $1++.
//GO.SYSIN DD hoc.1
echo hoc.h 1>&2
sed 's/.//' >hoc.h <<'//GO.SYSIN DD hoc.h'
-typedef void (*Inst)(void);
-#define	STOP	(Inst) 0
-
-typedef struct Symbol {	/* symbol table entry */
-	char	*name;
-	long	type;
-	union {
-		double	val;		/* VAR */
-		double	(*ptr)(double);	/* BLTIN */
-		Inst	*defn;		/* FUNCTION, PROCEDURE */
-		char	*str;		/* STRING */
-	} u;
-	struct Symbol	*next;	/* to link to another */
-} Symbol;
-Symbol	*install(char*, int, double), *lookup(char*);
-
-typedef union Datum {	/* interpreter stack type */
-	double	val;
-	Symbol	*sym;
-} Datum;
-extern	double Fgetd(int);
-extern	int moreinput(void);
-extern	void execerror(char*, char*);
-extern	void define(Symbol*), verify(Symbol*);
-extern	Datum pop(void);
-extern	void initcode(void), push(Datum), xpop(void), constpush(void);
-extern	void varpush(void);
-extern	void eval(void), add(void), sub(void), mul(void), divop(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 argaddeq(void), argsubeq(void), argmuleq(void);
-extern	void argdiveq(void), argmodeq(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);
-
-extern	void defnonly(char *);
-extern	void warning(char *s, char *t);
//GO.SYSIN DD hoc.h
echo hoc.y 1>&2
sed 's/.//' >hoc.y <<'//GO.SYSIN DD hoc.y'
-%{
-#include <string.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 */
-}
-%token	<sym>	NUMBER STRING PRINT VAR BLTIN UNDEF WHILE FOR IF ELSE
-%token	<sym>	FUNCTION PROCEDURE RETURN FUNC PROC READ
-%token	<narg>	ARG
-%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; }
-	| ARG '=' expr   { defnonly("$"); code2(argassign,(Inst)$1); $$=$3;}
-	| ARG ADDEQ expr { defnonly("$"); code2(argaddeq,(Inst)$1); $$=$3;}
-	| ARG SUBEQ expr { defnonly("$"); code2(argsubeq,(Inst)$1); $$=$3;}
-	| ARG MULEQ expr { defnonly("$"); code2(argmuleq,(Inst)$1); $$=$3;}
-	| ARG DIVEQ expr { defnonly("$"); code2(argdiveq,(Inst)$1); $$=$3;}
-	| ARG MODEQ expr { defnonly("$"); code2(argmodeq,(Inst)$1); $$=$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); }
-	| ARG	 { defnonly("$"); $$ = code2(arg, (Inst)$1); }
-	| 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(divop); }	/* ansi has a div fcn! */
-	| 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; }
-	    '(' ')' stmt { code(procret); define($2); indef=0; }
-	| PROC procname { $2->type=PROCEDURE; indef=1; }
-	    '(' ')' stmt { code(procret); define($2); indef=0; }
-	;
-procname: VAR
-	| FUNCTION
-	| PROCEDURE
-	;
-arglist:  /* nothing */ 	{ $$ = 0; }
-	| expr			{ $$ = 1; }
-	| arglist ',' expr	{ $$ = $1 + 1; }
-	;
-%%
-	/* end of grammar */
-#include <stdio.h>
-#include <ctype.h>
-char	*progname;
-int	lineno = 1;
-#include <signal.h>
-#include <setjmp.h>
-#include <errno.h>
-jmp_buf	begin;
-int	indef;
-char	*infile;	/* input file name */
-FILE	*fin;		/* input file pointer */
-char	**gargv;	/* global argument list */
-extern	errno;
-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*);
-
-yylex(void)		/* hoc6 */
-{
-	while ((c=getc(fin)) == ' ' || c == '\t')
-		;
-	if (c == EOF)
-		return 0;
-	if (c == '\\') {
-		c = getc(fin);
-		if (c == '\n') {
-			lineno++;
-			return yylex();
-		}
-	}
-	if (c == '#') {		/* comment */
-		while ((c=getc(fin)) != '\n' && c != EOF)
-			;
-		if (c == '\n')
-			lineno++;
-		return c;
-	}
-	if (c == '.' || isdigit(c)) {	/* number */