|
|
1.1 ! root 1: #include "hoc.h" ! 2: #include "y.tab.h" ! 3: #include <stdio.h> ! 4: ! 5: #define NSTACK 256 ! 6: ! 7: static Datum stack[NSTACK]; /* the stack */ ! 8: static Datum *stackp; /* next free spot on stack */ ! 9: ! 10: #define NPROG 2000 ! 11: Inst prog[NPROG]; /* the machine */ ! 12: Inst *progp; /* next free spot for code generation */ ! 13: Inst *pc; /* program counter during execution */ ! 14: Inst *progbase = prog; /* start of current subprogram */ ! 15: int returning; /* 1 if return stmt seen */ ! 16: ! 17: typedef struct Frame { /* proc/func call stack frame */ ! 18: Symbol *sp; /* symbol table entry */ ! 19: Inst *retpc; /* where to resume after return */ ! 20: Datum *argn; /* n-th argument on stack */ ! 21: int nargs; /* number of arguments */ ! 22: } Frame; ! 23: #define NFRAME 100 ! 24: Frame frame[NFRAME]; ! 25: Frame *fp; /* frame pointer */ ! 26: ! 27: initcode() { ! 28: progp = progbase; ! 29: stackp = stack; ! 30: fp = frame; ! 31: returning = 0; ! 32: } ! 33: ! 34: push(d) ! 35: Datum d; ! 36: { ! 37: if (stackp >= &stack[NSTACK]) ! 38: execerror("stack too deep", (char *)0); ! 39: *stackp++ = d; ! 40: } ! 41: ! 42: Datum pop() ! 43: { ! 44: if (stackp == stack) ! 45: execerror("stack underflow", (char *)0); ! 46: return *--stackp; ! 47: } ! 48: ! 49: constpush() ! 50: { ! 51: Datum d; ! 52: d.val = ((Symbol *)*pc++)->u.val; ! 53: push(d); ! 54: } ! 55: ! 56: varpush() ! 57: { ! 58: Datum d; ! 59: d.sym = (Symbol *)(*pc++); ! 60: push(d); ! 61: } ! 62: ! 63: whilecode() ! 64: { ! 65: Datum d; ! 66: Inst *savepc = pc; ! 67: ! 68: execute(savepc+2); /* condition */ ! 69: d = pop(); ! 70: while (d.val) { ! 71: execute(*((Inst **)(savepc))); /* body */ ! 72: if (returning) ! 73: break; ! 74: execute(savepc+2); /* condition */ ! 75: d = pop(); ! 76: } ! 77: if (!returning) ! 78: pc = *((Inst **)(savepc+1)); /* next stmt */ ! 79: } ! 80: ! 81: forcode() ! 82: { ! 83: Datum d; ! 84: Inst *savepc = pc; ! 85: ! 86: execute(savepc+4); /* precharge */ ! 87: (void) pop(); ! 88: execute(*((Inst **)(savepc))); /* condition */ ! 89: d = pop(); ! 90: while (d.val) { ! 91: execute(*((Inst **)(savepc+2))); /* body */ ! 92: if (returning) ! 93: break; ! 94: execute(*((Inst **)(savepc+1))); /* post loop */ ! 95: (void) pop(); ! 96: execute(*((Inst **)(savepc))); /* condition */ ! 97: d = pop(); ! 98: } ! 99: if (!returning) ! 100: pc = *((Inst **)(savepc+3)); /* next stmt */ ! 101: } ! 102: ifcode() ! 103: { ! 104: Datum d; ! 105: Inst *savepc = pc; /* then part */ ! 106: ! 107: execute(savepc+3); /* condition */ ! 108: d = pop(); ! 109: if (d.val) ! 110: execute(*((Inst **)(savepc))); ! 111: else if (*((Inst **)(savepc+1))) /* else part? */ ! 112: execute(*((Inst **)(savepc+1))); ! 113: if (!returning) ! 114: pc = *((Inst **)(savepc+2)); /* next stmt */ ! 115: } ! 116: ! 117: define(sp) /* put func/proc in symbol table */ ! 118: Symbol *sp; ! 119: { ! 120: sp->u.defn = (Inst)progbase; /* start of code */ ! 121: progbase = progp; /* next code starts here */ ! 122: } ! 123: ! 124: call() /* call a function */ ! 125: { ! 126: Symbol *sp = (Symbol *)pc[0]; /* symbol table entry */ ! 127: /* for function */ ! 128: if (fp++ >= &frame[NFRAME-1]) ! 129: execerror(sp->name, "call nested too deeply"); ! 130: fp->sp = sp; ! 131: fp->nargs = (int)pc[1]; ! 132: fp->retpc = pc + 2; ! 133: fp->argn = stackp - 1; /* last argument */ ! 134: execute(sp->u.defn); ! 135: returning = 0; ! 136: } ! 137: ! 138: ret() /* common return from func or proc */ ! 139: { ! 140: int i; ! 141: for (i = 0; i < fp->nargs; i++) ! 142: pop(); /* pop arguments */ ! 143: pc = (Inst *)fp->retpc; ! 144: --fp; ! 145: returning = 1; ! 146: } ! 147: ! 148: funcret() /* return from a function */ ! 149: { ! 150: Datum d; ! 151: if (fp->sp->type == PROCEDURE) ! 152: execerror(fp->sp->name, "(proc) returns value"); ! 153: d = pop(); /* preserve function return value */ ! 154: ret(); ! 155: push(d); ! 156: } ! 157: ! 158: procret() /* return from a procedure */ ! 159: { ! 160: if (fp->sp->type == FUNCTION) ! 161: execerror(fp->sp->name, ! 162: "(func) returns no value"); ! 163: ret(); ! 164: } ! 165: ! 166: double *getarg() /* return pointer to argument */ ! 167: { ! 168: int nargs = (int) *pc++; ! 169: if (nargs > fp->nargs) ! 170: execerror(fp->sp->name, "not enough arguments"); ! 171: return &fp->argn[nargs - fp->nargs].val; ! 172: } ! 173: ! 174: arg() /* push argument onto stack */ ! 175: { ! 176: Datum d; ! 177: d.val = *getarg(); ! 178: push(d); ! 179: } ! 180: ! 181: argassign() /* store top of stack in argument */ ! 182: { ! 183: Datum d; ! 184: d = pop(); ! 185: push(d); /* leave value on stack */ ! 186: *getarg() = d.val; ! 187: } ! 188: ! 189: argaddeq() /* store top of stack in argument */ ! 190: { ! 191: Datum d; ! 192: d = pop(); ! 193: d.val = *getarg() += d.val; ! 194: push(d); /* leave value on stack */ ! 195: } ! 196: ! 197: argsubeq() /* store top of stack in argument */ ! 198: { ! 199: Datum d; ! 200: d = pop(); ! 201: d.val = *getarg() -= d.val; ! 202: push(d); /* leave value on stack */ ! 203: } ! 204: ! 205: argmuleq() /* store top of stack in argument */ ! 206: { ! 207: Datum d; ! 208: d = pop(); ! 209: d.val = *getarg() *= d.val; ! 210: push(d); /* leave value on stack */ ! 211: } ! 212: ! 213: argdiveq() /* store top of stack in argument */ ! 214: { ! 215: Datum d; ! 216: d = pop(); ! 217: d.val = *getarg() /= d.val; ! 218: push(d); /* leave value on stack */ ! 219: } ! 220: ! 221: argmodeq() /* store top of stack in argument */ ! 222: { ! 223: Datum d; ! 224: long x; ! 225: d = pop(); ! 226: /* d.val = *getarg() %= d.val; */ ! 227: x = *getarg(); ! 228: x %= (long) d.val; ! 229: d.val = *getarg() = x; ! 230: push(d); /* leave value on stack */ ! 231: } ! 232: ! 233: bltin() ! 234: { ! 235: ! 236: Datum d; ! 237: d = pop(); ! 238: d.val = (*(double (*)())*pc++)(d.val); ! 239: push(d); ! 240: } ! 241: ! 242: add() ! 243: { ! 244: Datum d1, d2; ! 245: d2 = pop(); ! 246: d1 = pop(); ! 247: d1.val += d2.val; ! 248: push(d1); ! 249: } ! 250: ! 251: sub() ! 252: { ! 253: Datum d1, d2; ! 254: d2 = pop(); ! 255: d1 = pop(); ! 256: d1.val -= d2.val; ! 257: push(d1); ! 258: } ! 259: ! 260: mul() ! 261: { ! 262: Datum d1, d2; ! 263: d2 = pop(); ! 264: d1 = pop(); ! 265: d1.val *= d2.val; ! 266: push(d1); ! 267: } ! 268: ! 269: div() ! 270: { ! 271: Datum d1, d2; ! 272: d2 = pop(); ! 273: if (d2.val == 0.0) ! 274: execerror("division by zero", (char *)0); ! 275: d1 = pop(); ! 276: d1.val /= d2.val; ! 277: push(d1); ! 278: } ! 279: ! 280: mod() ! 281: { ! 282: Datum d1, d2; ! 283: long x; ! 284: d2 = pop(); ! 285: if (d2.val == 0.0) ! 286: execerror("division by zero", (char *)0); ! 287: d1 = pop(); ! 288: /* d1.val %= d2.val; */ ! 289: x = d1.val; ! 290: x %= (long) d2.val; ! 291: d1.val = d2.val = x; ! 292: push(d1); ! 293: } ! 294: ! 295: negate() ! 296: { ! 297: Datum d; ! 298: d = pop(); ! 299: d.val = -d.val; ! 300: push(d); ! 301: } ! 302: ! 303: verify(s) ! 304: Symbol *s; ! 305: { ! 306: if (s->type != VAR && s->type != UNDEF) ! 307: execerror("attempt to evaluate non-variable", s->name); ! 308: if (s->type == UNDEF) ! 309: execerror("undefined variable", s->name); ! 310: } ! 311: ! 312: eval() /* evaluate variable on stack */ ! 313: { ! 314: Datum d; ! 315: d = pop(); ! 316: verify(d.sym); ! 317: d.val = d.sym->u.val; ! 318: push(d); ! 319: } ! 320: ! 321: preinc() ! 322: { ! 323: Datum d; ! 324: d.sym = (Symbol *)(*pc++); ! 325: verify(d.sym); ! 326: d.val = d.sym->u.val += 1.0; ! 327: push(d); ! 328: } ! 329: ! 330: predec() ! 331: { ! 332: Datum d; ! 333: d.sym = (Symbol *)(*pc++); ! 334: verify(d.sym); ! 335: d.val = d.sym->u.val -= 1.0; ! 336: push(d); ! 337: } ! 338: ! 339: postinc() ! 340: { ! 341: Datum d; ! 342: double v; ! 343: d.sym = (Symbol *)(*pc++); ! 344: verify(d.sym); ! 345: v = d.sym->u.val; ! 346: d.sym->u.val += 1.0; ! 347: d.val = v; ! 348: push(d); ! 349: } ! 350: ! 351: postdec() ! 352: { ! 353: Datum d; ! 354: double v; ! 355: d.sym = (Symbol *)(*pc++); ! 356: verify(d.sym); ! 357: v = d.sym->u.val; ! 358: d.sym->u.val -= 1.0; ! 359: d.val = v; ! 360: push(d); ! 361: } ! 362: ! 363: gt() ! 364: { ! 365: Datum d1, d2; ! 366: d2 = pop(); ! 367: d1 = pop(); ! 368: d1.val = (double)(d1.val > d2.val); ! 369: push(d1); ! 370: } ! 371: ! 372: lt() ! 373: { ! 374: Datum d1, d2; ! 375: d2 = pop(); ! 376: d1 = pop(); ! 377: d1.val = (double)(d1.val < d2.val); ! 378: push(d1); ! 379: } ! 380: ! 381: ge() ! 382: { ! 383: Datum d1, d2; ! 384: d2 = pop(); ! 385: d1 = pop(); ! 386: d1.val = (double)(d1.val >= d2.val); ! 387: push(d1); ! 388: } ! 389: ! 390: le() ! 391: { ! 392: Datum d1, d2; ! 393: d2 = pop(); ! 394: d1 = pop(); ! 395: d1.val = (double)(d1.val <= d2.val); ! 396: push(d1); ! 397: } ! 398: ! 399: eq() ! 400: { ! 401: Datum d1, d2; ! 402: d2 = pop(); ! 403: d1 = pop(); ! 404: d1.val = (double)(d1.val == d2.val); ! 405: push(d1); ! 406: } ! 407: ! 408: ne() ! 409: { ! 410: Datum d1, d2; ! 411: d2 = pop(); ! 412: d1 = pop(); ! 413: d1.val = (double)(d1.val != d2.val); ! 414: push(d1); ! 415: } ! 416: ! 417: and() ! 418: { ! 419: Datum d1, d2; ! 420: d2 = pop(); ! 421: d1 = pop(); ! 422: d1.val = (double)(d1.val != 0.0 && d2.val != 0.0); ! 423: push(d1); ! 424: } ! 425: ! 426: or() ! 427: { ! 428: Datum d1, d2; ! 429: d2 = pop(); ! 430: d1 = pop(); ! 431: d1.val = (double)(d1.val != 0.0 || d2.val != 0.0); ! 432: push(d1); ! 433: } ! 434: ! 435: not() ! 436: { ! 437: Datum d; ! 438: d = pop(); ! 439: d.val = (double)(d.val == 0.0); ! 440: push(d); ! 441: } ! 442: ! 443: power() ! 444: { ! 445: Datum d1, d2; ! 446: extern double Pow(); ! 447: d2 = pop(); ! 448: d1 = pop(); ! 449: d1.val = Pow(d1.val, d2.val); ! 450: push(d1); ! 451: } ! 452: ! 453: assign() ! 454: { ! 455: Datum d1, d2; ! 456: d1 = pop(); ! 457: d2 = pop(); ! 458: if (d1.sym->type != VAR && d1.sym->type != UNDEF) ! 459: execerror("assignment to non-variable", ! 460: d1.sym->name); ! 461: d1.sym->u.val = d2.val; ! 462: d1.sym->type = VAR; ! 463: push(d2); ! 464: } ! 465: ! 466: addeq() ! 467: { ! 468: Datum d1, d2; ! 469: d1 = pop(); ! 470: d2 = pop(); ! 471: if (d1.sym->type != VAR && d1.sym->type != UNDEF) ! 472: execerror("assignment to non-variable", ! 473: d1.sym->name); ! 474: d2.val = d1.sym->u.val += d2.val; ! 475: d1.sym->type = VAR; ! 476: push(d2); ! 477: } ! 478: ! 479: subeq() ! 480: { ! 481: Datum d1, d2; ! 482: d1 = pop(); ! 483: d2 = pop(); ! 484: if (d1.sym->type != VAR && d1.sym->type != UNDEF) ! 485: execerror("assignment to non-variable", ! 486: d1.sym->name); ! 487: d2.val = d1.sym->u.val -= d2.val; ! 488: d1.sym->type = VAR; ! 489: push(d2); ! 490: } ! 491: ! 492: muleq() ! 493: { ! 494: Datum d1, d2; ! 495: d1 = pop(); ! 496: d2 = pop(); ! 497: if (d1.sym->type != VAR && d1.sym->type != UNDEF) ! 498: execerror("assignment to non-variable", ! 499: d1.sym->name); ! 500: d2.val = d1.sym->u.val *= d2.val; ! 501: d1.sym->type = VAR; ! 502: push(d2); ! 503: } ! 504: ! 505: diveq() ! 506: { ! 507: Datum d1, d2; ! 508: d1 = pop(); ! 509: d2 = pop(); ! 510: if (d1.sym->type != VAR && d1.sym->type != UNDEF) ! 511: execerror("assignment to non-variable", ! 512: d1.sym->name); ! 513: d2.val = d1.sym->u.val /= d2.val; ! 514: d1.sym->type = VAR; ! 515: push(d2); ! 516: } ! 517: ! 518: modeq() ! 519: { ! 520: Datum d1, d2; ! 521: long x; ! 522: d1 = pop(); ! 523: d2 = pop(); ! 524: if (d1.sym->type != VAR && d1.sym->type != UNDEF) ! 525: execerror("assignment to non-variable", ! 526: d1.sym->name); ! 527: /* d2.val = d1.sym->u.val %= d2.val; */ ! 528: x = d1.sym->u.val; ! 529: x %= (long) d2.val; ! 530: d2.val = d1.sym->u.val = x; ! 531: d1.sym->type = VAR; ! 532: push(d2); ! 533: } ! 534: ! 535: print() /* pop top value from stack, print it */ ! 536: { ! 537: Datum d; ! 538: static Symbol *s; /* last value computed */ ! 539: if (s == NULL) ! 540: s = install("_", VAR, 0.0); ! 541: d = pop(); ! 542: printf("\t%.8g\n", d.val); ! 543: s->u.val = d.val; ! 544: } ! 545: ! 546: prexpr() /* print numeric value */ ! 547: { ! 548: Datum d; ! 549: d = pop(); ! 550: printf("%.8g ", d.val); ! 551: } ! 552: ! 553: prstr() /* print string value */ ! 554: { ! 555: printf("%s", (char *) *pc++); ! 556: } ! 557: ! 558: varread() /* read into variable */ ! 559: { ! 560: Datum d; ! 561: extern FILE *fin; ! 562: Symbol *var = (Symbol *) *pc++; ! 563: Again: ! 564: switch (fscanf(fin, "%lf", &var->u.val)) { ! 565: case EOF: ! 566: if (moreinput()) ! 567: goto Again; ! 568: d.val = var->u.val = 0.0; ! 569: break; ! 570: case 0: ! 571: execerror("non-number read into", var->name); ! 572: break; ! 573: default: ! 574: d.val = 1.0; ! 575: break; ! 576: } ! 577: var->type = VAR; ! 578: push(d); ! 579: } ! 580: ! 581: Inst *code(f) /* install one instruction or operand */ ! 582: Inst f; ! 583: { ! 584: Inst *oprogp = progp; ! 585: if (progp >= &prog[NPROG]) ! 586: execerror("program too big", (char *)0); ! 587: *progp++ = f; ! 588: return oprogp; ! 589: } ! 590: ! 591: execute(p) ! 592: Inst *p; ! 593: { ! 594: for (pc = p; *pc != STOP && !returning; ) ! 595: (*(*pc++))(); ! 596: }
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.