UNIX

Inst *progbase = prog; /* start of current subprogram */

int  returning; /* 1 if return stmt seen */

typedef struct Frame { /* proc/func call stack frame */

 Symbol *sp;    /* symbol table entry */

 Inst   *retpc; /* where to resume after return */

 Datum  *argn;  /* n-th argument on stack */

 int    nargs;  /* number of arguments */

} Frame;

#define NFRAME 100

Frame frame[NFRAME];

Frame *fp; /* frame pointer */

initcode() {

 progp = progbase;

 stackp = stack;

 fp = frame;

 returning = 0;

}

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;

 execute(savepc+2); /* condition */

 d = pop();

 while (d.val) {

  execute(*((Inst**)(savepc))); /* body */

  if (returning)

   break;

  execute(savepc+2); /* condition */

  d = pop();

 }

 if (!returning)

  pc = *((Inst**)(savepc+1)); /* next stmt */

}

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

 if (!returning)

  pc = *((Inst**)(savepc+2)); /* next stmt */

}

define(sp) /* put func/proc in symbol table */

 Symbol *sp;

{

 sp->u.defn = (Inst)progbase; /* start of code */

 progbase = progp; /* next code starts here */

}

call() /* call a function */

{

 Symbol *sp = (Symbol*)pc[0]; /* symbol table entry */

 /* for function */

 if (fp++ >= &frame[NFRAME-1])

  execerror(sp->name, "call nested too deeply");

 fp->sp = sp;

 fp->nargs = (int)pc[1];

 fp->retpc = pc + 2;

 fp->argn = stackp - 1; /* last argument */

 execute(sp->u.defn);

 returning = 0;

}

ret() /* common return from func or proc */

{

 int i;

 for (i = 0; i < fp->nargs; i++)

  pop(); /* pop arguments */

 pc = (Inst*)fp->retpc;

 --fp;

 returning = 1;

}

funcret() /* return from a function */

{

 Datum d;

 if (fp->sp->type == PROCEDURE)

  execerror(fp->sp->name, "(proc) returns value");

 d = pop(); /* preserve function return value */

 ret();

 push(d);

}

procret() /* return from a procedure */

{

 if (fp->sp->type == FUNCTION)

  execerror(fp->sp->name, "(func) returns no value");

 ret();

}

double *getarg() /* return pointer to argument */

{

 int nargs = (int)*pc++;

 if (nargs > fp->nargs)

  execerror(fp->sp->name, "not enough arguments");

 return &fp->argn[nargs - fp->nargs].val;

}

arg() /* push argument onto stack */

{

 Datum d;

 d.val = *getarg();

 push(d);

}