hoc.sh

c programming pearls answer

-		double d;
-		ungetc(c, fin);
-		fscanf(fin, "%lf", &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=getc(fin)) != EOF && (isalnum(c) || c == '_'));
-		ungetc(c, fin);
-		*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 == '$') {	/* argument? */
-		int n = 0;
-		while (isdigit(c=getc(fin)))
-			n = 10 * n + c - '0';
-		ungetc(c, fin);
-		if (n == 0)
-			execerror("strange $...", (char *)0);
-		yylval.narg = n;
-		return ARG;
-	}
-	if (c == '"') {	/* quoted string */
-		char sbuf[100], *p;
-		for (p = sbuf; (c=getc(fin)) != '"'; p++) {
-			if (c == '\n' || c == EOF)
-				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;
-	}
-}
-
-backslash(int c)	/* get next char with \'s interpreted */
-{
-	static char transtab[] = "b\bf\fn\nr\rt\t";
-	if (c != '\\')
-		return c;
-	c = getc(fin);
-	if (islower(c) && strchr(transtab, c))
-		return strchr(transtab, c)[1];
-	return c;
-}
-
-follow(int expect, int ifyes, int ifno)	/* look ahead for >=, etc. */
-{
-	int c = getc(fin);
-
-	if (c == expect)
-		return ifyes;
-	ungetc(c, fin);
-	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);
-	fseek(fin, 0L, 2);		/* flush rest of file */
-	longjmp(begin, 0);
-}
-
-void
-fpecatch(void)	/* catch floating point exceptions */
-{
-	execerror("floating point exception", (char *) 0);
-}
-
-void
-intcatch(void)	/* catch interrupts */
-{
-	execerror("interrupt", (char *) 0);
-}
-
-void
-run(void)	/* execute until EOF */
-{
-	setjmp(begin);
-	signal(SIGINT, intcatch);
-	signal(SIGFPE, fpecatch);
-	for (initcode(); yyparse(); initcode())
-		execute(progbase);
-}
-
-int
-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;
-	}
-	while (moreinput())
-		run();
-	signal(SIGINT, SIG_IGN);
-	return 0;
-}
-
-moreinput(void)
-{
-	if (gargc-- <= 0)
-		return 0;
-	if (fin && fin != stdin)
-		fclose(fin);
-	infile = *gargv++;
-	lineno = 1;
-	if (strcmp(infile, "-") == 0) {
-		fin = stdin;
-		infile = 0;
-	} else if ((fin=fopen(infile, "r")) == NULL) {
-		fprintf(stderr, "%s: can't open %s\n", progname, infile);
-		return moreinput();
-	}
-	return 1;
-}
-
-void
-warning(char *s, char *t)	/* print warning message */
-{
-	fprintf(stderr, "%s: %s", progname, s);
-	if (t)
-		fprintf(stderr, " %s", t);
-	if (infile)
-		fprintf(stderr, " in %s", infile);
-	fprintf(stderr, " near line %d\n", lineno);
-	while (c != '\n' && c != EOF)
-		if((c = getc(fin)) == '\n')	/* flush rest of input line */
-			lineno++;
-		else if (c == EOF && errno == EINTR) {
-			clearerr(stdin);	/* ick! */
-			errno = 0;
-		}
-}
-
-void
-defnonly(char *s)	/* warn if illegal definition */
-{
-	if (!indef)
-		execerror(s, "used outside definition");
-}
//GO.SYSIN DD hoc.y
echo init.c 1>&2
sed 's/.//' >init.c <<'//GO.SYSIN DD init.c'
-#include "hoc.h"
-#include "y.tab.h"
-#include <math.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 */
-	"PREC",	15,	/* output precision */
-	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 */
-	"gamma", Gamma,	/* checks range */
-	"int",	integer,
-	"abs",	fabs,
-	"erf",	erf,
-	"erfc",	erfc,
-	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;
-	}
-}
//GO.SYSIN DD init.c
echo makefile 1>&2
sed 's/.//' >makefile <<'//GO.SYSIN DD makefile'
-YFLAGS = -d
-CFLAGS = -g
-
-SRC = hoc.y hoc.h code.c init.c math.c symbol.c
-OBJS = hoc.o code.o init.o math.o symbol.o
-
-hoc:	$(OBJS)
-	$(CC) $(CFLAGS) $(OBJS) -lstdio -lm -o hoc
-
-hoc.o code.o init.o symbol.o:	hoc.h
-
-code.o init.o symbol.o:	x.tab.h
-
-x.tab.h:	y.tab.h
-	-cmp -s x.tab.h y.tab.h || cp y.tab.h x.tab.h
-
-pr:	$(SRC)
-	@prcan $?
-	@touch pr
-
-install:	hoc
-	cp hoc /usr/bin
-	strip /usr/bin/hoc
-
-clean:
-	rm -f $(OBJS) [xy].tab.[ch]  hoc
-
-bundle:
-	@bundle $(SRC) makefile README
//GO.SYSIN DD makefile
echo math.c 1>&2
sed 's/.//' >math.c <<'//GO.SYSIN DD math.c'
-#include <math.h>
-#include <errno.h>
-extern	int	errno;
-double	errcheck();
-
-#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
-Gamma(double x)
-{
-	double y;
-	extern int signgam;
-	y=errcheck(gamma(x), "gamma");
-	if(y>88.0)
-		execerror("gamma result out of range", (char *)0);
-	return signgam*exp(y);
-}
-
-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)
-{
-	return (double)(long)x;
-}
-
-double
-errcheck(double d, char* s)	/* check result of library call */
-{
-	if (errno == EDOM) {
-		errno = 0;
-		execerror(s, "argument out of domain");
-	} else if (errno == ERANGE) {
-		errno = 0;
-		execerror(s, "result out of range");
-	}
-	return d;
-}
//GO.SYSIN DD math.c
echo symbol.c 1>&2
sed 's/.//' >symbol.c <<'//GO.SYSIN DD symbol.c'
-#include <stdlib.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;
-}
//GO.SYSIN DD symbol.c
echo tests.a 1>&2
sed 's/.//' >tests.a <<'//GO.SYSIN DD tests.a'
-!<arch>
-ack             437774800   9     1     100666  161       `
-func ack() {
-	n = n+1
-	if($1 == 0) return ($2+1)
-	if($2 == 0) 	 return (ack($1 - 1, 1))
-	return (ack($1 - 1, ack($1, $2 - 1)))
-}
-n=0
-ack(3,3)
-print n, "calls\n"
-
-ack1            437774800   9     1     100666  197       `
-func ack() {
-	n = n+1
-	if($1 == 0) return ($2+1)
-	if($2 == 0) 	 return (ack($1 - 1, 1))
-	return (ack($1 - 1, ack($1, $2 - 1)))
-}
-n=0
-while (read(x)) {
-	read(y)
-	print ack(x,y), "\n"
-}
-print n,"\n"
-
-double          437774801   9     1     100666  89        `
-proc double(){
-}
-proc double(){
-	if($1 > 1){
-		double($1/2)
-	}
-	print($1)
-}
-double(1024)
-
-fac             437774801   9     1     100666  65        `
-func fac() {
-	if ($1 <= 0) return 1 else return $1 * fac($1-1)
-}
-
-fac1            437774801   9     1     100666  82        `
-func fac() if ($1 <= 0) return 1 else return $1 * fac($1-1)
-fac(0)
-fac(7)
-fac(10)
-fac2            437774802   9     1     100666  142       `
-func fac() {
-	if ($1 <= 0) {
-		return 1
-	}
-	return $1 * fac($1-1)
-}
-i=0
-while(i<=20){
-	print "factorial of ", i, "is ", fac(i), "\n"
-	i=i+1
-}
-fib             437774802   9     1     100666  98        `
-proc fib() {
-	a = 0
-	b = 1
-	while (b < $1) {
-		print b
-		c = b
-		b = a+b
-		a = c
-	}
-	print "\n"
-}
-fib2            437774802   9     1     100666  80        `
-{
-n=0
-a=0
-b=1
-while(b<10000000){
-	n=n+1
-	c=b
-	b=a+b
-	a=c
-	print(b)
-}
-print(n)
-}
-fibsum          437774802   9     1     100666  144       `
-proc fib(){
-	a=1
-	b=1
-	c=2
-	d=3
-	sum = a+b+c+d
-	while(d<$1){
-		e=d+c
-		print(e)
-		a=b
-		b=c
-		c=d
-		d=e
-		sum=sum+e
-	}
-	print(sum)
-}
-
-fib(1000)
-fibtest         437774802   9     1     100666  126       `
-proc fib() {
-	a = 0
-	b = 1
-	while (b < $1) {
-		c = b
-		b = a+b
-		a = c
-	}
-}
-
-i = 1
-while (i < 1000) {
-	fib(1000)
-	i = i + 1
-}
//GO.SYSIN DD tests.a