return STRING;
}
switch (c) {
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(c) /* get next char with 's interpreted */
int c;
{
char *index(); /* 'strchr()' in some systems */
static char transtab[] = "bbffnnrrtt";
if (c != '\')
return c;
с = getc(fin);
if (islower(c) && index(transtab, c))
return index(transtab, с)[1];
return c;
}
follow(expect, ifyes, ifno) /* look ahead for >=, etc. */
{
int с = getc(fin);
if (c == expect)
return ifyes;
ungetc(c, fin);
return ifno;
}
defnonly(s) /* warn if illegal definition */
char *s;
{
if (!indef)
execerror(s, "used outside definition");
}
yyerror(s) /* report compile-time error */
char *s;
{
warning(s, (char *)0);
}
execerror(s, t) /* recover from run-time error */
char *s, *t;
{
warning(s, t);
fseek(fin, 0L, 2); /* flush rest of file */
longjmp(begin, 0);
}
fpecatch() /* catch floating point exceptions */
{
execerror("floating point exception", (char*)0);
}
main(argc, argv) /* hoc6 */
char *argv[];
{
int i, fpecatch();
progname = argv[0];
if (argc == 1) { /* fake an argument list */
static char *stdinonly[] = { "-" };
gargv = stdinonly;
gargc = 1;
} else {
gargv = argv+1;
gargc = argc-1;
}
init();
while (moreinput())
run();
return 0;
}
moreinput() {
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 %sn", progname, infile);
return moreinput();
}
return 1;
}
run() /* execute until EOF */
{
setjmp(begin);
signal(SIGFPE, fpecatch);
for (initcode(); yyparse(); initcode())
execute(progbase);
}
warning(s, t) /* print warning message */
char *s, *t;
{
fprintf(stderr, "%s: %s", progname, s);
if (t)
fprintf(stderr, " %s", t);
if (infile)
fprintf(stderr, " in %s", infile);
fprintf(stderr, " near line %dn", lineno);
while (c != 'n' && c != EOF)
с = getc(fin); /* flush rest of input line */
if (c == 'n')
lineno++;
}
#include "hoc.h"
#include "y.tab.h"
#include <math.h>
extern double Log(), Log10(), Sqrt(), Exp(), integer();
static struct { /* Keywords */
char *name;
int kval;
} keywords[] = {
"proc", PROC,
"func", FUNC,
"return", RETURN,
"if", IF,
"else", ELSE,
"while", WHILE,
"print", PRINT,
"read", READ,
0, 0,
};
static struct { /* Constants */
char *name;
double eval;
} 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)();
} builtins[] = {
"sin", sin,
"cos", cos,
"atan", atan,
"log", Log, /* checks range */
"log10", Log10, /* checks range */
"exp", Exp, /* checks range */
"sqrt", Sqrt, /* checks range */
"int", integer,
"abs", fabs,
0, 0
};
init() /* 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].eval);
for (i = 0; builtins[i].name; i++) {
s = install(builtins[i].name, BLTIN, 0.0);
s->u.ptr = builtins[i].func;
}
}
#!/bin/sh
cd hoc6
for i in hoc.y hoc.h symbol.c code.c init.c math.c makefile
do
echo "
**** $i ***************************************
"
sed 's/\/\e/g
s/^$/.sp .5/' $i |
awk '
{ print }
/(^ ;$)|(^})|(^%%)/ { print ".P3" }
'
done
CC = lcc
YFLAGS = -d
OBJS = hoc.o code.o init.o math.o symbol.o
hoc6: $(OBJS)
$(CC) $(CFLAGS) $(OBJS) -lm -o hoc6
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: hoc.y hoc.h code.c init.c math.c symbol.c
@pr $?
@touch pr
clean:
rm -f $(OBJS) [xy].tab.[ch]
#include <math.h>
#include <errno.h>
extern int errno;
double errcheck();
double Log(x)
double x;
{
return errcheck(log(x), "log");
}
double Log10(x)
double x;
{
return errcheck(log10(x), "log10");
}
double Sqrt(x)
double x;
{
return errcheck(sqrt(x), "sqrt");
}
double Exp(x)
double x;
{
return errcheck(exp(x), "exp");
}
double Pow(x, y)
double x, y;
{
return errcheck(pow(x,y), "exponentiation");
}
double integer(x)
double x;
{
return (double)(long)x;
}
double errcheck(d, s) /* check result of library call */
double d;
char *s;
{
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;
}
From: Polyhedron Software Ltd < [email protected]>
To: ">INTERNET: [email protected]" < [email protected] >
Subject: Message from Internet
Date: 10 May 91 04:07:07 EDT
Message-Id: <"910510080707 100013.461 CHE27-1"@CompuServe.COM>
Got your message. I'll pass it on to Tony. We haven't noticed any
errors at all in CompuServe mail, so far.
Regards
Graham Wood
From kam Thu May 9 10:58:06 EDT 1991
tony fritzpatrick called from england. he had spoken to you
last week about compuserve.
the number is:
100013,461
this is regarding the HOC6 listing.
he will call you back tomorrow
From pipe!subll276 Fri May 3 10:38:29 EDT 1991
Message to: BK
From: Tony Fitzpatrick
ECL
Highlands Farm
Greys Road
Henley OXON, RG 94 PS
ENGLAND
Telephone: 0491 - 575-989 (country code 45)
FAX: 0491 576 557
1. H would like permission
(which has already been granted by publisher) to
use HUC 6 program — commercial software.
2. Is the listing available on floppy disk?
3. Thank you for a very interesting and useful book.
4. He left his fax # and telephone #. He wasn't sure of the country code.
He would appreciate hearing from you via fax.
sub 11276
#include "hoc.h"
#include "y.tab.h"
static Symbol *symlist =0; /* symbol table: linked list */
Symbol *lookup(s) /* find s in symbol table */
char *s;
{
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(s, t, d) /* install s in symbol table */
char *s;
int t;
double d;
