UNIX — универсальная среда программирования

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

}

argassign /* store top of stack in argument */

{

 Datum d;

 d = pop;

 push(d); /* leave value on stack */

 *getarg = d.val;

}

bltin {

 Datum d;

 d = pop;

 d.val = (*(double(*))*pc++)(d.val);

 push(d);

}

eval /* evaluate variable on stack */

{

 Datum d;

 d = pop;