UNIX

 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;