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