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