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