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