1: /* 2: * Copyright (c) 1980 Regents of the University of California. 3: * All rights reserved. The Berkeley software License Agreement 4: * specifies the terms and conditions for redistribution. 5: */ 6: 7: #ifndef lint 8: static char sccsid[] = "@(#)interp.c 5.3 (Berkeley) 9/18/85"; 9: #endif not lint 10: 11: #include <math.h> 12: #include <signal.h> 13: #include "whoami.h" 14: #include "vars.h" 15: #include "objfmt.h" 16: #include "h02opcs.h" 17: #include "machdep.h" 18: #include "libpc.h" 19: 20: /* 21: * program variables 22: */ 23: union display _display; 24: struct dispsave *_dp; 25: long _lino = 0; 26: int _argc; 27: char **_argv; 28: long _mode; 29: long _runtst = (long)TRUE; 30: bool _nodump = FALSE; 31: long _stlim = 500000; 32: long _stcnt = 0; 33: long _seed = 1; 34: #ifdef ADDR32 35: char *_minptr = (char *)0x7fffffff; 36: #endif ADDR32 37: #ifdef ADDR16 38: char *_minptr = (char *)0xffff; 39: #endif ADDR16 40: char *_maxptr = (char *)0; 41: long *_pcpcount = (long *)0; 42: long _cntrs = 0; 43: long _rtns = 0; 44: 45: /* 46: * standard files 47: */ 48: char _inwin, _outwin, _errwin; 49: struct iorechd _err = { 50: &_errwin, /* fileptr */ 51: 0, /* lcount */ 52: 0x7fffffff, /* llimit */ 53: &_iob[2], /* fbuf */ 54: FILNIL, /* fchain */ 55: STDLVL, /* flev */ 56: "Message file", /* pfname */ 57: FTEXT | FWRITE | EOFF, /* funit */ 58: 2, /* fblk */ 59: 1 /* fsize */ 60: }; 61: struct iorechd output = { 62: &_outwin, /* fileptr */ 63: 0, /* lcount */ 64: 0x7fffffff, /* llimit */ 65: &_iob[1], /* fbuf */ 66: ERR, /* fchain */ 67: STDLVL, /* flev */ 68: "standard output", /* pfname */ 69: FTEXT | FWRITE | EOFF, /* funit */ 70: 1, /* fblk */ 71: 1 /* fsize */ 72: }; 73: struct iorechd input = { 74: &_inwin, /* fileptr */ 75: 0, /* lcount */ 76: 0x7fffffff, /* llimit */ 77: &_iob[0], /* fbuf */ 78: OUTPUT, /* fchain */ 79: STDLVL, /* flev */ 80: "standard input", /* pfname */ 81: FTEXT|FREAD|SYNC|EOLN, /* funit */ 82: 0, /* fblk */ 83: 1 /* fsize */ 84: }; 85: 86: /* 87: * file record variables 88: */ 89: long _filefre = PREDEF; 90: struct iorechd _fchain = { 91: 0, 0, 0, 0, /* only use fchain field */ 92: INPUT /* fchain */ 93: }; 94: struct iorec *_actfile[MAXFILES] = { 95: INPUT, 96: OUTPUT, 97: ERR 98: }; 99: 100: /* 101: * stuff for pdx 102: */ 103: 104: union progcntr *pcaddrp; 105: asm(".globl _loopaddr"); 106: 107: /* 108: * Px profile array 109: */ 110: #ifdef PROFILE 111: long _profcnts[NUMOPS]; 112: #endif PROFILE 113: 114: /* 115: * debugging variables 116: */ 117: #ifdef DEBUG 118: char opc[10]; 119: long opcptr = 9; 120: #endif DEBUG 121: 122: interpreter(base) 123: char *base; 124: { 125: union progcntr pc; /* interpreted program cntr */ 126: register char *vpc; /* register used for "pc" */ 127: struct iorec *curfile; /* active file */ 128: register struct blockmark *stp; /* active stack frame ptr */ 129: /* 130: * the following variables are used as scratch 131: */ 132: register char *tcp; 133: register short *tsp; 134: register long tl, tl1, tl2; 135: double td, td1; 136: struct sze8 t8; 137: register short *tsp1; 138: long *tlp, tl3; 139: char *tcp1; 140: bool tb; 141: struct blockmark *tstp; 142: register struct formalrtn *tfp; 143: union progcntr tpc; 144: struct iorec **ip; 145: int mypid; 146: 147: pcaddrp = &pc; 148: mypid = getpid(); 149: 150: /* 151: * Setup sets up any hardware specific parameters before 152: * starting the interpreter. Typically this is inline replaced 153: * by interp.sed to utilize specific machine instructions. 154: */ 155: setup(); 156: /* 157: * necessary only on systems which do not initialize 158: * memory to zero 159: */ 160: for (ip = &_actfile[3]; ip < &_actfile[MAXFILES]; *ip++ = FILNIL) 161: /* void */; 162: /* 163: * set up global environment, then ``call'' the main program 164: */ 165: _display.frame[0].locvars = pushsp((long)(2 * sizeof(struct iorec *))); 166: _display.frame[0].locvars += 2 * sizeof(struct iorec *); 167: *(struct iorec **)(_display.frame[0].locvars + OUTPUT_OFF) = OUTPUT; 168: *(struct iorec **)(_display.frame[0].locvars + INPUT_OFF) = INPUT; 169: stp = (struct blockmark *)pushsp((long)(sizeof(struct blockmark))); 170: _dp = &_display.frame[0]; 171: pc.cp = base; 172: 173: asm("_loopaddr:"); 174: for(;;) { 175: # ifdef DEBUG 176: if (++opcptr == 10) 177: opcptr = 0; 178: opc[opcptr] = *pc.ucp; 179: # endif DEBUG 180: # ifdef PROFILE 181: _profcnts[*pc.ucp]++; 182: # endif PROFILE 183: switch (*pc.ucp++) { 184: case O_BPT: /* breakpoint trap */ 185: PFLUSH(); 186: kill(mypid, SIGILL); 187: pc.ucp--; 188: continue; 189: case O_NODUMP: 190: _nodump = TRUE; 191: /* and fall through */ 192: case O_BEG: 193: _dp += 1; /* enter local scope */ 194: stp->odisp = *_dp; /* save old display value */ 195: tl = *pc.ucp++; /* tl = name size */ 196: stp->entry = pc.hdrp; /* pointer to entry info */ 197: tl1 = pc.hdrp->framesze;/* tl1 = size of frame */ 198: _lino = pc.hdrp->offset; 199: _runtst = pc.hdrp->tests; 200: disableovrflo(); 201: if (_runtst) 202: enableovrflo(); 203: pc.cp += (int)tl; /* skip over proc hdr info */ 204: stp->file = curfile; /* save active file */ 205: tcp = pushsp(tl1); /* tcp = new top of stack */ 206: if (_runtst) /* zero stack frame */ 207: blkclr(tcp, tl1); 208: tcp += (int)tl1; /* offsets of locals are neg */ 209: _dp->locvars = tcp; /* set new display pointer */ 210: _dp->stp = stp; 211: stp->tos = pushsp((long)0); /* set tos pointer */ 212: continue; 213: case O_END: 214: PCLOSE(_dp->locvars); /* flush & close local files */ 215: stp = _dp->stp; 216: curfile = stp->file; /* restore old active file */ 217: *_dp = stp->odisp; /* restore old display entry */ 218: if (_dp == &_display.frame[1]) 219: return; /* exiting main proc ??? */ 220: _lino = stp->lino; /* restore lino, pc, dp */ 221: pc.cp = stp->pc; 222: _dp = stp->dp; 223: _runtst = stp->entry->tests; 224: disableovrflo(); 225: if (_runtst) 226: enableovrflo(); 227: popsp(stp->entry->framesze + /* pop local vars */ 228: sizeof(struct blockmark) + /* pop stack frame */ 229: stp->entry->nargs); /* pop parms */ 230: continue; 231: case O_CALL: 232: tl = *pc.cp++; 233: tcp = base + *pc.lp++;/* calc new entry point */ 234: tcp += sizeof(short); 235: tcp = base + *(long *)tcp; 236: stp = (struct blockmark *) 237: pushsp((long)(sizeof(struct blockmark))); 238: stp->lino = _lino; /* save lino, pc, dp */ 239: stp->pc = pc.cp; 240: stp->dp = _dp; 241: _dp = &_display.frame[tl]; /* set up new display ptr */ 242: pc.cp = tcp; 243: continue; 244: case O_FCALL: 245: pc.cp++; 246: tcp = popaddr(); /* ptr to display save area */ 247: tfp = (struct formalrtn *)popaddr(); 248: stp = (struct blockmark *) 249: pushsp((long)(sizeof(struct blockmark))); 250: stp->lino = _lino; /* save lino, pc, dp */ 251: stp->pc = pc.cp; 252: stp->dp = _dp; 253: pc.cp = (char *)(tfp->fentryaddr);/* new entry point */ 254: _dp = &_display.frame[tfp->fbn];/* new display ptr */ 255: blkcpy(&_display.frame[1], tcp, 256: tfp->fbn * sizeof(struct dispsave)); 257: blkcpy(&tfp->fdisp[0], &_display.frame[1], 258: tfp->fbn * sizeof(struct dispsave)); 259: continue; 260: case O_FRTN: 261: tl = *pc.cp++; /* tl = size of return obj */ 262: if (tl == 0) 263: tl = *pc.usp++; 264: tcp = pushsp((long)(0)); 265: tfp = *(struct formalrtn **)(tcp + tl); 266: tcp1 = *(char **) 267: (tcp + tl + sizeof(struct formalrtn *)); 268: if (tl != 0) { 269: blkcpy(tcp, tcp + sizeof(struct formalrtn *) 270: + sizeof(char *), tl); 271: } 272: popsp((long) 273: (sizeof(struct formalrtn *) + sizeof (char *))); 274: blkcpy(tcp1, &_display.frame[1], 275: tfp->fbn * sizeof(struct dispsave)); 276: continue; 277: case O_FSAV: 278: tfp = (struct formalrtn *)popaddr(); 279: tfp->fbn = *pc.cp++; /* blk number of routine */ 280: tcp = base + *pc.lp++; /* calc new entry point */ 281: tcp += sizeof(short); 282: tfp->fentryaddr = (long (*)())(base + *(long *)tcp); 283: blkcpy(&_display.frame[1], &tfp->fdisp[0], 284: tfp->fbn * sizeof(struct dispsave)); 285: pushaddr(tfp); 286: continue; 287: case O_SDUP2: 288: pc.cp++; 289: tl = pop2(); 290: push2((short)(tl)); 291: push2((short)(tl)); 292: continue; 293: case O_SDUP4: 294: pc.cp++; 295: tl = pop4(); 296: push4(tl); 297: push4(tl); 298: continue; 299: case O_TRA: 300: pc.cp++; 301: pc.cp += *pc.sp; 302: continue; 303: case O_TRA4: 304: pc.cp++; 305: pc.cp = base + *pc.lp; 306: continue; 307: case O_GOTO: 308: tstp = _display.frame[*pc.cp++].stp; /* ptr to 309: exit frame */ 310: pc.cp = base + *pc.lp; 311: stp = _dp->stp; 312: while (tstp != stp) { 313: if (_dp == &_display.frame[1]) 314: ERROR("Active frame not found in non-local goto\n", 0); /* exiting prog ??? */ 315: PCLOSE(_dp->locvars); /* close local files */ 316: curfile = stp->file; /* restore active file */ 317: *_dp = stp->odisp; /* old display entry */ 318: _dp = stp->dp; /* restore dp */ 319: stp = _dp->stp; 320: } 321: /* pop locals, stack frame, parms, and return values */ 322: popsp((long)(stp->tos - pushsp((long)(0)))); 323: continue; 324: case O_LINO: 325: if (_dp->stp->tos != pushsp((long)(0))) 326: ERROR("Panic: stack not empty between statements\n"); 327: _lino = *pc.cp++; /* set line number */ 328: if (_lino == 0) 329: _lino = *pc.sp++; 330: if (_runtst) { 331: LINO(); /* inc statement count */ 332: continue; 333: } 334: _stcnt++; 335: continue; 336: case O_PUSH: 337: tl = *pc.cp++; 338: if (tl == 0) 339: tl = *pc.lp++; 340: tl = (-tl + 1) & ~1; 341: tcp = pushsp(tl); 342: if (_runtst) 343: blkclr(tcp, tl); 344: continue; 345: case O_IF: 346: pc.cp++; 347: if (pop2()) { 348: pc.sp++; 349: continue; 350: } 351: pc.cp += *pc.sp; 352: continue; 353: case O_REL2: 354: tl = pop2(); 355: tl1 = pop2(); 356: goto cmplong; 357: case O_REL24: 358: tl = pop2(); 359: tl1 = pop4(); 360: goto cmplong; 361: case O_REL42: 362: tl = pop4(); 363: tl1 = pop2(); 364: goto cmplong; 365: case O_REL4: 366: tl = pop4(); 367: tl1 = pop4(); 368: cmplong: 369: switch (*pc.cp++) { 370: case releq: 371: push2(tl1 == tl); 372: continue; 373: case relne: 374: push2(tl1 != tl); 375: continue; 376: case rellt: 377: push2(tl1 < tl); 378: continue; 379: case relgt: 380: push2(tl1 > tl); 381: continue; 382: case relle: 383: push2(tl1 <= tl); 384: continue; 385: case relge: 386: push2(tl1 >= tl); 387: continue; 388: default: 389: ERROR("Panic: bad relation %d to REL4*\n", 390: *(pc.cp - 1)); 391: continue; 392: } 393: case O_RELG: 394: tl2 = *pc.cp++; /* tc has jump opcode */ 395: tl = *pc.usp++; /* tl has comparison length */ 396: tl1 = (tl + 1) & ~1; /* tl1 has arg stack length */ 397: tcp = pushsp((long)(0));/* tcp pts to first arg */ 398: switch (tl2) { 399: case releq: 400: tb = RELEQ(tl, tcp + tl1, tcp); 401: break; 402: case relne: 403: tb = RELNE(tl, tcp + tl1, tcp); 404: break; 405: case rellt: 406: tb = RELSLT(tl, tcp + tl1, tcp); 407: break; 408: case relgt: 409: tb = RELSGT(tl, tcp + tl1, tcp); 410: break; 411: case relle: 412: tb = RELSLE(tl, tcp + tl1, tcp); 413: break; 414: case relge: 415: tb = RELSGE(tl, tcp + tl1, tcp); 416: break; 417: default: 418: ERROR("Panic: bad relation %d to RELG*\n", tl2); 419: break; 420: } 421: popsp(tl1 << 1); 422: push2((short)(tb)); 423: continue; 424: case O_RELT: 425: tl2 = *pc.cp++; /* tc has jump opcode */ 426: tl1 = *pc.usp++; /* tl1 has comparison length */ 427: tcp = pushsp((long)(0));/* tcp pts to first arg */ 428: switch (tl2) { 429: case releq: 430: tb = RELEQ(tl1, tcp + tl1, tcp); 431: break; 432: case relne: 433: tb = RELNE(tl1, tcp + tl1, tcp); 434: break; 435: case rellt: 436: tb = RELTLT(tl1, tcp + tl1, tcp); 437: break; 438: case relgt: 439: tb = RELTGT(tl1, tcp + tl1, tcp); 440: break; 441: case relle: 442: tb = RELTLE(tl1, tcp + tl1, tcp); 443: break; 444: case relge: 445: tb = RELTGE(tl1, tcp + tl1, tcp); 446: break; 447: default: 448: ERROR("Panic: bad relation %d to RELT*\n", tl2); 449: break; 450: } 451: popsp(tl1 << 1); 452: push2((short)(tb)); 453: continue; 454: case O_REL28: 455: td = pop2(); 456: td1 = pop8(); 457: goto cmpdbl; 458: case O_REL48: 459: td = pop4(); 460: td1 = pop8(); 461: goto cmpdbl; 462: case O_REL82: 463: td = pop8(); 464: td1 = pop2(); 465: goto cmpdbl; 466: case O_REL84: 467: td = pop8(); 468: td1 = pop4(); 469: goto cmpdbl; 470: case O_REL8: 471: td = pop8(); 472: td1 = pop8(); 473: cmpdbl: 474: switch (*pc.cp++) { 475: case releq: 476: push2(td1 == td); 477: continue; 478: case relne: 479: push2(td1 != td); 480: continue; 481: case rellt: 482: push2(td1 < td); 483: continue; 484: case relgt: 485: push2(td1 > td); 486: continue; 487: case relle: 488: push2(td1 <= td); 489: continue; 490: case relge: 491: push2(td1 >= td); 492: continue; 493: default: 494: ERROR("Panic: bad relation %d to REL8*\n", 495: *(pc.cp - 1)); 496: continue; 497: } 498: case O_AND: 499: pc.cp++; 500: tl = pop2(); 501: tl1 = pop2(); 502: push2(tl1 & tl); 503: continue; 504: case O_OR: 505: pc.cp++; 506: tl = pop2(); 507: tl1 = pop2(); 508: push2(tl1 | tl); 509: continue; 510: case O_NOT: 511: pc.cp++; 512: tl = pop2(); 513: push2(tl ^ 1); 514: continue; 515: case O_AS2: 516: pc.cp++; 517: tl = pop2(); 518: *(short *)popaddr() = tl; 519: continue; 520: case O_AS4: 521: pc.cp++; 522: tl = pop4(); 523: *(long *)popaddr() = tl; 524: continue; 525: case O_AS24: 526: pc.cp++; 527: tl = pop2(); 528: *(long *)popaddr() = tl; 529: continue; 530: case O_AS42: 531: pc.cp++; 532: tl = pop4(); 533: *(short *)popaddr() = tl; 534: continue; 535: case O_AS21: 536: pc.cp++; 537: tl = pop2(); 538: *popaddr() = tl; 539: continue; 540: case O_AS41: 541: pc.cp++; 542: tl = pop4(); 543: *popaddr() = tl; 544: continue; 545: case O_AS28: 546: pc.cp++; 547: tl = pop2(); 548: *(double *)popaddr() = tl; 549: continue; 550: case O_AS48: 551: pc.cp++; 552: tl = pop4(); 553: *(double *)popaddr() = tl; 554: continue; 555: case O_AS8: 556: pc.cp++; 557: t8 = popsze8(); 558: *(struct sze8 *)popaddr() = t8; 559: continue; 560: case O_AS: 561: tl = *pc.cp++; 562: if (tl == 0) 563: tl = *pc.usp++; 564: tl1 = (tl + 1) & ~1; 565: tcp = pushsp((long)(0)); 566: blkcpy(tcp, *(char **)(tcp + tl1), tl); 567: popsp(tl1 + sizeof(char *)); 568: continue; 569: case O_VAS: 570: pc.cp++; 571: tl = pop4(); 572: tcp1 = popaddr(); 573: tcp = popaddr(); 574: blkcpy(tcp1, tcp, tl); 575: continue; 576: case O_INX2P2: 577: tl = *pc.cp++; /* tl has shift amount */ 578: tl1 = pop2(); 579: tl1 = (tl1 - *pc.sp++) << tl; 580: tcp = popaddr(); 581: pushaddr(tcp + tl1); 582: continue; 583: case O_INX4P2: 584: tl = *pc.cp++; /* tl has shift amount */ 585: tl1 = pop4(); 586: tl1 = (tl1 - *pc.sp++) << tl; 587: tcp = popaddr(); 588: pushaddr(tcp + tl1); 589: continue; 590: case O_INX2: 591: tl = *pc.cp++; /* tl has element size */ 592: if (tl == 0) 593: tl = *pc.usp++; 594: tl1 = pop2(); /* index */ 595: tl2 = *pc.sp++; 596: tcp = popaddr(); 597: pushaddr(tcp + (tl1 - tl2) * tl); 598: tl = *pc.usp++; 599: if (_runtst) 600: SUBSC(tl1, tl2, tl); /* range check */ 601: continue; 602: case O_INX4: 603: tl = *pc.cp++; /* tl has element size */ 604: if (tl == 0) 605: tl = *pc.usp++; 606: tl1 = pop4(); /* index */ 607: tl2 = *pc.sp++; 608: tcp = popaddr(); 609: pushaddr(tcp + (tl1 - tl2) * tl); 610: tl = *pc.usp++; 611: if (_runtst) 612: SUBSC(tl1, tl2, tl); /* range check */ 613: continue; 614: case O_VINX2: 615: pc.cp++; 616: tl = pop2(); /* tl has element size */ 617: tl1 = pop2(); /* upper bound */ 618: tl2 = pop2(); /* lower bound */ 619: tl3 = pop2(); /* index */ 620: tcp = popaddr(); 621: pushaddr(tcp + (tl3 - tl2) * tl); 622: if (_runtst) 623: SUBSC(tl3, tl2, tl1); /* range check */ 624: continue; 625: case O_VINX24: 626: pc.cp++; 627: tl = pop2(); /* tl has element size */ 628: tl1 = pop2(); /* upper bound */ 629: tl2 = pop2(); /* lower bound */ 630: tl3 = pop4(); /* index */ 631: tcp = popaddr(); 632: pushaddr(tcp + (tl3 - tl2) * tl); 633: if (_runtst) 634: SUBSC(tl3, tl2, tl1); /* range check */ 635: continue; 636: case O_VINX42: 637: pc.cp++; 638: tl = pop4(); /* tl has element size */ 639: tl1 = pop4(); /* upper bound */ 640: tl2 = pop4(); /* lower bound */ 641: tl3 = pop2(); /* index */ 642: tcp = popaddr(); 643: pushaddr(tcp + (tl3 - tl2) * tl); 644: if (_runtst) 645: SUBSC(tl3, tl2, tl1); /* range check */ 646: continue; 647: case O_VINX4: 648: pc.cp++; 649: tl = pop4(); /* tl has element size */ 650: tl1 = pop4(); /* upper bound */ 651: tl2 = pop4(); /* lower bound */ 652: tl3 = pop4(); /* index */ 653: tcp = popaddr(); 654: pushaddr(tcp + (tl3 - tl2) * tl); 655: if (_runtst) 656: SUBSC(tl3, tl2, tl1); /* range check */ 657: continue; 658: case O_OFF: 659: tl = *pc.cp++; 660: if (tl == 0) 661: tl = *pc.usp++; 662: tcp = popaddr(); 663: pushaddr(tcp + tl); 664: continue; 665: case O_NIL: 666: pc.cp++; 667: tcp = popaddr(); 668: NIL(tcp); 669: pushaddr(tcp); 670: continue; 671: case O_ADD2: 672: pc.cp++; 673: tl = pop2(); 674: tl1 = pop2(); 675: push4(tl1 + tl); 676: continue; 677: case O_ADD4: 678: pc.cp++; 679: tl = pop4(); 680: tl1 = pop4(); 681: push4(tl1 + tl); 682: continue; 683: case O_ADD24: 684: pc.cp++; 685: tl = pop2(); 686: tl1 = pop4(); 687: push4(tl1 + tl); 688: continue; 689: case O_ADD42: 690: pc.cp++; 691: tl = pop4(); 692: tl1 = pop2(); 693: push4(tl1 + tl); 694: continue; 695: case O_ADD28: 696: pc.cp++; 697: tl = pop2(); 698: td = pop8(); 699: push8(td + tl); 700: continue; 701: case O_ADD48: 702: pc.cp++; 703: tl = pop4(); 704: td = pop8(); 705: push8(td + tl); 706: continue; 707: case O_ADD82: 708: pc.cp++; 709: td = pop8(); 710: td1 = pop2(); 711: push8(td1 + td); 712: continue; 713: case O_ADD84: 714: pc.cp++; 715: td = pop8(); 716: td1 = pop4(); 717: push8(td1 + td); 718: continue; 719: case O_SUB2: 720: pc.cp++; 721: tl = pop2(); 722: tl1 = pop2(); 723: push4(tl1 - tl); 724: continue; 725: case O_SUB4: 726: pc.cp++; 727: tl = pop4(); 728: tl1 = pop4(); 729: push4(tl1 - tl); 730: continue; 731: case O_SUB24: 732: pc.cp++; 733: tl = pop2(); 734: tl1 = pop4(); 735: push4(tl1 - tl); 736: continue; 737: case O_SUB42: 738: pc.cp++; 739: tl = pop4(); 740: tl1 = pop2(); 741: push4(tl1 - tl); 742: continue; 743: case O_SUB28: 744: pc.cp++; 745: tl = pop2(); 746: td = pop8(); 747: push8(td - tl); 748: continue; 749: case O_SUB48: 750: pc.cp++; 751: tl = pop4(); 752: td = pop8(); 753: push8(td - tl); 754: continue; 755: case O_SUB82: 756: pc.cp++; 757: td = pop8(); 758: td1 = pop2(); 759: push8(td1 - td); 760: continue; 761: case O_SUB84: 762: pc.cp++; 763: td = pop8(); 764: td1 = pop4(); 765: push8(td1 - td); 766: continue; 767: case O_MUL2: 768: pc.cp++; 769: tl = pop2(); 770: tl1 = pop2(); 771: push4(tl1 * tl); 772: continue; 773: case O_MUL4: 774: pc.cp++; 775: tl = pop4(); 776: tl1 = pop4(); 777: push4(tl1 * tl); 778: continue; 779: case O_MUL24: 780: pc.cp++; 781: tl = pop2(); 782: tl1 = pop4(); 783: push4(tl1 * tl); 784: continue; 785: case O_MUL42: 786: pc.cp++; 787: tl = pop4(); 788: tl1 = pop2(); 789: push4(tl1 * tl); 790: continue; 791: case O_MUL28: 792: pc.cp++; 793: tl = pop2(); 794: td = pop8(); 795: push8(td * tl); 796: continue; 797: case O_MUL48: 798: pc.cp++; 799: tl = pop4(); 800: td = pop8(); 801: push8(td * tl); 802: continue; 803: case O_MUL82: 804: pc.cp++; 805: td = pop8(); 806: td1 = pop2(); 807: push8(td1 * td); 808: continue; 809: case O_MUL84: 810: pc.cp++; 811: td = pop8(); 812: td1 = pop4(); 813: push8(td1 * td); 814: continue; 815: case O_ABS2: 816: case O_ABS4: 817: pc.cp++; 818: tl = pop4(); 819: push4(tl >= 0 ? tl : -tl); 820: continue; 821: case O_ABS8: 822: pc.cp++; 823: td = pop8(); 824: push8(td >= 0.0 ? td : -td); 825: continue; 826: case O_NEG2: 827: pc.cp++; 828: push4((long)(-pop2())); 829: continue; 830: case O_NEG4: 831: pc.cp++; 832: push4(-pop4()); 833: continue; 834: case O_NEG8: 835: pc.cp++; 836: push8(-pop8()); 837: continue; 838: case O_DIV2: 839: pc.cp++; 840: tl = pop2(); 841: tl1 = pop2(); 842: push4(tl1 / tl); 843: continue; 844: case O_DIV4: 845: pc.cp++; 846: tl = pop4(); 847: tl1 = pop4(); 848: push4(tl1 / tl); 849: continue; 850: case O_DIV24: 851: pc.cp++; 852: tl = pop2(); 853: tl1 = pop4(); 854: push4(tl1 / tl); 855: continue; 856: case O_DIV42: 857: pc.cp++; 858: tl = pop4(); 859: tl1 = pop2(); 860: push4(tl1 / tl); 861: continue; 862: case O_MOD2: 863: pc.cp++; 864: tl = pop2(); 865: tl1 = pop2(); 866: push4(tl1 % tl); 867: continue; 868: case O_MOD4: 869: pc.cp++; 870: tl = pop4(); 871: tl1 = pop4(); 872: push4(tl1 % tl); 873: continue; 874: case O_MOD24: 875: pc.cp++; 876: tl = pop2(); 877: tl1 = pop4(); 878: push4(tl1 % tl); 879: continue; 880: case O_MOD42: 881: pc.cp++; 882: tl = pop4(); 883: tl1 = pop2(); 884: push4(tl1 % tl); 885: continue; 886: case O_ADD8: 887: pc.cp++; 888: td = pop8(); 889: td1 = pop8(); 890: push8(td1 + td); 891: continue; 892: case O_SUB8: 893: pc.cp++; 894: td = pop8(); 895: td1 = pop8(); 896: push8(td1 - td); 897: continue; 898: case O_MUL8: 899: pc.cp++; 900: td = pop8(); 901: td1 = pop8(); 902: push8(td1 * td); 903: continue; 904: case O_DVD8: 905: pc.cp++; 906: td = pop8(); 907: td1 = pop8(); 908: push8(td1 / td); 909: continue; 910: case O_STOI: 911: pc.cp++; 912: push4((long)(pop2())); 913: continue; 914: case O_STOD: 915: pc.cp++; 916: td = pop2(); 917: push8(td); 918: continue; 919: case O_ITOD: 920: pc.cp++; 921: td = pop4(); 922: push8(td); 923: continue; 924: case O_ITOS: 925: pc.cp++; 926: push2((short)(pop4())); 927: continue; 928: case O_DVD2: 929: pc.cp++; 930: td = pop2(); 931: td1 = pop2(); 932: push8(td1 / td); 933: continue; 934: case O_DVD4: 935: pc.cp++; 936: td = pop4(); 937: td1 = pop4(); 938: push8(td1 / td); 939: continue; 940: case O_DVD24: 941: pc.cp++; 942: td = pop2(); 943: td1 = pop4(); 944: push8(td1 / td); 945: continue; 946: case O_DVD42: 947: pc.cp++; 948: td = pop4(); 949: td1 = pop2(); 950: push8(td1 / td); 951: continue; 952: case O_DVD28: 953: pc.cp++; 954: td = pop2(); 955: td1 = pop8(); 956: push8(td1 / td); 957: continue; 958: case O_DVD48: 959: pc.cp++; 960: td = pop4(); 961: td1 = pop8(); 962: push8(td1 / td); 963: continue; 964: case O_DVD82: 965: pc.cp++; 966: td = pop8(); 967: td1 = pop2(); 968: push8(td1 / td); 969: continue; 970: case O_DVD84: 971: pc.cp++; 972: td = pop8(); 973: td1 = pop4(); 974: push8(td1 / td); 975: continue; 976: case O_RV1: 977: tcp = _display.raw[*pc.ucp++]; 978: push2((short)(*(tcp + *pc.sp++))); 979: continue; 980: case O_RV14: 981: tcp = _display.raw[*pc.ucp++]; 982: push4((long)(*(tcp + *pc.sp++))); 983: continue; 984: case O_RV2: 985: tcp = _display.raw[*pc.ucp++]; 986: push2(*(short *)(tcp + *pc.sp++)); 987: continue; 988: case O_RV24: 989: tcp = _display.raw[*pc.ucp++]; 990: push4((long)(*(short *)(tcp + *pc.sp++))); 991: continue; 992: case O_RV4: 993: tcp = _display.raw[*pc.ucp++]; 994: push4(*(long *)(tcp + *pc.sp++)); 995: continue; 996: case O_RV8: 997: tcp = _display.raw[*pc.ucp++]; 998: pushsze8(*(struct sze8 *)(tcp + *pc.sp++)); 999: continue; 1000: case O_RV: 1001: tcp = _display.raw[*pc.ucp++]; 1002: tcp += *pc.sp++; 1003: tl = *pc.usp++; 1004: tcp1 = pushsp((tl + 1) & ~1); 1005: blkcpy(tcp, tcp1, tl); 1006: continue; 1007: case O_LV: 1008: tcp = _display.raw[*pc.ucp++]; 1009: pushaddr(tcp + *pc.sp++); 1010: continue; 1011: case O_LRV1: 1012: tcp = _display.raw[*pc.ucp++]; 1013: push2((short)(*(tcp + *pc.lp++))); 1014: continue; 1015: case O_LRV14: 1016: tcp = _display.raw[*pc.ucp++]; 1017: push4((long)(*(tcp + *pc.lp++))); 1018: continue; 1019: case O_LRV2: 1020: tcp = _display.raw[*pc.ucp++]; 1021: push2(*(short *)(tcp + *pc.lp++)); 1022: continue; 1023: case O_LRV24: 1024: tcp = _display.raw[*pc.ucp++]; 1025: push4((long)(*(short *)(tcp + *pc.lp++))); 1026: continue; 1027: case O_LRV4: 1028: tcp = _display.raw[*pc.ucp++]; 1029: push4(*(long *)(tcp + *pc.lp++)); 1030: continue; 1031: case O_LRV8: 1032: tcp = _display.raw[*pc.ucp++]; 1033: pushsze8(*(struct sze8 *)(tcp + *pc.lp++)); 1034: continue; 1035: case O_LRV: 1036: tcp = _display.raw[*pc.ucp++]; 1037: tcp += (int)*pc.lp++; 1038: tl = *pc.usp++; 1039: tcp1 = pushsp((tl + 1) & ~1); 1040: blkcpy(tcp, tcp1, tl); 1041: continue; 1042: case O_LLV: 1043: tcp = _display.raw[*pc.ucp++]; 1044: pushaddr(tcp + *pc.lp++); 1045: continue; 1046: case O_IND1: 1047: pc.cp++; 1048: push2((short)(*popaddr())); 1049: continue; 1050: case O_IND14: 1051: pc.cp++; 1052: push4((long)(*popaddr())); 1053: continue; 1054: case O_IND2: 1055: pc.cp++; 1056: push2(*(short *)(popaddr())); 1057: continue; 1058: case O_IND24: 1059: pc.cp++; 1060: push4((long)(*(short *)(popaddr()))); 1061: continue; 1062: case O_IND4: 1063: pc.cp++; 1064: push4(*(long *)(popaddr())); 1065: continue; 1066: case O_IND8: 1067: pc.cp++; 1068: pushsze8(*(struct sze8 *)(popaddr())); 1069: continue; 1070: case O_IND: 1071: tl = *pc.cp++; 1072: if (tl == 0) 1073: tl = *pc.usp++; 1074: tcp = popaddr(); 1075: tcp1 = pushsp((tl + 1) & ~1); 1076: blkcpy(tcp, tcp1, tl); 1077: continue; 1078: case O_CON1: 1079: push2((short)(*pc.cp++)); 1080: continue; 1081: case O_CON14: 1082: push4((long)(*pc.cp++)); 1083: continue; 1084: case O_CON2: 1085: pc.cp++; 1086: push2(*pc.sp++); 1087: continue; 1088: case O_CON24: 1089: pc.cp++; 1090: push4((long)(*pc.sp++)); 1091: continue; 1092: case O_CON4: 1093: pc.cp++; 1094: push4(*pc.lp++); 1095: continue; 1096: case O_CON8: 1097: pc.cp++; 1098: push8(*pc.dbp++); 1099: continue; 1100: case O_CON: 1101: tl = *pc.cp++; 1102: if (tl == 0) 1103: tl = *pc.usp++; 1104: tl = (tl + 1) & ~1; 1105: tcp = pushsp(tl); 1106: blkcpy(pc.cp, tcp, tl); 1107: pc.cp += (int)tl; 1108: continue; 1109: case O_CONG: 1110: tl = *pc.cp++; 1111: if (tl == 0) 1112: tl = *pc.usp++; 1113: tl1 = (tl + 1) & ~1; 1114: tcp = pushsp(tl1); 1115: blkcpy(pc.cp, tcp, tl1); 1116: pc.cp += (int)((tl + 2) & ~1); 1117: continue; 1118: case O_LVCON: 1119: tl = *pc.cp++; 1120: if (tl == 0) 1121: tl = *pc.usp++; 1122: tl = (tl + 1) & ~1; 1123: pushaddr(pc.cp); 1124: pc.cp += (int)tl; 1125: continue; 1126: case O_RANG2: 1127: tl = *pc.cp++; 1128: if (tl == 0) 1129: tl = *pc.sp++; 1130: tl1 = pop2(); 1131: push2((short)(RANG4(tl1, tl, (long)(*pc.sp++)))); 1132: continue; 1133: case O_RANG42: 1134: tl = *pc.cp++; 1135: if (tl == 0) 1136: tl = *pc.sp++; 1137: tl1 = pop4(); 1138: push4(RANG4(tl1, tl, (long)(*pc.sp++))); 1139: continue; 1140: case O_RSNG2: 1141: tl = *pc.cp++; 1142: if (tl == 0) 1143: tl = *pc.sp++; 1144: tl1 = pop2(); 1145: push2((short)(RSNG4(tl1, tl))); 1146: continue; 1147: case O_RSNG42: 1148: tl = *pc.cp++; 1149: if (tl == 0) 1150: tl = *pc.sp++; 1151: tl1 = pop4(); 1152: push4(RSNG4(tl1, tl)); 1153: continue; 1154: case O_RANG4: 1155: tl = *pc.cp++; 1156: if (tl == 0) 1157: tl = *pc.lp++; 1158: tl1 = pop4(); 1159: push4(RANG4(tl1, tl, *pc.lp++)); 1160: continue; 1161: case O_RANG24: 1162: tl = *pc.cp++; 1163: if (tl == 0) 1164: tl = *pc.lp++; 1165: tl1 = pop2(); 1166: push2((short)(RANG4(tl1, tl, *pc.lp++))); 1167: continue; 1168: case O_RSNG4: 1169: tl = *pc.cp++; 1170: if (tl == 0) 1171: tl = *pc.lp++; 1172: tl1 = pop4(); 1173: push4(RSNG4(tl1, tl)); 1174: continue; 1175: case O_RSNG24: 1176: tl = *pc.cp++; 1177: if (tl == 0) 1178: tl = *pc.lp++; 1179: tl1 = pop2(); 1180: push2((short)(RSNG4(tl1, tl))); 1181: continue; 1182: case O_STLIM: 1183: pc.cp++; 1184: STLIM(); 1185: popsp((long)(sizeof(long))); 1186: continue; 1187: case O_LLIMIT: 1188: pc.cp++; 1189: LLIMIT(); 1190: popsp((long)(sizeof(char *)+sizeof(long))); 1191: continue; 1192: case O_BUFF: 1193: BUFF((long)(*pc.cp++)); 1194: continue; 1195: case O_HALT: 1196: pc.cp++; 1197: if (_nodump == TRUE) 1198: psexit(0); 1199: fputs("\nCall to procedure halt\n", stderr); 1200: backtrace("Halted"); 1201: psexit(0); 1202: continue; 1203: case O_PXPBUF: 1204: pc.cp++; 1205: _cntrs = *pc.lp++; 1206: _rtns = *pc.lp++; 1207: NEW(&_pcpcount, (_cntrs + 1) * sizeof(long)); 1208: blkclr(_pcpcount, (_cntrs + 1) * sizeof(long)); 1209: continue; 1210: case O_COUNT: 1211: pc.cp++; 1212: _pcpcount[*pc.usp++]++; 1213: continue; 1214: case O_CASE1OP: 1215: tl = *pc.cp++; /* tl = number of cases */ 1216: if (tl == 0) 1217: tl = *pc.usp++; 1218: tsp = pc.sp + tl; /* ptr to end of jump table */ 1219: tcp = (char *)tsp; /* tcp = ptr to case values */ 1220: tl1 = pop2(); /* tl1 = element to find */ 1221: for(; tl > 0; tl--) /* look for element */ 1222: if (tl1 == *tcp++) 1223: break; 1224: if (tl == 0) /* default case => error */ 1225: CASERNG(tl1); 1226: pc.cp += *(tsp - tl); 1227: continue; 1228: case O_CASE2OP: 1229: tl = *pc.cp++; /* tl = number of cases */ 1230: if (tl == 0) 1231: tl = *pc.usp++; 1232: tsp = pc.sp + tl; /* ptr to end of jump table */ 1233: tsp1 = tsp; /* tsp1 = ptr to case values */ 1234: tl1 = (unsigned short)pop2();/* tl1 = element to find */ 1235: for(; tl > 0; tl--) /* look for element */ 1236: if (tl1 == *tsp1++) 1237: break; 1238: if (tl == 0) /* default case => error */ 1239: CASERNG(tl1); 1240: pc.cp += *(tsp - tl); 1241: continue; 1242: case O_CASE4OP: 1243: tl = *pc.cp++; /* tl = number of cases */ 1244: if (tl == 0) 1245: tl = *pc.usp++; 1246: tsp = pc.sp + tl; /* ptr to end of jump table */ 1247: tlp = (long *)tsp; /* tlp = ptr to case values */ 1248: tl1 = pop4(); /* tl1 = element to find */ 1249: for(; tl > 0; tl--) /* look for element */ 1250: if (tl1 == *tlp++) 1251: break; 1252: if (tl == 0) /* default case => error */ 1253: CASERNG(tl1); 1254: pc.cp += *(tsp - tl); 1255: continue; 1256: case O_ADDT: 1257: tl = *pc.cp++; /* tl has comparison length */ 1258: if (tl == 0) 1259: tl = *pc.usp++; 1260: tcp = pushsp((long)(0));/* tcp pts to first arg */ 1261: ADDT(tcp + tl, tcp + tl, tcp, tl >> 2); 1262: popsp(tl); 1263: continue; 1264: case O_SUBT: 1265: tl = *pc.cp++; /* tl has comparison length */ 1266: if (tl == 0) 1267: tl = *pc.usp++; 1268: tcp = pushsp((long)(0));/* tcp pts to first arg */ 1269: SUBT(tcp + tl, tcp + tl, tcp, tl >> 2); 1270: popsp(tl); 1271: continue; 1272: case O_MULT: 1273: tl = *pc.cp++; /* tl has comparison length */ 1274: if (tl == 0) 1275: tl = *pc.usp++; 1276: tcp = pushsp((long)(0));/* tcp pts to first arg */ 1277: MULT(tcp + tl, tcp + tl, tcp, tl >> 2); 1278: popsp(tl); 1279: continue; 1280: case O_INCT: 1281: tl = *pc.cp++; /* tl has number of args */ 1282: if (tl == 0) 1283: tl = *pc.usp++; 1284: tb = INCT(); 1285: popsp(tl*sizeof(long)); 1286: push2((short)(tb)); 1287: continue; 1288: case O_CTTOT: 1289: tl = *pc.cp++; /* tl has number of args */ 1290: if (tl == 0) 1291: tl = *pc.usp++; 1292: tl1 = tl * sizeof(long); 1293: tcp = pushsp((long)(0)) + tl1; /* tcp pts to result */ 1294: CTTOT(tcp); 1295: popsp(tl*sizeof(long)); 1296: continue; 1297: case O_CARD: 1298: tl = *pc.cp++; /* tl has comparison length */ 1299: if (tl == 0) 1300: tl = *pc.usp++; 1301: tcp = pushsp((long)(0));/* tcp pts to set */ 1302: tl1 = CARD(tcp, tl); 1303: popsp(tl); 1304: push2((short)(tl1)); 1305: continue; 1306: case O_IN: 1307: tl = *pc.cp++; /* tl has comparison length */ 1308: if (tl == 0) 1309: tl = *pc.usp++; 1310: tl1 = pop4(); /* tl1 is the element */ 1311: tcp = pushsp((long)(0));/* tcp pts to set */ 1312: tl2 = *pc.sp++; /* lower bound */ 1313: tb = IN(tl1, tl2, (long)(*pc.usp++), tcp); 1314: popsp(tl); 1315: push2((short)(tb)); 1316: continue; 1317: case O_ASRT: 1318: pc.cp++; 1319: tl = pop4(); 1320: tcp = popaddr(); 1321: ASRTS(tl, tcp); 1322: continue; 1323: case O_FOR1U: 1324: tl1 = *pc.cp++; /* tl1 loop branch */ 1325: if (tl1 == 0) 1326: tl1 = *pc.sp++; 1327: tcp = popaddr(); /* tcp = ptr to index var */ 1328: tl = pop4(); /* tl upper bound */ 1329: if (*tcp == tl) /* loop is done, fall through */ 1330: continue; 1331: *tcp += 1; /* inc index var */ 1332: pc.cp += tl1; /* return to top of loop */ 1333: continue; 1334: case O_FOR2U: 1335: tl1 = *pc.cp++; /* tl1 loop branch */ 1336: if (tl1 == 0) 1337: tl1 = *pc.sp++; 1338: tsp = (short *)popaddr(); /* tsp = ptr to index var */ 1339: tl = pop4(); /* tl upper bound */ 1340: if (*tsp == tl) /* loop is done, fall through */ 1341: continue; 1342: *tsp += 1; /* inc index var */ 1343: pc.cp += tl1; /* return to top of loop */ 1344: continue; 1345: case O_FOR4U: 1346: tl1 = *pc.cp++; /* tl1 loop branch */ 1347: if (tl1 == 0) 1348: tl1 = *pc.sp++; 1349: tlp = (long *)popaddr(); /* tlp = ptr to index var */ 1350: tl = pop4(); /* tl upper bound */ 1351: if (*tlp == tl) /* loop is done, fall through */ 1352: continue; 1353: *tlp += 1; /* inc index var */ 1354: pc.cp += tl1; /* return to top of loop */ 1355: continue; 1356: case O_FOR1D: 1357: tl1 = *pc.cp++; /* tl1 loop branch */ 1358: if (tl1 == 0) 1359: tl1 = *pc.sp++; 1360: tcp = popaddr(); /* tcp = ptr to index var */ 1361: tl = pop4(); /* tl upper bound */ 1362: if (*tcp == tl) /* loop is done, fall through */ 1363: continue; 1364: *tcp -= 1; /* dec index var */ 1365: pc.cp += tl1; /* return to top of loop */ 1366: continue; 1367: case O_FOR2D: 1368: tl1 = *pc.cp++; /* tl1 loop branch */ 1369: if (tl1 == 0) 1370: tl1 = *pc.sp++; 1371: tsp = (short *)popaddr(); /* tsp = ptr to index var */ 1372: tl = pop4(); /* tl upper bound */ 1373: if (*tsp == tl) /* loop is done, fall through */ 1374: continue; 1375: *tsp -= 1; /* dec index var */ 1376: pc.cp += tl1; /* return to top of loop */ 1377: continue; 1378: case O_FOR4D: 1379: tl1 = *pc.cp++; /* tl1 loop branch */ 1380: if (tl1 == 0) 1381: tl1 = *pc.sp++; 1382: tlp = (long *)popaddr(); /* tlp = ptr to index var */ 1383: tl = pop4(); /* tl upper bound */ 1384: if (*tlp == tl) /* loop is done, fall through */ 1385: continue; 1386: *tlp -= 1; /* dec index var */ 1387: pc.cp += tl1; /* return to top of loop */ 1388: continue; 1389: case O_READE: 1390: pc.cp++; 1391: push2((short)(READE(curfile, base + *pc.lp++))); 1392: continue; 1393: case O_READ4: 1394: pc.cp++; 1395: push4(READ4(curfile)); 1396: continue; 1397: case O_READC: 1398: pc.cp++; 1399: push2((short)(READC(curfile))); 1400: continue; 1401: case O_READ8: 1402: pc.cp++; 1403: push8(READ8(curfile)); 1404: continue; 1405: case O_READLN: 1406: pc.cp++; 1407: READLN(curfile); 1408: continue; 1409: case O_EOF: 1410: pc.cp++; 1411: push2((short)(TEOF(popaddr()))); 1412: continue; 1413: case O_EOLN: 1414: pc.cp++; 1415: push2((short)(TEOLN(popaddr()))); 1416: continue; 1417: case O_WRITEC: 1418: if (_runtst) { 1419: WRITEC(curfile); 1420: popsp((long)(*pc.cp++)); 1421: continue; 1422: } 1423: tl = *pc.cp++; 1424: switch (tl - sizeof(FILE *)) { 1425: case 2: 1426: tl1 = pop2(); 1427: break; 1428: case 4: 1429: tl1 = pop4(); 1430: break; 1431: default: 1432: ERROR("Panic: bad size to O_WRITEC"); 1433: /* NOT REACHED */ 1434: } 1435: tcp = popaddr(); 1436: fputc(tl1, tcp); 1437: continue; 1438: case O_WRITES: 1439: if (_runtst) { 1440: WRITES(curfile); 1441: popsp((long)(*pc.cp++)); 1442: continue; 1443: } 1444: fwrite(); 1445: popsp((long)(*pc.cp++)); 1446: continue; 1447: case O_WRITEF: 1448: if (_runtst) { 1449: WRITEF(curfile); 1450: popsp((long)(*pc.cp++)); 1451: continue; 1452: } 1453: fprintf(); 1454: popsp((long)(*pc.cp++)); 1455: continue; 1456: case O_WRITLN: 1457: pc.cp++; 1458: if (_runtst) { 1459: WRITLN(curfile); 1460: continue; 1461: } 1462: fputc('\n', ACTFILE(curfile)); 1463: continue; 1464: case O_PAGE: 1465: pc.cp++; 1466: if (_runtst) { 1467: PAGE(curfile); 1468: continue; 1469: } 1470: fputc('', ACTFILE(curfile)); 1471: continue; 1472: case O_NAM: 1473: pc.cp++; 1474: tl = pop4(); 1475: pushaddr(NAM(tl, base + *pc.lp++)); 1476: continue; 1477: case O_MAX: 1478: tl = *pc.cp++; 1479: if (tl == 0) 1480: tl = *pc.usp++; 1481: tl1 = pop4(); 1482: if (_runtst) { 1483: push4(MAX(tl1, tl, (long)(*pc.usp++))); 1484: continue; 1485: } 1486: tl1 -= tl; 1487: tl = *pc.usp++; 1488: push4(tl1 > tl ? tl1 : tl); 1489: continue; 1490: case O_MIN: 1491: tl = *pc.cp++; 1492: if (tl == 0) 1493: tl = *pc.usp++; 1494: tl1 = pop4(); 1495: push4(tl1 < tl ? tl1 : tl); 1496: continue; 1497: case O_UNIT: 1498: pc.cp++; 1499: curfile = UNIT(popaddr()); 1500: continue; 1501: case O_UNITINP: 1502: pc.cp++; 1503: curfile = INPUT; 1504: continue; 1505: case O_UNITOUT: 1506: pc.cp++; 1507: curfile = OUTPUT; 1508: continue; 1509: case O_MESSAGE: 1510: pc.cp++; 1511: PFLUSH(); 1512: curfile = ERR; 1513: continue; 1514: case O_PUT: 1515: pc.cp++; 1516: PUT(curfile); 1517: continue; 1518: case O_GET: 1519: pc.cp++; 1520: GET(curfile); 1521: continue; 1522: case O_FNIL: 1523: pc.cp++; 1524: pushaddr(FNIL(popaddr())); 1525: continue; 1526: case O_DEFNAME: 1527: pc.cp++; 1528: DEFNAME(); 1529: popsp((long)(2*sizeof(char *)+2*sizeof(long))); 1530: continue; 1531: case O_RESET: 1532: pc.cp++; 1533: RESET(); 1534: popsp((long)(2*sizeof(char *)+2*sizeof(long))); 1535: continue; 1536: case O_REWRITE: 1537: pc.cp++; 1538: REWRITE(); 1539: popsp((long)(2*sizeof(char *)+2*sizeof(long))); 1540: continue; 1541: case O_FILE: 1542: pc.cp++; 1543: pushaddr(ACTFILE(curfile)); 1544: continue; 1545: case O_REMOVE: 1546: pc.cp++; 1547: REMOVE(); 1548: popsp((long)(sizeof(char *)+sizeof(long))); 1549: continue; 1550: case O_FLUSH: 1551: pc.cp++; 1552: FLUSH(); 1553: popsp((long)(sizeof(char *))); 1554: continue; 1555: case O_PACK: 1556: pc.cp++; 1557: PACK(); 1558: popsp((long)(5*sizeof(long)+2*sizeof(char*))); 1559: continue; 1560: case O_UNPACK: 1561: pc.cp++; 1562: UNPACK(); 1563: popsp((long)(5*sizeof(long)+2*sizeof(char*))); 1564: continue; 1565: case O_ARGC: 1566: pc.cp++; 1567: push4((long)_argc); 1568: continue; 1569: case O_ARGV: 1570: tl = *pc.cp++; /* tl = size of char array */ 1571: if (tl == 0) 1572: tl = *pc.usp++; 1573: tcp = popaddr(); /* tcp = addr of char array */ 1574: tl1 = pop4(); /* tl1 = argv subscript */ 1575: ARGV(tl1, tcp, tl); 1576: continue; 1577: case O_CLCK: 1578: pc.cp++; 1579: push4(CLCK()); 1580: continue; 1581: case O_WCLCK: 1582: pc.cp++; 1583: push4(time(0)); 1584: continue; 1585: case O_SCLCK: 1586: pc.cp++; 1587: push4(SCLCK()); 1588: continue; 1589: case O_NEW: 1590: tl = *pc.cp++; /* tl = size being new'ed */ 1591: if (tl == 0) 1592: tl = *pc.usp++; 1593: tcp = popaddr(); /* ptr to ptr being new'ed */ 1594: NEW(tcp, tl); 1595: if (_runtst) { 1596: blkclr(*((char **)(tcp)), tl); 1597: } 1598: continue; 1599: case O_DISPOSE: 1600: tl = *pc.cp++; /* tl = size being disposed */ 1601: if (tl == 0) 1602: tl = *pc.usp++; 1603: tcp = popaddr(); /* ptr to ptr being disposed */ 1604: DISPOSE(tcp, tl); 1605: *(char **)tcp = (char *)0; 1606: continue; 1607: case O_DFDISP: 1608: tl = *pc.cp++; /* tl = size being disposed */ 1609: if (tl == 0) 1610: tl = *pc.usp++; 1611: tcp = popaddr(); /* ptr to ptr being disposed */ 1612: DFDISPOSE(tcp, tl); 1613: *(char **)tcp = (char *)0; 1614: continue; 1615: case O_DATE: 1616: pc.cp++; 1617: DATE(popaddr()); 1618: continue; 1619: case O_TIME: 1620: pc.cp++; 1621: TIME(popaddr()); 1622: continue; 1623: case O_UNDEF: 1624: pc.cp++; 1625: pop8(); 1626: push2((short)(0)); 1627: continue; 1628: case O_ATAN: 1629: pc.cp++; 1630: if (_runtst) { 1631: push8(ATAN(pop8())); 1632: continue; 1633: } 1634: push8(atan(pop8())); 1635: continue; 1636: case O_COS: 1637: pc.cp++; 1638: if (_runtst) { 1639: push8(COS(pop8())); 1640: continue; 1641: } 1642: push8(cos(pop8())); 1643: continue; 1644: case O_EXP: 1645: pc.cp++; 1646: if (_runtst) { 1647: push8(EXP(pop8())); 1648: continue; 1649: } 1650: push8(exp(pop8())); 1651: continue; 1652: case O_LN: 1653: pc.cp++; 1654: if (_runtst) { 1655: push8(LN(pop8())); 1656: continue; 1657: } 1658: push8(log(pop8())); 1659: continue; 1660: case O_SIN: 1661: pc.cp++; 1662: if (_runtst) { 1663: push8(SIN(pop8())); 1664: continue; 1665: } 1666: push8(sin(pop8())); 1667: continue; 1668: case O_SQRT: 1669: pc.cp++; 1670: if (_runtst) { 1671: push8(SQRT(pop8())); 1672: continue; 1673: } 1674: push8(sqrt(pop8())); 1675: continue; 1676: case O_CHR2: 1677: case O_CHR4: 1678: pc.cp++; 1679: if (_runtst) { 1680: push2((short)(CHR(pop4()))); 1681: continue; 1682: } 1683: push2((short)(pop4())); 1684: continue; 1685: case O_ODD2: 1686: case O_ODD4: 1687: pc.cp++; 1688: tl = pop4(); 1689: push2((short)(tl & 1)); 1690: continue; 1691: case O_SUCC2: 1692: tl = *pc.cp++; 1693: if (tl == 0) 1694: tl = *pc.sp++; 1695: tl1 = pop4(); 1696: if (_runtst) { 1697: push2((short)(SUCC(tl1, tl, (long)(*pc.sp++)))); 1698: continue; 1699: } 1700: push2((short)(tl1 + 1)); 1701: pc.sp++; 1702: continue; 1703: case O_SUCC24: 1704: tl = *pc.cp++; 1705: if (tl == 0) 1706: tl = *pc.sp++; 1707: tl1 = pop4(); 1708: if (_runtst) { 1709: push4(SUCC(tl1, tl, (long)(*pc.sp++))); 1710: continue; 1711: } 1712: push4(tl1 + 1); 1713: pc.sp++; 1714: continue; 1715: case O_SUCC4: 1716: tl = *pc.cp++; 1717: if (tl == 0) 1718: tl = *pc.lp++; 1719: tl1 = pop4(); 1720: if (_runtst) { 1721: push4(SUCC(tl1, tl, (long)(*pc.lp++))); 1722: continue; 1723: } 1724: push4(tl1 + 1); 1725: pc.lp++; 1726: continue; 1727: case O_PRED2: 1728: tl = *pc.cp++; 1729: if (tl == 0) 1730: tl = *pc.sp++; 1731: tl1 = pop4(); 1732: if (_runtst) { 1733: push2((short)(PRED(tl1, tl, (long)(*pc.sp++)))); 1734: continue; 1735: } 1736: push2((short)(tl1 - 1)); 1737: pc.sp++; 1738: continue; 1739: case O_PRED24: 1740: tl = *pc.cp++; 1741: if (tl == 0) 1742: tl = *pc.sp++; 1743: tl1 = pop4(); 1744: if (_runtst) { 1745: push4(PRED(tl1, tl, (long)(*pc.sp++))); 1746: continue; 1747: } 1748: push4(tl1 - 1); 1749: pc.sp++; 1750: continue; 1751: case O_PRED4: 1752: tl = *pc.cp++; 1753: if (tl == 0) 1754: tl = *pc.lp++; 1755: tl1 = pop4(); 1756: if (_runtst) { 1757: push4(PRED(tl1, tl, (long)(*pc.lp++))); 1758: continue; 1759: } 1760: push4(tl1 - 1); 1761: pc.lp++; 1762: continue; 1763: case O_SEED: 1764: pc.cp++; 1765: push4(SEED(pop4())); 1766: continue; 1767: case O_RANDOM: 1768: pc.cp++; 1769: push8(RANDOM(pop8())); 1770: continue; 1771: case O_EXPO: 1772: pc.cp++; 1773: push4(EXPO(pop8())); 1774: continue; 1775: case O_SQR2: 1776: case O_SQR4: 1777: pc.cp++; 1778: tl = pop4(); 1779: push4(tl * tl); 1780: continue; 1781: case O_SQR8: 1782: pc.cp++; 1783: td = pop8(); 1784: push8(td * td); 1785: continue; 1786: case O_ROUND: 1787: pc.cp++; 1788: push4(ROUND(pop8())); 1789: continue; 1790: case O_TRUNC: 1791: pc.cp++; 1792: push4(TRUNC(pop8())); 1793: continue; 1794: default: 1795: ERROR("Panic: bad op code\n"); 1796: continue; 1797: } 1798: } 1799: }