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

Керниган Брайан Уилсон

 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 {