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