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