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;
}
3.5.7 symbol.c
#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;
{
Symbol *sp;
char *emalloc;
sp = (Symbol*)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;
}
char *emalloc(n) /* check return from malloc */
unsigned n;
{
char *p, *malloc;
p = malloc(n);
if (p == 0)
execerror("out of memory", (char*)0);
return p;
}
3.6 hoc5
3.6.1 code.c
#include "hoc.h"
#include "y.tab.h"
#define NSTACK 256
static Datum stack[NSTACK];
static Datum *stackp;
#define NPROG 2000
Inst prog[NPROG];
static Inst *pc;
Inst *progp;
initcode {
progp = prog;
stackp = stack;
}
push(d)
Datum d;
{
if (stackp = stack[NSTACK])
execerror("stack too deep", (char*)0);
*stackp++ = d;
}
Datum pop {
if (stackp == stack)
execerror("stack underflow", (char*)0);
return *--stackp;
}
constpush {
Datum d;
d.val = ((Symbol*)*pc++)-u.val;
push(d);
}
varpush {
Datum d;
d.sym = (Symbol*)(*pc++);
push(d);
}
whilecode {
Datum d;
Inst *savepc = pc; /* loop body */
execute(savepc+2); /* condition */
d = pop;
while (d.val) {
execute (*((Inst**)(savepc))); /* body */
execute(savepc+2);
d = pop;
}
pc = *((Inst**)(savepc+1)); /* next statement */
}
ifcode {
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)));
pc = *((Inst**)(savepc+2)); /* next stmt */
}
bltin {
Datum d;
d = pop;
d.val = (*(double(*))(*pc++))(d.val);
push(d);
}
eval /* Evaluate variable on stack */ {
Datum d;
d = pop;
if (d.sym-type != VAR d.sym-type != UNDEF)
execerror("attempt to evaluate non-variable", d.sym-name);
if (d.sym-type == UNDEF)
execerror("undefined variable", d.sym-name);
d.val = d.sym-u.val;
push(d);
}
add {
Datum d1, d2;
d2 = pop;
d1 = pop;
d1.val += d2.val;
push(d1);
}
sub {
Datum d1, d2;
d2 = pop;
d1 = pop;