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