13e12c5d1SDavid du Colombier #include <u.h> 23e12c5d1SDavid du Colombier #include <libc.h> 33e12c5d1SDavid du Colombier #include <bio.h> 43e12c5d1SDavid du Colombier #include "hoc.h" 53e12c5d1SDavid du Colombier #include "y.tab.h" 63e12c5d1SDavid du Colombier 73e12c5d1SDavid du Colombier #define NSTACK 256 83e12c5d1SDavid du Colombier 93e12c5d1SDavid du Colombier static Datum stack[NSTACK]; /* the stack */ 103e12c5d1SDavid du Colombier static Datum *stackp; /* next free spot on stack */ 113e12c5d1SDavid du Colombier 123e12c5d1SDavid du Colombier #define NPROG 2000 133e12c5d1SDavid du Colombier Inst prog[NPROG]; /* the machine */ 143e12c5d1SDavid du Colombier Inst *progp; /* next free spot for code generation */ 153e12c5d1SDavid du Colombier Inst *pc; /* program counter during execution */ 163e12c5d1SDavid du Colombier Inst *progbase = prog; /* start of current subprogram */ 173e12c5d1SDavid du Colombier int returning; /* 1 if return stmt seen */ 18219b2ee8SDavid du Colombier int indef; /* 1 if parsing a func or proc */ 193e12c5d1SDavid du Colombier 203e12c5d1SDavid du Colombier typedef struct Frame { /* proc/func call stack frame */ 213e12c5d1SDavid du Colombier Symbol *sp; /* symbol table entry */ 223e12c5d1SDavid du Colombier Inst *retpc; /* where to resume after return */ 233e12c5d1SDavid du Colombier Datum *argn; /* n-th argument on stack */ 243e12c5d1SDavid du Colombier int nargs; /* number of arguments */ 253e12c5d1SDavid du Colombier } Frame; 263e12c5d1SDavid du Colombier #define NFRAME 100 273e12c5d1SDavid du Colombier Frame frame[NFRAME]; 283e12c5d1SDavid du Colombier Frame *fp; /* frame pointer */ 293e12c5d1SDavid du Colombier 303e12c5d1SDavid du Colombier void 313e12c5d1SDavid du Colombier initcode(void) 323e12c5d1SDavid du Colombier { 333e12c5d1SDavid du Colombier progp = progbase; 343e12c5d1SDavid du Colombier stackp = stack; 353e12c5d1SDavid du Colombier fp = frame; 363e12c5d1SDavid du Colombier returning = 0; 37219b2ee8SDavid du Colombier indef = 0; 383e12c5d1SDavid du Colombier } 393e12c5d1SDavid du Colombier 403e12c5d1SDavid du Colombier void 413e12c5d1SDavid du Colombier push(Datum d) 423e12c5d1SDavid du Colombier { 433e12c5d1SDavid du Colombier if (stackp >= &stack[NSTACK]) 443e12c5d1SDavid du Colombier execerror("stack too deep", 0); 453e12c5d1SDavid du Colombier *stackp++ = d; 463e12c5d1SDavid du Colombier } 473e12c5d1SDavid du Colombier 483e12c5d1SDavid du Colombier Datum 493e12c5d1SDavid du Colombier pop(void) 503e12c5d1SDavid du Colombier { 513e12c5d1SDavid du Colombier if (stackp == stack) 523e12c5d1SDavid du Colombier execerror("stack underflow", 0); 533e12c5d1SDavid du Colombier return *--stackp; 543e12c5d1SDavid du Colombier } 553e12c5d1SDavid du Colombier 563e12c5d1SDavid du Colombier void 573e12c5d1SDavid du Colombier xpop(void) /* for when no value is wanted */ 583e12c5d1SDavid du Colombier { 593e12c5d1SDavid du Colombier if (stackp == stack) 603e12c5d1SDavid du Colombier execerror("stack underflow", (char *)0); 613e12c5d1SDavid du Colombier --stackp; 623e12c5d1SDavid du Colombier } 633e12c5d1SDavid du Colombier 643e12c5d1SDavid du Colombier void 653e12c5d1SDavid du Colombier constpush(void) 663e12c5d1SDavid du Colombier { 673e12c5d1SDavid du Colombier Datum d; 683e12c5d1SDavid du Colombier d.val = ((Symbol *)*pc++)->u.val; 693e12c5d1SDavid du Colombier push(d); 703e12c5d1SDavid du Colombier } 713e12c5d1SDavid du Colombier 723e12c5d1SDavid du Colombier void 733e12c5d1SDavid du Colombier varpush(void) 743e12c5d1SDavid du Colombier { 753e12c5d1SDavid du Colombier Datum d; 763e12c5d1SDavid du Colombier d.sym = (Symbol *)(*pc++); 773e12c5d1SDavid du Colombier push(d); 783e12c5d1SDavid du Colombier } 793e12c5d1SDavid du Colombier 803e12c5d1SDavid du Colombier void 813e12c5d1SDavid du Colombier whilecode(void) 823e12c5d1SDavid du Colombier { 833e12c5d1SDavid du Colombier Datum d; 843e12c5d1SDavid du Colombier Inst *savepc = pc; 853e12c5d1SDavid du Colombier 863e12c5d1SDavid du Colombier execute(savepc+2); /* condition */ 873e12c5d1SDavid du Colombier d = pop(); 883e12c5d1SDavid du Colombier while (d.val) { 893e12c5d1SDavid du Colombier execute(*((Inst **)(savepc))); /* body */ 903e12c5d1SDavid du Colombier if (returning) 913e12c5d1SDavid du Colombier break; 923e12c5d1SDavid du Colombier execute(savepc+2); /* condition */ 933e12c5d1SDavid du Colombier d = pop(); 943e12c5d1SDavid du Colombier } 953e12c5d1SDavid du Colombier if (!returning) 963e12c5d1SDavid du Colombier pc = *((Inst **)(savepc+1)); /* next stmt */ 973e12c5d1SDavid du Colombier } 983e12c5d1SDavid du Colombier 993e12c5d1SDavid du Colombier void 1003e12c5d1SDavid du Colombier forcode(void) 1013e12c5d1SDavid du Colombier { 1023e12c5d1SDavid du Colombier Datum d; 1033e12c5d1SDavid du Colombier Inst *savepc = pc; 1043e12c5d1SDavid du Colombier 1053e12c5d1SDavid du Colombier execute(savepc+4); /* precharge */ 1063e12c5d1SDavid du Colombier pop(); 1073e12c5d1SDavid du Colombier execute(*((Inst **)(savepc))); /* condition */ 1083e12c5d1SDavid du Colombier d = pop(); 1093e12c5d1SDavid du Colombier while (d.val) { 1103e12c5d1SDavid du Colombier execute(*((Inst **)(savepc+2))); /* body */ 1113e12c5d1SDavid du Colombier if (returning) 1123e12c5d1SDavid du Colombier break; 1133e12c5d1SDavid du Colombier execute(*((Inst **)(savepc+1))); /* post loop */ 1143e12c5d1SDavid du Colombier pop(); 1153e12c5d1SDavid du Colombier execute(*((Inst **)(savepc))); /* condition */ 1163e12c5d1SDavid du Colombier d = pop(); 1173e12c5d1SDavid du Colombier } 1183e12c5d1SDavid du Colombier if (!returning) 1193e12c5d1SDavid du Colombier pc = *((Inst **)(savepc+3)); /* next stmt */ 1203e12c5d1SDavid du Colombier } 1213e12c5d1SDavid du Colombier 1223e12c5d1SDavid du Colombier void 1233e12c5d1SDavid du Colombier ifcode(void) 1243e12c5d1SDavid du Colombier { 1253e12c5d1SDavid du Colombier Datum d; 1263e12c5d1SDavid du Colombier Inst *savepc = pc; /* then part */ 1273e12c5d1SDavid du Colombier 1283e12c5d1SDavid du Colombier execute(savepc+3); /* condition */ 1293e12c5d1SDavid du Colombier d = pop(); 1303e12c5d1SDavid du Colombier if (d.val) 1313e12c5d1SDavid du Colombier execute(*((Inst **)(savepc))); 1323e12c5d1SDavid du Colombier else if (*((Inst **)(savepc+1))) /* else part? */ 1333e12c5d1SDavid du Colombier execute(*((Inst **)(savepc+1))); 1343e12c5d1SDavid du Colombier if (!returning) 1353e12c5d1SDavid du Colombier pc = *((Inst **)(savepc+2)); /* next stmt */ 1363e12c5d1SDavid du Colombier } 1373e12c5d1SDavid du Colombier 1383e12c5d1SDavid du Colombier void 1397dd7cddfSDavid du Colombier define(Symbol* sp, Formal *f) /* put func/proc in symbol table */ 1403e12c5d1SDavid du Colombier { 1417dd7cddfSDavid du Colombier Fndefn *fd; 1427dd7cddfSDavid du Colombier int n; 1437dd7cddfSDavid du Colombier 1447dd7cddfSDavid du Colombier fd = emalloc(sizeof(Fndefn)); 1457dd7cddfSDavid du Colombier fd->code = progbase; /* start of code */ 1463e12c5d1SDavid du Colombier progbase = progp; /* next code starts here */ 1477dd7cddfSDavid du Colombier fd->formals = f; 1487dd7cddfSDavid du Colombier for(n=0; f; f=f->next) 1497dd7cddfSDavid du Colombier n++; 1507dd7cddfSDavid du Colombier fd->nargs = n; 1517dd7cddfSDavid du Colombier sp->u.defn = fd; 1523e12c5d1SDavid du Colombier } 1533e12c5d1SDavid du Colombier 1543e12c5d1SDavid du Colombier void 1553e12c5d1SDavid du Colombier call(void) /* call a function */ 1563e12c5d1SDavid du Colombier { 1577dd7cddfSDavid du Colombier Formal *f; 1587dd7cddfSDavid du Colombier Datum *arg; 1597dd7cddfSDavid du Colombier Saveval *s; 1607dd7cddfSDavid du Colombier int i; 1617dd7cddfSDavid du Colombier 1623e12c5d1SDavid du Colombier Symbol *sp = (Symbol *)pc[0]; /* symbol table entry */ 1633e12c5d1SDavid du Colombier /* for function */ 1647dd7cddfSDavid du Colombier if (fp >= &frame[NFRAME]) 1653e12c5d1SDavid du Colombier execerror(sp->name, "call nested too deeply"); 1667dd7cddfSDavid du Colombier fp++; 1673e12c5d1SDavid du Colombier fp->sp = sp; 168*73e742d7SDavid du Colombier fp->nargs = (int)(uintptr)pc[1]; 1693e12c5d1SDavid du Colombier fp->retpc = pc + 2; 1703e12c5d1SDavid du Colombier fp->argn = stackp - 1; /* last argument */ 1717dd7cddfSDavid du Colombier if(fp->nargs != sp->u.defn->nargs) 1727dd7cddfSDavid du Colombier execerror(sp->name, "called with wrong number of arguments"); 1737dd7cddfSDavid du Colombier /* bind formals */ 1747dd7cddfSDavid du Colombier f = sp->u.defn->formals; 1757dd7cddfSDavid du Colombier arg = stackp - fp->nargs; 1767dd7cddfSDavid du Colombier while(f){ 1777dd7cddfSDavid du Colombier s = emalloc(sizeof(Saveval)); 1787dd7cddfSDavid du Colombier s->val = f->sym->u; 1797dd7cddfSDavid du Colombier s->type = f->sym->type; 1807dd7cddfSDavid du Colombier s->next = f->save; 1817dd7cddfSDavid du Colombier f->save = s; 1827dd7cddfSDavid du Colombier f->sym->u.val = arg->val; 1837dd7cddfSDavid du Colombier f->sym->type = VAR; 1847dd7cddfSDavid du Colombier f = f->next; 1857dd7cddfSDavid du Colombier arg++; 1867dd7cddfSDavid du Colombier } 1877dd7cddfSDavid du Colombier for (i = 0; i < fp->nargs; i++) 1887dd7cddfSDavid du Colombier pop(); /* pop arguments; no longer needed */ 1897dd7cddfSDavid du Colombier execute(sp->u.defn->code); 1903e12c5d1SDavid du Colombier returning = 0; 1913e12c5d1SDavid du Colombier } 1923e12c5d1SDavid du Colombier 1937dd7cddfSDavid du Colombier void 1947dd7cddfSDavid du Colombier restore(Symbol *sp) /* restore formals associated with symbol */ 1957dd7cddfSDavid du Colombier { 1967dd7cddfSDavid du Colombier Formal *f; 1977dd7cddfSDavid du Colombier Saveval *s; 1987dd7cddfSDavid du Colombier 1997dd7cddfSDavid du Colombier f = sp->u.defn->formals; 2007dd7cddfSDavid du Colombier while(f){ 2017dd7cddfSDavid du Colombier s = f->save; 2027dd7cddfSDavid du Colombier if(s == 0) /* more actuals than formals */ 2037dd7cddfSDavid du Colombier break; 2047dd7cddfSDavid du Colombier f->sym->u = s->val; 2057dd7cddfSDavid du Colombier f->sym->type = s->type; 2067dd7cddfSDavid du Colombier f->save = s->next; 2077dd7cddfSDavid du Colombier free(s); 2087dd7cddfSDavid du Colombier f = f->next; 2097dd7cddfSDavid du Colombier } 2107dd7cddfSDavid du Colombier } 2117dd7cddfSDavid du Colombier 2127dd7cddfSDavid du Colombier void 2137dd7cddfSDavid du Colombier restoreall(void) /* restore all variables in case of error */ 2147dd7cddfSDavid du Colombier { 2157dd7cddfSDavid du Colombier while(fp>=frame && fp->sp){ 2167dd7cddfSDavid du Colombier restore(fp->sp); 2177dd7cddfSDavid du Colombier --fp; 2187dd7cddfSDavid du Colombier } 2197dd7cddfSDavid du Colombier fp = frame; 2207dd7cddfSDavid du Colombier } 2217dd7cddfSDavid du Colombier 2223e12c5d1SDavid du Colombier static void 2233e12c5d1SDavid du Colombier ret(void) /* common return from func or proc */ 2243e12c5d1SDavid du Colombier { 2257dd7cddfSDavid du Colombier /* restore formals */ 2267dd7cddfSDavid du Colombier restore(fp->sp); 2273e12c5d1SDavid du Colombier pc = (Inst *)fp->retpc; 2283e12c5d1SDavid du Colombier --fp; 2293e12c5d1SDavid du Colombier returning = 1; 2303e12c5d1SDavid du Colombier } 2313e12c5d1SDavid du Colombier 2323e12c5d1SDavid du Colombier void 2333e12c5d1SDavid du Colombier funcret(void) /* return from a function */ 2343e12c5d1SDavid du Colombier { 2353e12c5d1SDavid du Colombier Datum d; 2363e12c5d1SDavid du Colombier if (fp->sp->type == PROCEDURE) 2373e12c5d1SDavid du Colombier execerror(fp->sp->name, "(proc) returns value"); 2383e12c5d1SDavid du Colombier d = pop(); /* preserve function return value */ 2393e12c5d1SDavid du Colombier ret(); 2403e12c5d1SDavid du Colombier push(d); 2413e12c5d1SDavid du Colombier } 2423e12c5d1SDavid du Colombier 2433e12c5d1SDavid du Colombier void 2443e12c5d1SDavid du Colombier procret(void) /* return from a procedure */ 2453e12c5d1SDavid du Colombier { 2463e12c5d1SDavid du Colombier if (fp->sp->type == FUNCTION) 2473e12c5d1SDavid du Colombier execerror(fp->sp->name, 2483e12c5d1SDavid du Colombier "(func) returns no value"); 2493e12c5d1SDavid du Colombier ret(); 2503e12c5d1SDavid du Colombier } 2513e12c5d1SDavid du Colombier 2523e12c5d1SDavid du Colombier void 2533e12c5d1SDavid du Colombier bltin(void) 2543e12c5d1SDavid du Colombier { 2553e12c5d1SDavid du Colombier 2563e12c5d1SDavid du Colombier Datum d; 2573e12c5d1SDavid du Colombier d = pop(); 2583e12c5d1SDavid du Colombier d.val = (*(double (*)(double))*pc++)(d.val); 2593e12c5d1SDavid du Colombier push(d); 2603e12c5d1SDavid du Colombier } 2613e12c5d1SDavid du Colombier 2623e12c5d1SDavid du Colombier void 2633e12c5d1SDavid du Colombier add(void) 2643e12c5d1SDavid du Colombier { 2653e12c5d1SDavid du Colombier Datum d1, d2; 2663e12c5d1SDavid du Colombier d2 = pop(); 2673e12c5d1SDavid du Colombier d1 = pop(); 2683e12c5d1SDavid du Colombier d1.val += d2.val; 2693e12c5d1SDavid du Colombier push(d1); 2703e12c5d1SDavid du Colombier } 2713e12c5d1SDavid du Colombier 2723e12c5d1SDavid du Colombier void 2733e12c5d1SDavid du Colombier sub(void) 2743e12c5d1SDavid du Colombier { 2753e12c5d1SDavid du Colombier Datum d1, d2; 2763e12c5d1SDavid du Colombier d2 = pop(); 2773e12c5d1SDavid du Colombier d1 = pop(); 2783e12c5d1SDavid du Colombier d1.val -= d2.val; 2793e12c5d1SDavid du Colombier push(d1); 2803e12c5d1SDavid du Colombier } 2813e12c5d1SDavid du Colombier 2823e12c5d1SDavid du Colombier void 2833e12c5d1SDavid du Colombier mul(void) 2843e12c5d1SDavid du Colombier { 2853e12c5d1SDavid du Colombier Datum d1, d2; 2863e12c5d1SDavid du Colombier d2 = pop(); 2873e12c5d1SDavid du Colombier d1 = pop(); 2883e12c5d1SDavid du Colombier d1.val *= d2.val; 2893e12c5d1SDavid du Colombier push(d1); 2903e12c5d1SDavid du Colombier } 2913e12c5d1SDavid du Colombier 2923e12c5d1SDavid du Colombier void 2933e12c5d1SDavid du Colombier div(void) 2943e12c5d1SDavid du Colombier { 2953e12c5d1SDavid du Colombier Datum d1, d2; 2963e12c5d1SDavid du Colombier d2 = pop(); 2973e12c5d1SDavid du Colombier if (d2.val == 0.0) 2983e12c5d1SDavid du Colombier execerror("division by zero", (char *)0); 2993e12c5d1SDavid du Colombier d1 = pop(); 3003e12c5d1SDavid du Colombier d1.val /= d2.val; 3013e12c5d1SDavid du Colombier push(d1); 3023e12c5d1SDavid du Colombier } 3033e12c5d1SDavid du Colombier 3043e12c5d1SDavid du Colombier void 3053e12c5d1SDavid du Colombier mod(void) 3063e12c5d1SDavid du Colombier { 3073e12c5d1SDavid du Colombier Datum d1, d2; 3083e12c5d1SDavid du Colombier d2 = pop(); 3093e12c5d1SDavid du Colombier if (d2.val == 0.0) 3103e12c5d1SDavid du Colombier execerror("division by zero", (char *)0); 3113e12c5d1SDavid du Colombier d1 = pop(); 3123e12c5d1SDavid du Colombier /* d1.val %= d2.val; */ 3137dd7cddfSDavid du Colombier d1.val = fmod(d1.val, d2.val); 3143e12c5d1SDavid du Colombier push(d1); 3153e12c5d1SDavid du Colombier } 3163e12c5d1SDavid du Colombier 3173e12c5d1SDavid du Colombier void 3183e12c5d1SDavid du Colombier negate(void) 3193e12c5d1SDavid du Colombier { 3203e12c5d1SDavid du Colombier Datum d; 3213e12c5d1SDavid du Colombier d = pop(); 3223e12c5d1SDavid du Colombier d.val = -d.val; 3233e12c5d1SDavid du Colombier push(d); 3243e12c5d1SDavid du Colombier } 3253e12c5d1SDavid du Colombier 3263e12c5d1SDavid du Colombier void 3273e12c5d1SDavid du Colombier verify(Symbol* s) 3283e12c5d1SDavid du Colombier { 3293e12c5d1SDavid du Colombier if (s->type != VAR && s->type != UNDEF) 3303e12c5d1SDavid du Colombier execerror("attempt to evaluate non-variable", s->name); 3313e12c5d1SDavid du Colombier if (s->type == UNDEF) 3323e12c5d1SDavid du Colombier execerror("undefined variable", s->name); 3333e12c5d1SDavid du Colombier } 3343e12c5d1SDavid du Colombier 3353e12c5d1SDavid du Colombier void 3363e12c5d1SDavid du Colombier eval(void) /* evaluate variable on stack */ 3373e12c5d1SDavid du Colombier { 3383e12c5d1SDavid du Colombier Datum d; 3393e12c5d1SDavid du Colombier d = pop(); 3403e12c5d1SDavid du Colombier verify(d.sym); 3413e12c5d1SDavid du Colombier d.val = d.sym->u.val; 3423e12c5d1SDavid du Colombier push(d); 3433e12c5d1SDavid du Colombier } 3443e12c5d1SDavid du Colombier 3453e12c5d1SDavid du Colombier void 3463e12c5d1SDavid du Colombier preinc(void) 3473e12c5d1SDavid du Colombier { 3483e12c5d1SDavid du Colombier Datum d; 3493e12c5d1SDavid du Colombier d.sym = (Symbol *)(*pc++); 3503e12c5d1SDavid du Colombier verify(d.sym); 3513e12c5d1SDavid du Colombier d.val = d.sym->u.val += 1.0; 3523e12c5d1SDavid du Colombier push(d); 3533e12c5d1SDavid du Colombier } 3543e12c5d1SDavid du Colombier 3553e12c5d1SDavid du Colombier void 3563e12c5d1SDavid du Colombier predec(void) 3573e12c5d1SDavid du Colombier { 3583e12c5d1SDavid du Colombier Datum d; 3593e12c5d1SDavid du Colombier d.sym = (Symbol *)(*pc++); 3603e12c5d1SDavid du Colombier verify(d.sym); 3613e12c5d1SDavid du Colombier d.val = d.sym->u.val -= 1.0; 3623e12c5d1SDavid du Colombier push(d); 3633e12c5d1SDavid du Colombier } 3643e12c5d1SDavid du Colombier 3653e12c5d1SDavid du Colombier void 3663e12c5d1SDavid du Colombier postinc(void) 3673e12c5d1SDavid du Colombier { 3683e12c5d1SDavid du Colombier Datum d; 3693e12c5d1SDavid du Colombier double v; 3703e12c5d1SDavid du Colombier d.sym = (Symbol *)(*pc++); 3713e12c5d1SDavid du Colombier verify(d.sym); 3723e12c5d1SDavid du Colombier v = d.sym->u.val; 3733e12c5d1SDavid du Colombier d.sym->u.val += 1.0; 3743e12c5d1SDavid du Colombier d.val = v; 3753e12c5d1SDavid du Colombier push(d); 3763e12c5d1SDavid du Colombier } 3773e12c5d1SDavid du Colombier 3783e12c5d1SDavid du Colombier void 3793e12c5d1SDavid du Colombier postdec(void) 3803e12c5d1SDavid du Colombier { 3813e12c5d1SDavid du Colombier Datum d; 3823e12c5d1SDavid du Colombier double v; 3833e12c5d1SDavid du Colombier d.sym = (Symbol *)(*pc++); 3843e12c5d1SDavid du Colombier verify(d.sym); 3853e12c5d1SDavid du Colombier v = d.sym->u.val; 3863e12c5d1SDavid du Colombier d.sym->u.val -= 1.0; 3873e12c5d1SDavid du Colombier d.val = v; 3883e12c5d1SDavid du Colombier push(d); 3893e12c5d1SDavid du Colombier } 3903e12c5d1SDavid du Colombier 3913e12c5d1SDavid du Colombier void 3923e12c5d1SDavid du Colombier gt(void) 3933e12c5d1SDavid du Colombier { 3943e12c5d1SDavid du Colombier Datum d1, d2; 3953e12c5d1SDavid du Colombier d2 = pop(); 3963e12c5d1SDavid du Colombier d1 = pop(); 3973e12c5d1SDavid du Colombier d1.val = (double)(d1.val > d2.val); 3983e12c5d1SDavid du Colombier push(d1); 3993e12c5d1SDavid du Colombier } 4003e12c5d1SDavid du Colombier 4013e12c5d1SDavid du Colombier void 4023e12c5d1SDavid du Colombier lt(void) 4033e12c5d1SDavid du Colombier { 4043e12c5d1SDavid du Colombier Datum d1, d2; 4053e12c5d1SDavid du Colombier d2 = pop(); 4063e12c5d1SDavid du Colombier d1 = pop(); 4073e12c5d1SDavid du Colombier d1.val = (double)(d1.val < d2.val); 4083e12c5d1SDavid du Colombier push(d1); 4093e12c5d1SDavid du Colombier } 4103e12c5d1SDavid du Colombier 4113e12c5d1SDavid du Colombier void 4123e12c5d1SDavid du Colombier ge(void) 4133e12c5d1SDavid du Colombier { 4143e12c5d1SDavid du Colombier Datum d1, d2; 4153e12c5d1SDavid du Colombier d2 = pop(); 4163e12c5d1SDavid du Colombier d1 = pop(); 4173e12c5d1SDavid du Colombier d1.val = (double)(d1.val >= d2.val); 4183e12c5d1SDavid du Colombier push(d1); 4193e12c5d1SDavid du Colombier } 4203e12c5d1SDavid du Colombier 4213e12c5d1SDavid du Colombier void 4223e12c5d1SDavid du Colombier le(void) 4233e12c5d1SDavid du Colombier { 4243e12c5d1SDavid du Colombier Datum d1, d2; 4253e12c5d1SDavid du Colombier d2 = pop(); 4263e12c5d1SDavid du Colombier d1 = pop(); 4273e12c5d1SDavid du Colombier d1.val = (double)(d1.val <= d2.val); 4283e12c5d1SDavid du Colombier push(d1); 4293e12c5d1SDavid du Colombier } 4303e12c5d1SDavid du Colombier 4313e12c5d1SDavid du Colombier void 4323e12c5d1SDavid du Colombier eq(void) 4333e12c5d1SDavid du Colombier { 4343e12c5d1SDavid du Colombier Datum d1, d2; 4353e12c5d1SDavid du Colombier d2 = pop(); 4363e12c5d1SDavid du Colombier d1 = pop(); 4373e12c5d1SDavid du Colombier d1.val = (double)(d1.val == d2.val); 4383e12c5d1SDavid du Colombier push(d1); 4393e12c5d1SDavid du Colombier } 4403e12c5d1SDavid du Colombier 4413e12c5d1SDavid du Colombier void 4423e12c5d1SDavid du Colombier ne(void) 4433e12c5d1SDavid du Colombier { 4443e12c5d1SDavid du Colombier Datum d1, d2; 4453e12c5d1SDavid du Colombier d2 = pop(); 4463e12c5d1SDavid du Colombier d1 = pop(); 4473e12c5d1SDavid du Colombier d1.val = (double)(d1.val != d2.val); 4483e12c5d1SDavid du Colombier push(d1); 4493e12c5d1SDavid du Colombier } 4503e12c5d1SDavid du Colombier 4513e12c5d1SDavid du Colombier void 4523e12c5d1SDavid du Colombier and(void) 4533e12c5d1SDavid du Colombier { 4543e12c5d1SDavid du Colombier Datum d1, d2; 4553e12c5d1SDavid du Colombier d2 = pop(); 4563e12c5d1SDavid du Colombier d1 = pop(); 4573e12c5d1SDavid du Colombier d1.val = (double)(d1.val != 0.0 && d2.val != 0.0); 4583e12c5d1SDavid du Colombier push(d1); 4593e12c5d1SDavid du Colombier } 4603e12c5d1SDavid du Colombier 4613e12c5d1SDavid du Colombier void 4623e12c5d1SDavid du Colombier or(void) 4633e12c5d1SDavid du Colombier { 4643e12c5d1SDavid du Colombier Datum d1, d2; 4653e12c5d1SDavid du Colombier d2 = pop(); 4663e12c5d1SDavid du Colombier d1 = pop(); 4673e12c5d1SDavid du Colombier d1.val = (double)(d1.val != 0.0 || d2.val != 0.0); 4683e12c5d1SDavid du Colombier push(d1); 4693e12c5d1SDavid du Colombier } 4703e12c5d1SDavid du Colombier 4713e12c5d1SDavid du Colombier void 4723e12c5d1SDavid du Colombier not(void) 4733e12c5d1SDavid du Colombier { 4743e12c5d1SDavid du Colombier Datum d; 4753e12c5d1SDavid du Colombier d = pop(); 4763e12c5d1SDavid du Colombier d.val = (double)(d.val == 0.0); 4773e12c5d1SDavid du Colombier push(d); 4783e12c5d1SDavid du Colombier } 4793e12c5d1SDavid du Colombier 4803e12c5d1SDavid du Colombier void 4813e12c5d1SDavid du Colombier power(void) 4823e12c5d1SDavid du Colombier { 4833e12c5d1SDavid du Colombier Datum d1, d2; 4843e12c5d1SDavid du Colombier d2 = pop(); 4853e12c5d1SDavid du Colombier d1 = pop(); 4863e12c5d1SDavid du Colombier d1.val = Pow(d1.val, d2.val); 4873e12c5d1SDavid du Colombier push(d1); 4883e12c5d1SDavid du Colombier } 4893e12c5d1SDavid du Colombier 4903e12c5d1SDavid du Colombier void 4913e12c5d1SDavid du Colombier assign(void) 4923e12c5d1SDavid du Colombier { 4933e12c5d1SDavid du Colombier Datum d1, d2; 4943e12c5d1SDavid du Colombier d1 = pop(); 4953e12c5d1SDavid du Colombier d2 = pop(); 4963e12c5d1SDavid du Colombier if (d1.sym->type != VAR && d1.sym->type != UNDEF) 4973e12c5d1SDavid du Colombier execerror("assignment to non-variable", 4983e12c5d1SDavid du Colombier d1.sym->name); 4993e12c5d1SDavid du Colombier d1.sym->u.val = d2.val; 5003e12c5d1SDavid du Colombier d1.sym->type = VAR; 5013e12c5d1SDavid du Colombier push(d2); 5023e12c5d1SDavid du Colombier } 5033e12c5d1SDavid du Colombier 5043e12c5d1SDavid du Colombier void 5053e12c5d1SDavid du Colombier addeq(void) 5063e12c5d1SDavid du Colombier { 5073e12c5d1SDavid du Colombier Datum d1, d2; 5083e12c5d1SDavid du Colombier d1 = pop(); 5093e12c5d1SDavid du Colombier d2 = pop(); 5103e12c5d1SDavid du Colombier if (d1.sym->type != VAR && d1.sym->type != UNDEF) 5113e12c5d1SDavid du Colombier execerror("assignment to non-variable", 5123e12c5d1SDavid du Colombier d1.sym->name); 5133e12c5d1SDavid du Colombier d2.val = d1.sym->u.val += d2.val; 5143e12c5d1SDavid du Colombier d1.sym->type = VAR; 5153e12c5d1SDavid du Colombier push(d2); 5163e12c5d1SDavid du Colombier } 5173e12c5d1SDavid du Colombier 5183e12c5d1SDavid du Colombier void 5193e12c5d1SDavid du Colombier subeq(void) 5203e12c5d1SDavid du Colombier { 5213e12c5d1SDavid du Colombier Datum d1, d2; 5223e12c5d1SDavid du Colombier d1 = pop(); 5233e12c5d1SDavid du Colombier d2 = pop(); 5243e12c5d1SDavid du Colombier if (d1.sym->type != VAR && d1.sym->type != UNDEF) 5253e12c5d1SDavid du Colombier execerror("assignment to non-variable", 5263e12c5d1SDavid du Colombier d1.sym->name); 5273e12c5d1SDavid du Colombier d2.val = d1.sym->u.val -= d2.val; 5283e12c5d1SDavid du Colombier d1.sym->type = VAR; 5293e12c5d1SDavid du Colombier push(d2); 5303e12c5d1SDavid du Colombier } 5313e12c5d1SDavid du Colombier 5323e12c5d1SDavid du Colombier void 5333e12c5d1SDavid du Colombier muleq(void) 5343e12c5d1SDavid du Colombier { 5353e12c5d1SDavid du Colombier Datum d1, d2; 5363e12c5d1SDavid du Colombier d1 = pop(); 5373e12c5d1SDavid du Colombier d2 = pop(); 5383e12c5d1SDavid du Colombier if (d1.sym->type != VAR && d1.sym->type != UNDEF) 5393e12c5d1SDavid du Colombier execerror("assignment to non-variable", 5403e12c5d1SDavid du Colombier d1.sym->name); 5413e12c5d1SDavid du Colombier d2.val = d1.sym->u.val *= d2.val; 5423e12c5d1SDavid du Colombier d1.sym->type = VAR; 5433e12c5d1SDavid du Colombier push(d2); 5443e12c5d1SDavid du Colombier } 5453e12c5d1SDavid du Colombier 5463e12c5d1SDavid du Colombier void 5473e12c5d1SDavid du Colombier diveq(void) 5483e12c5d1SDavid du Colombier { 5493e12c5d1SDavid du Colombier Datum d1, d2; 5503e12c5d1SDavid du Colombier d1 = pop(); 5513e12c5d1SDavid du Colombier d2 = pop(); 5523e12c5d1SDavid du Colombier if (d1.sym->type != VAR && d1.sym->type != UNDEF) 5533e12c5d1SDavid du Colombier execerror("assignment to non-variable", 5543e12c5d1SDavid du Colombier d1.sym->name); 5553e12c5d1SDavid du Colombier d2.val = d1.sym->u.val /= d2.val; 5563e12c5d1SDavid du Colombier d1.sym->type = VAR; 5573e12c5d1SDavid du Colombier push(d2); 5583e12c5d1SDavid du Colombier } 5593e12c5d1SDavid du Colombier 5603e12c5d1SDavid du Colombier void 5613e12c5d1SDavid du Colombier modeq(void) 5623e12c5d1SDavid du Colombier { 5633e12c5d1SDavid du Colombier Datum d1, d2; 5643e12c5d1SDavid du Colombier long x; 5653e12c5d1SDavid du Colombier d1 = pop(); 5663e12c5d1SDavid du Colombier d2 = pop(); 5673e12c5d1SDavid du Colombier if (d1.sym->type != VAR && d1.sym->type != UNDEF) 5683e12c5d1SDavid du Colombier execerror("assignment to non-variable", 5693e12c5d1SDavid du Colombier d1.sym->name); 5703e12c5d1SDavid du Colombier /* d2.val = d1.sym->u.val %= d2.val; */ 5713e12c5d1SDavid du Colombier x = d1.sym->u.val; 5723e12c5d1SDavid du Colombier x %= (long) d2.val; 5733e12c5d1SDavid du Colombier d2.val = d1.sym->u.val = x; 5743e12c5d1SDavid du Colombier d1.sym->type = VAR; 5753e12c5d1SDavid du Colombier push(d2); 5763e12c5d1SDavid du Colombier } 5773e12c5d1SDavid du Colombier 5783e12c5d1SDavid du Colombier void 5793e12c5d1SDavid du Colombier printtop(void) /* pop top value from stack, print it */ 5803e12c5d1SDavid du Colombier { 5813e12c5d1SDavid du Colombier Datum d; 5823e12c5d1SDavid du Colombier static Symbol *s; /* last value computed */ 5833e12c5d1SDavid du Colombier if (s == 0) 5843e12c5d1SDavid du Colombier s = install("_", VAR, 0.0); 5853e12c5d1SDavid du Colombier d = pop(); 5863e12c5d1SDavid du Colombier print("%.12g\n", d.val); 5873e12c5d1SDavid du Colombier s->u.val = d.val; 5883e12c5d1SDavid du Colombier } 5893e12c5d1SDavid du Colombier 5903e12c5d1SDavid du Colombier void 5913e12c5d1SDavid du Colombier prexpr(void) /* print numeric value */ 5923e12c5d1SDavid du Colombier { 5933e12c5d1SDavid du Colombier Datum d; 5943e12c5d1SDavid du Colombier d = pop(); 5953e12c5d1SDavid du Colombier print("%.12g ", d.val); 5963e12c5d1SDavid du Colombier } 5973e12c5d1SDavid du Colombier 5983e12c5d1SDavid du Colombier void 5993e12c5d1SDavid du Colombier prstr(void) /* print string value */ 6003e12c5d1SDavid du Colombier { 6013e12c5d1SDavid du Colombier print("%s", (char *) *pc++); 6023e12c5d1SDavid du Colombier } 6033e12c5d1SDavid du Colombier 6043e12c5d1SDavid du Colombier void 6053e12c5d1SDavid du Colombier varread(void) /* read into variable */ 6063e12c5d1SDavid du Colombier { 6073e12c5d1SDavid du Colombier Datum d; 6083e12c5d1SDavid du Colombier extern Biobuf *bin; 6093e12c5d1SDavid du Colombier Symbol *var = (Symbol *) *pc++; 6103e12c5d1SDavid du Colombier int c; 6113e12c5d1SDavid du Colombier 6123e12c5d1SDavid du Colombier Again: 6133e12c5d1SDavid du Colombier do 6143e12c5d1SDavid du Colombier c = Bgetc(bin); 6153e12c5d1SDavid du Colombier while(c==' ' || c=='\t'); 6163e12c5d1SDavid du Colombier if(c == Beof){ 6173e12c5d1SDavid du Colombier Iseof: 6183e12c5d1SDavid du Colombier if(moreinput()) 6193e12c5d1SDavid du Colombier goto Again; 6203e12c5d1SDavid du Colombier d.val = var->u.val = 0.0; 6213e12c5d1SDavid du Colombier goto Return; 6223e12c5d1SDavid du Colombier } 6233e12c5d1SDavid du Colombier 6243e12c5d1SDavid du Colombier if(strchr("+-.0123456789", c) == 0) 6253e12c5d1SDavid du Colombier execerror("non-number read into", var->name); 6263e12c5d1SDavid du Colombier Bungetc(bin); 6273e12c5d1SDavid du Colombier if(Bgetd(bin, &var->u.val) == Beof) 6283e12c5d1SDavid du Colombier goto Iseof; 6293e12c5d1SDavid du Colombier else 6303e12c5d1SDavid du Colombier d.val = 1.0; 6313e12c5d1SDavid du Colombier Return: 6323e12c5d1SDavid du Colombier var->type = VAR; 6333e12c5d1SDavid du Colombier push(d); 6343e12c5d1SDavid du Colombier } 6353e12c5d1SDavid du Colombier 6363e12c5d1SDavid du Colombier Inst* 6373e12c5d1SDavid du Colombier code(Inst f) /* install one instruction or operand */ 6383e12c5d1SDavid du Colombier { 6393e12c5d1SDavid du Colombier Inst *oprogp = progp; 6403e12c5d1SDavid du Colombier if (progp >= &prog[NPROG]) 6413e12c5d1SDavid du Colombier execerror("program too big", (char *)0); 6423e12c5d1SDavid du Colombier *progp++ = f; 6433e12c5d1SDavid du Colombier return oprogp; 6443e12c5d1SDavid du Colombier } 6453e12c5d1SDavid du Colombier 6463e12c5d1SDavid du Colombier void 6473e12c5d1SDavid du Colombier execute(Inst* p) 6483e12c5d1SDavid du Colombier { 6493e12c5d1SDavid du Colombier for (pc = p; *pc != STOP && !returning; ) 6503e12c5d1SDavid du Colombier (*((++pc)[-1]))(); 6513e12c5d1SDavid du Colombier } 652