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);
}