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