9 static Datum stack[NSTACK]; /* the stack */
10 static Datum *stackp; /* next free spot on stack */
13 Inst prog[NPROG]; /* the machine */
14 Inst *progp; /* next free spot for code generation */
15 Inst *pc; /* program counter during execution */
16 Inst *progbase = prog; /* start of current subprogram */
17 int returning; /* 1 if return stmt seen */
18 int indef; /* 1 if parsing a func or proc */
20 typedef struct Frame { /* proc/func call stack frame */
21 Symbol *sp; /* symbol table entry */
22 Inst *retpc; /* where to resume after return */
23 Datum *argn; /* n-th argument on stack */
24 int nargs; /* number of arguments */
28 Frame *fp; /* frame pointer */
43 if (stackp >= &stack[NSTACK])
44 execerror("stack too deep", 0);
52 execerror("stack underflow", 0);
57 xpop(void) /* for when no value is wanted */
60 execerror("stack underflow", (char *)0);
68 d.val = ((Symbol *)*pc++)->u.val;
76 d.sym = (Symbol *)(*pc++);
86 execute(savepc+2); /* condition */
89 execute(*((Inst **)(savepc))); /* body */
92 execute(savepc+2); /* condition */
96 pc = *((Inst **)(savepc+1)); /* next stmt */
105 execute(savepc+4); /* precharge */
107 execute(*((Inst **)(savepc))); /* condition */
110 execute(*((Inst **)(savepc+2))); /* body */
113 execute(*((Inst **)(savepc+1))); /* post loop */
115 execute(*((Inst **)(savepc))); /* condition */
119 pc = *((Inst **)(savepc+3)); /* next stmt */
126 Inst *savepc = pc; /* then part */
128 execute(savepc+3); /* condition */
131 execute(*((Inst **)(savepc)));
132 else if (*((Inst **)(savepc+1))) /* else part? */
133 execute(*((Inst **)(savepc+1)));
135 pc = *((Inst **)(savepc+2)); /* next stmt */
139 define(Symbol* sp, Formal *f) /* put func/proc in symbol table */
144 fd = emalloc(sizeof(Fndefn));
145 fd->code = progbase; /* start of code */
146 progbase = progp; /* next code starts here */
148 for(n=0; f; f=f->next)
155 call(void) /* call a function */
162 Symbol *sp = (Symbol *)pc[0]; /* symbol table entry */
164 if (fp >= &frame[NFRAME-1])
165 execerror(sp->name, "call nested too deeply");
168 fp->nargs = (int)(uintptr)pc[1];
170 fp->argn = stackp - 1; /* last argument */
171 if(fp->nargs != sp->u.defn->nargs)
172 execerror(sp->name, "called with wrong number of arguments");
174 f = sp->u.defn->formals;
175 arg = stackp - fp->nargs;
177 s = emalloc(sizeof(Saveval));
179 s->type = f->sym->type;
182 f->sym->u.val = arg->val;
187 for (i = 0; i < fp->nargs; i++)
188 pop(); /* pop arguments; no longer needed */
189 execute(sp->u.defn->code);
194 restore(Symbol *sp) /* restore formals associated with symbol */
199 f = sp->u.defn->formals;
202 if(s == 0) /* more actuals than formals */
205 f->sym->type = s->type;
213 restoreall(void) /* restore all variables in case of error */
215 while(fp>=frame && fp->sp){
223 ret(void) /* common return from func or proc */
225 /* restore formals */
227 pc = (Inst *)fp->retpc;
233 funcret(void) /* return from a function */
236 if (fp->sp->type == PROCEDURE)
237 execerror(fp->sp->name, "(proc) returns value");
238 d = pop(); /* preserve function return value */
244 procret(void) /* return from a procedure */
246 if (fp->sp->type == FUNCTION)
247 execerror(fp->sp->name,
248 "(func) returns no value");
258 d.val = (*(double (*)(double))*pc++)(d.val);
298 execerror("division by zero", (char *)0);
310 execerror("division by zero", (char *)0);
312 /* d1.val %= d2.val; */
313 d1.val = fmod(d1.val, d2.val);
329 if (s->type != VAR && s->type != UNDEF)
330 execerror("attempt to evaluate non-variable", s->name);
331 if (s->type == UNDEF)
332 execerror("undefined variable", s->name);
336 eval(void) /* evaluate variable on stack */
341 d.val = d.sym->u.val;
349 d.sym = (Symbol *)(*pc++);
351 d.val = d.sym->u.val += 1.0;
359 d.sym = (Symbol *)(*pc++);
361 d.val = d.sym->u.val -= 1.0;
370 d.sym = (Symbol *)(*pc++);
383 d.sym = (Symbol *)(*pc++);
397 d1.val = (double)(d1.val > d2.val);
407 d1.val = (double)(d1.val < d2.val);
417 d1.val = (double)(d1.val >= d2.val);
427 d1.val = (double)(d1.val <= d2.val);
437 d1.val = (double)(d1.val == d2.val);
447 d1.val = (double)(d1.val != d2.val);
457 d1.val = (double)(d1.val != 0.0 && d2.val != 0.0);
467 d1.val = (double)(d1.val != 0.0 || d2.val != 0.0);
476 d.val = (double)(d.val == 0.0);
486 d1.val = Pow(d1.val, d2.val);
496 if (d1.sym->type != VAR && d1.sym->type != UNDEF)
497 execerror("assignment to non-variable",
499 d1.sym->u.val = d2.val;
510 if (d1.sym->type != VAR && d1.sym->type != UNDEF)
511 execerror("assignment to non-variable",
513 d2.val = d1.sym->u.val += d2.val;
524 if (d1.sym->type != VAR && d1.sym->type != UNDEF)
525 execerror("assignment to non-variable",
527 d2.val = d1.sym->u.val -= d2.val;
538 if (d1.sym->type != VAR && d1.sym->type != UNDEF)
539 execerror("assignment to non-variable",
541 d2.val = d1.sym->u.val *= d2.val;
552 if (d1.sym->type != VAR && d1.sym->type != UNDEF)
553 execerror("assignment to non-variable",
555 d2.val = d1.sym->u.val /= d2.val;
567 if (d1.sym->type != VAR && d1.sym->type != UNDEF)
568 execerror("assignment to non-variable",
570 /* d2.val = d1.sym->u.val %= d2.val; */
573 d2.val = d1.sym->u.val = x;
579 printtop(void) /* pop top value from stack, print it */
582 static Symbol *s; /* last value computed */
584 s = install("_", VAR, 0.0);
586 print("%.12g\n", d.val);
591 prexpr(void) /* print numeric value */
595 print("%.12g ", d.val);
599 prstr(void) /* print string value */
601 print("%s", (char *) *pc++);
605 varread(void) /* read into variable */
609 Symbol *var = (Symbol *) *pc++;
615 while(c==' ' || c=='\t' || c=='\n');
620 d.val = var->u.val = 0.0;
624 if(strchr("+-.0123456789", c) == 0)
625 execerror("non-number read into", var->name);
627 if(Bgetd(bin, &var->u.val) == Beof)
637 code(Inst f) /* install one instruction or operand */
639 Inst *oprogp = progp;
640 if (progp >= &prog[NPROG])
641 execerror("program too big", (char *)0);
649 for (pc = p; *pc != STOP && !returning; )