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