|
|
1.1 ! root 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: }
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.