/* * Copyright (c) 1980 Regents of the University of California. * All rights reserved. The Berkeley software License Agreement * specifies the terms and conditions for redistribution. */ #ifndef lint static char sccsid[] = "@(#)interp.c 5.3 (Berkeley) 9/18/85"; #endif not lint #include #include #include "whoami.h" #include "vars.h" #include "objfmt.h" #include "h02opcs.h" #include "machdep.h" #include "libpc.h" /* * program variables */ union display _display; struct dispsave *_dp; long _lino = 0; int _argc; char **_argv; long _mode; long _runtst = (long)TRUE; bool _nodump = FALSE; long _stlim = 500000; long _stcnt = 0; long _seed = 1; #ifdef ADDR32 char *_minptr = (char *)0x7fffffff; #endif ADDR32 #ifdef ADDR16 char *_minptr = (char *)0xffff; #endif ADDR16 char *_maxptr = (char *)0; long *_pcpcount = (long *)0; long _cntrs = 0; long _rtns = 0; /* * standard files */ char _inwin, _outwin, _errwin; struct iorechd _err = { &_errwin, /* fileptr */ 0, /* lcount */ 0x7fffffff, /* llimit */ &_iob[2], /* fbuf */ FILNIL, /* fchain */ STDLVL, /* flev */ "Message file", /* pfname */ FTEXT | FWRITE | EOFF, /* funit */ 2, /* fblk */ 1 /* fsize */ }; struct iorechd output = { &_outwin, /* fileptr */ 0, /* lcount */ 0x7fffffff, /* llimit */ &_iob[1], /* fbuf */ ERR, /* fchain */ STDLVL, /* flev */ "standard output", /* pfname */ FTEXT | FWRITE | EOFF, /* funit */ 1, /* fblk */ 1 /* fsize */ }; struct iorechd input = { &_inwin, /* fileptr */ 0, /* lcount */ 0x7fffffff, /* llimit */ &_iob[0], /* fbuf */ OUTPUT, /* fchain */ STDLVL, /* flev */ "standard input", /* pfname */ FTEXT|FREAD|SYNC|EOLN, /* funit */ 0, /* fblk */ 1 /* fsize */ }; /* * file record variables */ long _filefre = PREDEF; struct iorechd _fchain = { 0, 0, 0, 0, /* only use fchain field */ INPUT /* fchain */ }; struct iorec *_actfile[MAXFILES] = { INPUT, OUTPUT, ERR }; /* * stuff for pdx */ union progcntr *pcaddrp; asm(".globl _loopaddr"); /* * Px profile array */ #ifdef PROFILE long _profcnts[NUMOPS]; #endif PROFILE /* * debugging variables */ #ifdef DEBUG char opc[10]; long opcptr = 9; #endif DEBUG interpreter(base) char *base; { union progcntr pc; /* interpreted program cntr */ register char *vpc; /* register used for "pc" */ struct iorec *curfile; /* active file */ register struct blockmark *stp; /* active stack frame ptr */ /* * the following variables are used as scratch */ register char *tcp; register short *tsp; register long tl, tl1, tl2; double td, td1; struct sze8 t8; register short *tsp1; long *tlp, tl3; char *tcp1; bool tb; struct blockmark *tstp; register struct formalrtn *tfp; union progcntr tpc; struct iorec **ip; int mypid; pcaddrp = &pc; mypid = getpid(); /* * Setup sets up any hardware specific parameters before * starting the interpreter. Typically this is inline replaced * by interp.sed to utilize specific machine instructions. */ setup(); /* * necessary only on systems which do not initialize * memory to zero */ for (ip = &_actfile[3]; ip < &_actfile[MAXFILES]; *ip++ = FILNIL) /* void */; /* * set up global environment, then ``call'' the main program */ _display.frame[0].locvars = pushsp((long)(2 * sizeof(struct iorec *))); _display.frame[0].locvars += 2 * sizeof(struct iorec *); *(struct iorec **)(_display.frame[0].locvars + OUTPUT_OFF) = OUTPUT; *(struct iorec **)(_display.frame[0].locvars + INPUT_OFF) = INPUT; stp = (struct blockmark *)pushsp((long)(sizeof(struct blockmark))); _dp = &_display.frame[0]; pc.cp = base; asm("_loopaddr:"); for(;;) { # ifdef DEBUG if (++opcptr == 10) opcptr = 0; opc[opcptr] = *pc.ucp; # endif DEBUG # ifdef PROFILE _profcnts[*pc.ucp]++; # endif PROFILE switch (*pc.ucp++) { case O_BPT: /* breakpoint trap */ PFLUSH(); kill(mypid, SIGILL); pc.ucp--; continue; case O_NODUMP: _nodump = TRUE; /* and fall through */ case O_BEG: _dp += 1; /* enter local scope */ stp->odisp = *_dp; /* save old display value */ tl = *pc.ucp++; /* tl = name size */ stp->entry = pc.hdrp; /* pointer to entry info */ tl1 = pc.hdrp->framesze;/* tl1 = size of frame */ _lino = pc.hdrp->offset; _runtst = pc.hdrp->tests; disableovrflo(); if (_runtst) enableovrflo(); pc.cp += (int)tl; /* skip over proc hdr info */ stp->file = curfile; /* save active file */ tcp = pushsp(tl1); /* tcp = new top of stack */ if (_runtst) /* zero stack frame */ blkclr(tcp, tl1); tcp += (int)tl1; /* offsets of locals are neg */ _dp->locvars = tcp; /* set new display pointer */ _dp->stp = stp; stp->tos = pushsp((long)0); /* set tos pointer */ continue; case O_END: PCLOSE(_dp->locvars); /* flush & close local files */ stp = _dp->stp; curfile = stp->file; /* restore old active file */ *_dp = stp->odisp; /* restore old display entry */ if (_dp == &_display.frame[1]) return; /* exiting main proc ??? */ _lino = stp->lino; /* restore lino, pc, dp */ pc.cp = stp->pc; _dp = stp->dp; _runtst = stp->entry->tests; disableovrflo(); if (_runtst) enableovrflo(); popsp(stp->entry->framesze + /* pop local vars */ sizeof(struct blockmark) + /* pop stack frame */ stp->entry->nargs); /* pop parms */ continue; case O_CALL: tl = *pc.cp++; tcp = base + *pc.lp++;/* calc new entry point */ tcp += sizeof(short); tcp = base + *(long *)tcp; stp = (struct blockmark *) pushsp((long)(sizeof(struct blockmark))); stp->lino = _lino; /* save lino, pc, dp */ stp->pc = pc.cp; stp->dp = _dp; _dp = &_display.frame[tl]; /* set up new display ptr */ pc.cp = tcp; continue; case O_FCALL: pc.cp++; tcp = popaddr(); /* ptr to display save area */ tfp = (struct formalrtn *)popaddr(); stp = (struct blockmark *) pushsp((long)(sizeof(struct blockmark))); stp->lino = _lino; /* save lino, pc, dp */ stp->pc = pc.cp; stp->dp = _dp; pc.cp = (char *)(tfp->fentryaddr);/* new entry point */ _dp = &_display.frame[tfp->fbn];/* new display ptr */ blkcpy(&_display.frame[1], tcp, tfp->fbn * sizeof(struct dispsave)); blkcpy(&tfp->fdisp[0], &_display.frame[1], tfp->fbn * sizeof(struct dispsave)); continue; case O_FRTN: tl = *pc.cp++; /* tl = size of return obj */ if (tl == 0) tl = *pc.usp++; tcp = pushsp((long)(0)); tfp = *(struct formalrtn **)(tcp + tl); tcp1 = *(char **) (tcp + tl + sizeof(struct formalrtn *)); if (tl != 0) { blkcpy(tcp, tcp + sizeof(struct formalrtn *) + sizeof(char *), tl); } popsp((long) (sizeof(struct formalrtn *) + sizeof (char *))); blkcpy(tcp1, &_display.frame[1], tfp->fbn * sizeof(struct dispsave)); continue; case O_FSAV: tfp = (struct formalrtn *)popaddr(); tfp->fbn = *pc.cp++; /* blk number of routine */ tcp = base + *pc.lp++; /* calc new entry point */ tcp += sizeof(short); tfp->fentryaddr = (long (*)())(base + *(long *)tcp); blkcpy(&_display.frame[1], &tfp->fdisp[0], tfp->fbn * sizeof(struct dispsave)); pushaddr(tfp); continue; case O_SDUP2: pc.cp++; tl = pop2(); push2((short)(tl)); push2((short)(tl)); continue; case O_SDUP4: pc.cp++; tl = pop4(); push4(tl); push4(tl); continue; case O_TRA: pc.cp++; pc.cp += *pc.sp; continue; case O_TRA4: pc.cp++; pc.cp = base + *pc.lp; continue; case O_GOTO: tstp = _display.frame[*pc.cp++].stp; /* ptr to exit frame */ pc.cp = base + *pc.lp; stp = _dp->stp; while (tstp != stp) { if (_dp == &_display.frame[1]) ERROR("Active frame not found in non-local goto\n", 0); /* exiting prog ??? */ PCLOSE(_dp->locvars); /* close local files */ curfile = stp->file; /* restore active file */ *_dp = stp->odisp; /* old display entry */ _dp = stp->dp; /* restore dp */ stp = _dp->stp; } /* pop locals, stack frame, parms, and return values */ popsp((long)(stp->tos - pushsp((long)(0)))); continue; case O_LINO: if (_dp->stp->tos != pushsp((long)(0))) ERROR("Panic: stack not empty between statements\n"); _lino = *pc.cp++; /* set line number */ if (_lino == 0) _lino = *pc.sp++; if (_runtst) { LINO(); /* inc statement count */ continue; } _stcnt++; continue; case O_PUSH: tl = *pc.cp++; if (tl == 0) tl = *pc.lp++; tl = (-tl + 1) & ~1; tcp = pushsp(tl); if (_runtst) blkclr(tcp, tl); continue; case O_IF: pc.cp++; if (pop2()) { pc.sp++; continue; } pc.cp += *pc.sp; continue; case O_REL2: tl = pop2(); tl1 = pop2(); goto cmplong; case O_REL24: tl = pop2(); tl1 = pop4(); goto cmplong; case O_REL42: tl = pop4(); tl1 = pop2(); goto cmplong; case O_REL4: tl = pop4(); tl1 = pop4(); cmplong: switch (*pc.cp++) { case releq: push2(tl1 == tl); continue; case relne: push2(tl1 != tl); continue; case rellt: push2(tl1 < tl); continue; case relgt: push2(tl1 > tl); continue; case relle: push2(tl1 <= tl); continue; case relge: push2(tl1 >= tl); continue; default: ERROR("Panic: bad relation %d to REL4*\n", *(pc.cp - 1)); continue; } case O_RELG: tl2 = *pc.cp++; /* tc has jump opcode */ tl = *pc.usp++; /* tl has comparison length */ tl1 = (tl + 1) & ~1; /* tl1 has arg stack length */ tcp = pushsp((long)(0));/* tcp pts to first arg */ switch (tl2) { case releq: tb = RELEQ(tl, tcp + tl1, tcp); break; case relne: tb = RELNE(tl, tcp + tl1, tcp); break; case rellt: tb = RELSLT(tl, tcp + tl1, tcp); break; case relgt: tb = RELSGT(tl, tcp + tl1, tcp); break; case relle: tb = RELSLE(tl, tcp + tl1, tcp); break; case relge: tb = RELSGE(tl, tcp + tl1, tcp); break; default: ERROR("Panic: bad relation %d to RELG*\n", tl2); break; } popsp(tl1 << 1); push2((short)(tb)); continue; case O_RELT: tl2 = *pc.cp++; /* tc has jump opcode */ tl1 = *pc.usp++; /* tl1 has comparison length */ tcp = pushsp((long)(0));/* tcp pts to first arg */ switch (tl2) { case releq: tb = RELEQ(tl1, tcp + tl1, tcp); break; case relne: tb = RELNE(tl1, tcp + tl1, tcp); break; case rellt: tb = RELTLT(tl1, tcp + tl1, tcp); break; case relgt: tb = RELTGT(tl1, tcp + tl1, tcp); break; case relle: tb = RELTLE(tl1, tcp + tl1, tcp); break; case relge: tb = RELTGE(tl1, tcp + tl1, tcp); break; default: ERROR("Panic: bad relation %d to RELT*\n", tl2); break; } popsp(tl1 << 1); push2((short)(tb)); continue; case O_REL28: td = pop2(); td1 = pop8(); goto cmpdbl; case O_REL48: td = pop4(); td1 = pop8(); goto cmpdbl; case O_REL82: td = pop8(); td1 = pop2(); goto cmpdbl; case O_REL84: td = pop8(); td1 = pop4(); goto cmpdbl; case O_REL8: td = pop8(); td1 = pop8(); cmpdbl: switch (*pc.cp++) { case releq: push2(td1 == td); continue; case relne: push2(td1 != td); continue; case rellt: push2(td1 < td); continue; case relgt: push2(td1 > td); continue; case relle: push2(td1 <= td); continue; case relge: push2(td1 >= td); continue; default: ERROR("Panic: bad relation %d to REL8*\n", *(pc.cp - 1)); continue; } case O_AND: pc.cp++; tl = pop2(); tl1 = pop2(); push2(tl1 & tl); continue; case O_OR: pc.cp++; tl = pop2(); tl1 = pop2(); push2(tl1 | tl); continue; case O_NOT: pc.cp++; tl = pop2(); push2(tl ^ 1); continue; case O_AS2: pc.cp++; tl = pop2(); *(short *)popaddr() = tl; continue; case O_AS4: pc.cp++; tl = pop4(); *(long *)popaddr() = tl; continue; case O_AS24: pc.cp++; tl = pop2(); *(long *)popaddr() = tl; continue; case O_AS42: pc.cp++; tl = pop4(); *(short *)popaddr() = tl; continue; case O_AS21: pc.cp++; tl = pop2(); *popaddr() = tl; continue; case O_AS41: pc.cp++; tl = pop4(); *popaddr() = tl; continue; case O_AS28: pc.cp++; tl = pop2(); *(double *)popaddr() = tl; continue; case O_AS48: pc.cp++; tl = pop4(); *(double *)popaddr() = tl; continue; case O_AS8: pc.cp++; t8 = popsze8(); *(struct sze8 *)popaddr() = t8; continue; case O_AS: tl = *pc.cp++; if (tl == 0) tl = *pc.usp++; tl1 = (tl + 1) & ~1; tcp = pushsp((long)(0)); blkcpy(tcp, *(char **)(tcp + tl1), tl); popsp(tl1 + sizeof(char *)); continue; case O_VAS: pc.cp++; tl = pop4(); tcp1 = popaddr(); tcp = popaddr(); blkcpy(tcp1, tcp, tl); continue; case O_INX2P2: tl = *pc.cp++; /* tl has shift amount */ tl1 = pop2(); tl1 = (tl1 - *pc.sp++) << tl; tcp = popaddr(); pushaddr(tcp + tl1); continue; case O_INX4P2: tl = *pc.cp++; /* tl has shift amount */ tl1 = pop4(); tl1 = (tl1 - *pc.sp++) << tl; tcp = popaddr(); pushaddr(tcp + tl1); continue; case O_INX2: tl = *pc.cp++; /* tl has element size */ if (tl == 0) tl = *pc.usp++; tl1 = pop2(); /* index */ tl2 = *pc.sp++; tcp = popaddr(); pushaddr(tcp + (tl1 - tl2) * tl); tl = *pc.usp++; if (_runtst) SUBSC(tl1, tl2, tl); /* range check */ continue; case O_INX4: tl = *pc.cp++; /* tl has element size */ if (tl == 0) tl = *pc.usp++; tl1 = pop4(); /* index */ tl2 = *pc.sp++; tcp = popaddr(); pushaddr(tcp + (tl1 - tl2) * tl); tl = *pc.usp++; if (_runtst) SUBSC(tl1, tl2, tl); /* range check */ continue; case O_VINX2: pc.cp++; tl = pop2(); /* tl has element size */ tl1 = pop2(); /* upper bound */ tl2 = pop2(); /* lower bound */ tl3 = pop2(); /* index */ tcp = popaddr(); pushaddr(tcp + (tl3 - tl2) * tl); if (_runtst) SUBSC(tl3, tl2, tl1); /* range check */ continue; case O_VINX24: pc.cp++; tl = pop2(); /* tl has element size */ tl1 = pop2(); /* upper bound */ tl2 = pop2(); /* lower bound */ tl3 = pop4(); /* index */ tcp = popaddr(); pushaddr(tcp + (tl3 - tl2) * tl); if (_runtst) SUBSC(tl3, tl2, tl1); /* range check */ continue; case O_VINX42: pc.cp++; tl = pop4(); /* tl has element size */ tl1 = pop4(); /* upper bound */ tl2 = pop4(); /* lower bound */ tl3 = pop2(); /* index */ tcp = popaddr(); pushaddr(tcp + (tl3 - tl2) * tl); if (_runtst) SUBSC(tl3, tl2, tl1); /* range check */ continue; case O_VINX4: pc.cp++; tl = pop4(); /* tl has element size */ tl1 = pop4(); /* upper bound */ tl2 = pop4(); /* lower bound */ tl3 = pop4(); /* index */ tcp = popaddr(); pushaddr(tcp + (tl3 - tl2) * tl); if (_runtst) SUBSC(tl3, tl2, tl1); /* range check */ continue; case O_OFF: tl = *pc.cp++; if (tl == 0) tl = *pc.usp++; tcp = popaddr(); pushaddr(tcp + tl); continue; case O_NIL: pc.cp++; tcp = popaddr(); NIL(tcp); pushaddr(tcp); continue; case O_ADD2: pc.cp++; tl = pop2(); tl1 = pop2(); push4(tl1 + tl); continue; case O_ADD4: pc.cp++; tl = pop4(); tl1 = pop4(); push4(tl1 + tl); continue; case O_ADD24: pc.cp++; tl = pop2(); tl1 = pop4(); push4(tl1 + tl); continue; case O_ADD42: pc.cp++; tl = pop4(); tl1 = pop2(); push4(tl1 + tl); continue; case O_ADD28: pc.cp++; tl = pop2(); td = pop8(); push8(td + tl); continue; case O_ADD48: pc.cp++; tl = pop4(); td = pop8(); push8(td + tl); continue; case O_ADD82: pc.cp++; td = pop8(); td1 = pop2(); push8(td1 + td); continue; case O_ADD84: pc.cp++; td = pop8(); td1 = pop4(); push8(td1 + td); continue; case O_SUB2: pc.cp++; tl = pop2(); tl1 = pop2(); push4(tl1 - tl); continue; case O_SUB4: pc.cp++; tl = pop4(); tl1 = pop4(); push4(tl1 - tl); continue; case O_SUB24: pc.cp++; tl = pop2(); tl1 = pop4(); push4(tl1 - tl); continue; case O_SUB42: pc.cp++; tl = pop4(); tl1 = pop2(); push4(tl1 - tl); continue; case O_SUB28: pc.cp++; tl = pop2(); td = pop8(); push8(td - tl); continue; case O_SUB48: pc.cp++; tl = pop4(); td = pop8(); push8(td - tl); continue; case O_SUB82: pc.cp++; td = pop8(); td1 = pop2(); push8(td1 - td); continue; case O_SUB84: pc.cp++; td = pop8(); td1 = pop4(); push8(td1 - td); continue; case O_MUL2: pc.cp++; tl = pop2(); tl1 = pop2(); push4(tl1 * tl); continue; case O_MUL4: pc.cp++; tl = pop4(); tl1 = pop4(); push4(tl1 * tl); continue; case O_MUL24: pc.cp++; tl = pop2(); tl1 = pop4(); push4(tl1 * tl); continue; case O_MUL42: pc.cp++; tl = pop4(); tl1 = pop2(); push4(tl1 * tl); continue; case O_MUL28: pc.cp++; tl = pop2(); td = pop8(); push8(td * tl); continue; case O_MUL48: pc.cp++; tl = pop4(); td = pop8(); push8(td * tl); continue; case O_MUL82: pc.cp++; td = pop8(); td1 = pop2(); push8(td1 * td); continue; case O_MUL84: pc.cp++; td = pop8(); td1 = pop4(); push8(td1 * td); continue; case O_ABS2: case O_ABS4: pc.cp++; tl = pop4(); push4(tl >= 0 ? tl : -tl); continue; case O_ABS8: pc.cp++; td = pop8(); push8(td >= 0.0 ? td : -td); continue; case O_NEG2: pc.cp++; push4((long)(-pop2())); continue; case O_NEG4: pc.cp++; push4(-pop4()); continue; case O_NEG8: pc.cp++; push8(-pop8()); continue; case O_DIV2: pc.cp++; tl = pop2(); tl1 = pop2(); push4(tl1 / tl); continue; case O_DIV4: pc.cp++; tl = pop4(); tl1 = pop4(); push4(tl1 / tl); continue; case O_DIV24: pc.cp++; tl = pop2(); tl1 = pop4(); push4(tl1 / tl); continue; case O_DIV42: pc.cp++; tl = pop4(); tl1 = pop2(); push4(tl1 / tl); continue; case O_MOD2: pc.cp++; tl = pop2(); tl1 = pop2(); push4(tl1 % tl); continue; case O_MOD4: pc.cp++; tl = pop4(); tl1 = pop4(); push4(tl1 % tl); continue; case O_MOD24: pc.cp++; tl = pop2(); tl1 = pop4(); push4(tl1 % tl); continue; case O_MOD42: pc.cp++; tl = pop4(); tl1 = pop2(); push4(tl1 % tl); continue; case O_ADD8: pc.cp++; td = pop8(); td1 = pop8(); push8(td1 + td); continue; case O_SUB8: pc.cp++; td = pop8(); td1 = pop8(); push8(td1 - td); continue; case O_MUL8: pc.cp++; td = pop8(); td1 = pop8(); push8(td1 * td); continue; case O_DVD8: pc.cp++; td = pop8(); td1 = pop8(); push8(td1 / td); continue; case O_STOI: pc.cp++; push4((long)(pop2())); continue; case O_STOD: pc.cp++; td = pop2(); push8(td); continue; case O_ITOD: pc.cp++; td = pop4(); push8(td); continue; case O_ITOS: pc.cp++; push2((short)(pop4())); continue; case O_DVD2: pc.cp++; td = pop2(); td1 = pop2(); push8(td1 / td); continue; case O_DVD4: pc.cp++; td = pop4(); td1 = pop4(); push8(td1 / td); continue; case O_DVD24: pc.cp++; td = pop2(); td1 = pop4(); push8(td1 / td); continue; case O_DVD42: pc.cp++; td = pop4(); td1 = pop2(); push8(td1 / td); continue; case O_DVD28: pc.cp++; td = pop2(); td1 = pop8(); push8(td1 / td); continue; case O_DVD48: pc.cp++; td = pop4(); td1 = pop8(); push8(td1 / td); continue; case O_DVD82: pc.cp++; td = pop8(); td1 = pop2(); push8(td1 / td); continue; case O_DVD84: pc.cp++; td = pop8(); td1 = pop4(); push8(td1 / td); continue; case O_RV1: tcp = _display.raw[*pc.ucp++]; push2((short)(*(tcp + *pc.sp++))); continue; case O_RV14: tcp = _display.raw[*pc.ucp++]; push4((long)(*(tcp + *pc.sp++))); continue; case O_RV2: tcp = _display.raw[*pc.ucp++]; push2(*(short *)(tcp + *pc.sp++)); continue; case O_RV24: tcp = _display.raw[*pc.ucp++]; push4((long)(*(short *)(tcp + *pc.sp++))); continue; case O_RV4: tcp = _display.raw[*pc.ucp++]; push4(*(long *)(tcp + *pc.sp++)); continue; case O_RV8: tcp = _display.raw[*pc.ucp++]; pushsze8(*(struct sze8 *)(tcp + *pc.sp++)); continue; case O_RV: tcp = _display.raw[*pc.ucp++]; tcp += *pc.sp++; tl = *pc.usp++; tcp1 = pushsp((tl + 1) & ~1); blkcpy(tcp, tcp1, tl); continue; case O_LV: tcp = _display.raw[*pc.ucp++]; pushaddr(tcp + *pc.sp++); continue; case O_LRV1: tcp = _display.raw[*pc.ucp++]; push2((short)(*(tcp + *pc.lp++))); continue; case O_LRV14: tcp = _display.raw[*pc.ucp++]; push4((long)(*(tcp + *pc.lp++))); continue; case O_LRV2: tcp = _display.raw[*pc.ucp++]; push2(*(short *)(tcp + *pc.lp++)); continue; case O_LRV24: tcp = _display.raw[*pc.ucp++]; push4((long)(*(short *)(tcp + *pc.lp++))); continue; case O_LRV4: tcp = _display.raw[*pc.ucp++]; push4(*(long *)(tcp + *pc.lp++)); continue; case O_LRV8: tcp = _display.raw[*pc.ucp++]; pushsze8(*(struct sze8 *)(tcp + *pc.lp++)); continue; case O_LRV: tcp = _display.raw[*pc.ucp++]; tcp += (int)*pc.lp++; tl = *pc.usp++; tcp1 = pushsp((tl + 1) & ~1); blkcpy(tcp, tcp1, tl); continue; case O_LLV: tcp = _display.raw[*pc.ucp++]; pushaddr(tcp + *pc.lp++); continue; case O_IND1: pc.cp++; push2((short)(*popaddr())); continue; case O_IND14: pc.cp++; push4((long)(*popaddr())); continue; case O_IND2: pc.cp++; push2(*(short *)(popaddr())); continue; case O_IND24: pc.cp++; push4((long)(*(short *)(popaddr()))); continue; case O_IND4: pc.cp++; push4(*(long *)(popaddr())); continue; case O_IND8: pc.cp++; pushsze8(*(struct sze8 *)(popaddr())); continue; case O_IND: tl = *pc.cp++; if (tl == 0) tl = *pc.usp++; tcp = popaddr(); tcp1 = pushsp((tl + 1) & ~1); blkcpy(tcp, tcp1, tl); continue; case O_CON1: push2((short)(*pc.cp++)); continue; case O_CON14: push4((long)(*pc.cp++)); continue; case O_CON2: pc.cp++; push2(*pc.sp++); continue; case O_CON24: pc.cp++; push4((long)(*pc.sp++)); continue; case O_CON4: pc.cp++; push4(*pc.lp++); continue; case O_CON8: pc.cp++; push8(*pc.dbp++); continue; case O_CON: tl = *pc.cp++; if (tl == 0) tl = *pc.usp++; tl = (tl + 1) & ~1; tcp = pushsp(tl); blkcpy(pc.cp, tcp, tl); pc.cp += (int)tl; continue; case O_CONG: tl = *pc.cp++; if (tl == 0) tl = *pc.usp++; tl1 = (tl + 1) & ~1; tcp = pushsp(tl1); blkcpy(pc.cp, tcp, tl1); pc.cp += (int)((tl + 2) & ~1); continue; case O_LVCON: tl = *pc.cp++; if (tl == 0) tl = *pc.usp++; tl = (tl + 1) & ~1; pushaddr(pc.cp); pc.cp += (int)tl; continue; case O_RANG2: tl = *pc.cp++; if (tl == 0) tl = *pc.sp++; tl1 = pop2(); push2((short)(RANG4(tl1, tl, (long)(*pc.sp++)))); continue; case O_RANG42: tl = *pc.cp++; if (tl == 0) tl = *pc.sp++; tl1 = pop4(); push4(RANG4(tl1, tl, (long)(*pc.sp++))); continue; case O_RSNG2: tl = *pc.cp++; if (tl == 0) tl = *pc.sp++; tl1 = pop2(); push2((short)(RSNG4(tl1, tl))); continue; case O_RSNG42: tl = *pc.cp++; if (tl == 0) tl = *pc.sp++; tl1 = pop4(); push4(RSNG4(tl1, tl)); continue; case O_RANG4: tl = *pc.cp++; if (tl == 0) tl = *pc.lp++; tl1 = pop4(); push4(RANG4(tl1, tl, *pc.lp++)); continue; case O_RANG24: tl = *pc.cp++; if (tl == 0) tl = *pc.lp++; tl1 = pop2(); push2((short)(RANG4(tl1, tl, *pc.lp++))); continue; case O_RSNG4: tl = *pc.cp++; if (tl == 0) tl = *pc.lp++; tl1 = pop4(); push4(RSNG4(tl1, tl)); continue; case O_RSNG24: tl = *pc.cp++; if (tl == 0) tl = *pc.lp++; tl1 = pop2(); push2((short)(RSNG4(tl1, tl))); continue; case O_STLIM: pc.cp++; STLIM(); popsp((long)(sizeof(long))); continue; case O_LLIMIT: pc.cp++; LLIMIT(); popsp((long)(sizeof(char *)+sizeof(long))); continue; case O_BUFF: BUFF((long)(*pc.cp++)); continue; case O_HALT: pc.cp++; if (_nodump == TRUE) psexit(0); fputs("\nCall to procedure halt\n", stderr); backtrace("Halted"); psexit(0); continue; case O_PXPBUF: pc.cp++; _cntrs = *pc.lp++; _rtns = *pc.lp++; NEW(&_pcpcount, (_cntrs + 1) * sizeof(long)); blkclr(_pcpcount, (_cntrs + 1) * sizeof(long)); continue; case O_COUNT: pc.cp++; _pcpcount[*pc.usp++]++; continue; case O_CASE1OP: tl = *pc.cp++; /* tl = number of cases */ if (tl == 0) tl = *pc.usp++; tsp = pc.sp + tl; /* ptr to end of jump table */ tcp = (char *)tsp; /* tcp = ptr to case values */ tl1 = pop2(); /* tl1 = element to find */ for(; tl > 0; tl--) /* look for element */ if (tl1 == *tcp++) break; if (tl == 0) /* default case => error */ CASERNG(tl1); pc.cp += *(tsp - tl); continue; case O_CASE2OP: tl = *pc.cp++; /* tl = number of cases */ if (tl == 0) tl = *pc.usp++; tsp = pc.sp + tl; /* ptr to end of jump table */ tsp1 = tsp; /* tsp1 = ptr to case values */ tl1 = (unsigned short)pop2();/* tl1 = element to find */ for(; tl > 0; tl--) /* look for element */ if (tl1 == *tsp1++) break; if (tl == 0) /* default case => error */ CASERNG(tl1); pc.cp += *(tsp - tl); continue; case O_CASE4OP: tl = *pc.cp++; /* tl = number of cases */ if (tl == 0) tl = *pc.usp++; tsp = pc.sp + tl; /* ptr to end of jump table */ tlp = (long *)tsp; /* tlp = ptr to case values */ tl1 = pop4(); /* tl1 = element to find */ for(; tl > 0; tl--) /* look for element */ if (tl1 == *tlp++) break; if (tl == 0) /* default case => error */ CASERNG(tl1); pc.cp += *(tsp - tl); continue; case O_ADDT: tl = *pc.cp++; /* tl has comparison length */ if (tl == 0) tl = *pc.usp++; tcp = pushsp((long)(0));/* tcp pts to first arg */ ADDT(tcp + tl, tcp + tl, tcp, tl >> 2); popsp(tl); continue; case O_SUBT: tl = *pc.cp++; /* tl has comparison length */ if (tl == 0) tl = *pc.usp++; tcp = pushsp((long)(0));/* tcp pts to first arg */ SUBT(tcp + tl, tcp + tl, tcp, tl >> 2); popsp(tl); continue; case O_MULT: tl = *pc.cp++; /* tl has comparison length */ if (tl == 0) tl = *pc.usp++; tcp = pushsp((long)(0));/* tcp pts to first arg */ MULT(tcp + tl, tcp + tl, tcp, tl >> 2); popsp(tl); continue; case O_INCT: tl = *pc.cp++; /* tl has number of args */ if (tl == 0) tl = *pc.usp++; tb = INCT(); popsp(tl*sizeof(long)); push2((short)(tb)); continue; case O_CTTOT: tl = *pc.cp++; /* tl has number of args */ if (tl == 0) tl = *pc.usp++; tl1 = tl * sizeof(long); tcp = pushsp((long)(0)) + tl1; /* tcp pts to result */ CTTOT(tcp); popsp(tl*sizeof(long)); continue; case O_CARD: tl = *pc.cp++; /* tl has comparison length */ if (tl == 0) tl = *pc.usp++; tcp = pushsp((long)(0));/* tcp pts to set */ tl1 = CARD(tcp, tl); popsp(tl); push2((short)(tl1)); continue; case O_IN: tl = *pc.cp++; /* tl has comparison length */ if (tl == 0) tl = *pc.usp++; tl1 = pop4(); /* tl1 is the element */ tcp = pushsp((long)(0));/* tcp pts to set */ tl2 = *pc.sp++; /* lower bound */ tb = IN(tl1, tl2, (long)(*pc.usp++), tcp); popsp(tl); push2((short)(tb)); continue; case O_ASRT: pc.cp++; tl = pop4(); tcp = popaddr(); ASRTS(tl, tcp); continue; case O_FOR1U: tl1 = *pc.cp++; /* tl1 loop branch */ if (tl1 == 0) tl1 = *pc.sp++; tcp = popaddr(); /* tcp = ptr to index var */ tl = pop4(); /* tl upper bound */ if (*tcp == tl) /* loop is done, fall through */ continue; *tcp += 1; /* inc index var */ pc.cp += tl1; /* return to top of loop */ continue; case O_FOR2U: tl1 = *pc.cp++; /* tl1 loop branch */ if (tl1 == 0) tl1 = *pc.sp++; tsp = (short *)popaddr(); /* tsp = ptr to index var */ tl = pop4(); /* tl upper bound */ if (*tsp == tl) /* loop is done, fall through */ continue; *tsp += 1; /* inc index var */ pc.cp += tl1; /* return to top of loop */ continue; case O_FOR4U: tl1 = *pc.cp++; /* tl1 loop branch */ if (tl1 == 0) tl1 = *pc.sp++; tlp = (long *)popaddr(); /* tlp = ptr to index var */ tl = pop4(); /* tl upper bound */ if (*tlp == tl) /* loop is done, fall through */ continue; *tlp += 1; /* inc index var */ pc.cp += tl1; /* return to top of loop */ continue; case O_FOR1D: tl1 = *pc.cp++; /* tl1 loop branch */ if (tl1 == 0) tl1 = *pc.sp++; tcp = popaddr(); /* tcp = ptr to index var */ tl = pop4(); /* tl upper bound */ if (*tcp == tl) /* loop is done, fall through */ continue; *tcp -= 1; /* dec index var */ pc.cp += tl1; /* return to top of loop */ continue; case O_FOR2D: tl1 = *pc.cp++; /* tl1 loop branch */ if (tl1 == 0) tl1 = *pc.sp++; tsp = (short *)popaddr(); /* tsp = ptr to index var */ tl = pop4(); /* tl upper bound */ if (*tsp == tl) /* loop is done, fall through */ continue; *tsp -= 1; /* dec index var */ pc.cp += tl1; /* return to top of loop */ continue; case O_FOR4D: tl1 = *pc.cp++; /* tl1 loop branch */ if (tl1 == 0) tl1 = *pc.sp++; tlp = (long *)popaddr(); /* tlp = ptr to index var */ tl = pop4(); /* tl upper bound */ if (*tlp == tl) /* loop is done, fall through */ continue; *tlp -= 1; /* dec index var */ pc.cp += tl1; /* return to top of loop */ continue; case O_READE: pc.cp++; push2((short)(READE(curfile, base + *pc.lp++))); continue; case O_READ4: pc.cp++; push4(READ4(curfile)); continue; case O_READC: pc.cp++; push2((short)(READC(curfile))); continue; case O_READ8: pc.cp++; push8(READ8(curfile)); continue; case O_READLN: pc.cp++; READLN(curfile); continue; case O_EOF: pc.cp++; push2((short)(TEOF(popaddr()))); continue; case O_EOLN: pc.cp++; push2((short)(TEOLN(popaddr()))); continue; case O_WRITEC: if (_runtst) { WRITEC(curfile); popsp((long)(*pc.cp++)); continue; } tl = *pc.cp++; switch (tl - sizeof(FILE *)) { case 2: tl1 = pop2(); break; case 4: tl1 = pop4(); break; default: ERROR("Panic: bad size to O_WRITEC"); /* NOT REACHED */ } tcp = popaddr(); fputc(tl1, tcp); continue; case O_WRITES: if (_runtst) { WRITES(curfile); popsp((long)(*pc.cp++)); continue; } fwrite(); popsp((long)(*pc.cp++)); continue; case O_WRITEF: if (_runtst) { WRITEF(curfile); popsp((long)(*pc.cp++)); continue; } fprintf(); popsp((long)(*pc.cp++)); continue; case O_WRITLN: pc.cp++; if (_runtst) { WRITLN(curfile); continue; } fputc('\n', ACTFILE(curfile)); continue; case O_PAGE: pc.cp++; if (_runtst) { PAGE(curfile); continue; } fputc(' ', ACTFILE(curfile)); continue; case O_NAM: pc.cp++; tl = pop4(); pushaddr(NAM(tl, base + *pc.lp++)); continue; case O_MAX: tl = *pc.cp++; if (tl == 0) tl = *pc.usp++; tl1 = pop4(); if (_runtst) { push4(MAX(tl1, tl, (long)(*pc.usp++))); continue; } tl1 -= tl; tl = *pc.usp++; push4(tl1 > tl ? tl1 : tl); continue; case O_MIN: tl = *pc.cp++; if (tl == 0) tl = *pc.usp++; tl1 = pop4(); push4(tl1 < tl ? tl1 : tl); continue; case O_UNIT: pc.cp++; curfile = UNIT(popaddr()); continue; case O_UNITINP: pc.cp++; curfile = INPUT; continue; case O_UNITOUT: pc.cp++; curfile = OUTPUT; continue; case O_MESSAGE: pc.cp++; PFLUSH(); curfile = ERR; continue; case O_PUT: pc.cp++; PUT(curfile); continue; case O_GET: pc.cp++; GET(curfile); continue; case O_FNIL: pc.cp++; pushaddr(FNIL(popaddr())); continue; case O_DEFNAME: pc.cp++; DEFNAME(); popsp((long)(2*sizeof(char *)+2*sizeof(long))); continue; case O_RESET: pc.cp++; RESET(); popsp((long)(2*sizeof(char *)+2*sizeof(long))); continue; case O_REWRITE: pc.cp++; REWRITE(); popsp((long)(2*sizeof(char *)+2*sizeof(long))); continue; case O_FILE: pc.cp++; pushaddr(ACTFILE(curfile)); continue; case O_REMOVE: pc.cp++; REMOVE(); popsp((long)(sizeof(char *)+sizeof(long))); continue; case O_FLUSH: pc.cp++; FLUSH(); popsp((long)(sizeof(char *))); continue; case O_PACK: pc.cp++; PACK(); popsp((long)(5*sizeof(long)+2*sizeof(char*))); continue; case O_UNPACK: pc.cp++; UNPACK(); popsp((long)(5*sizeof(long)+2*sizeof(char*))); continue; case O_ARGC: pc.cp++; push4((long)_argc); continue; case O_ARGV: tl = *pc.cp++; /* tl = size of char array */ if (tl == 0) tl = *pc.usp++; tcp = popaddr(); /* tcp = addr of char array */ tl1 = pop4(); /* tl1 = argv subscript */ ARGV(tl1, tcp, tl); continue; case O_CLCK: pc.cp++; push4(CLCK()); continue; case O_WCLCK: pc.cp++; push4(time(0)); continue; case O_SCLCK: pc.cp++; push4(SCLCK()); continue; case O_NEW: tl = *pc.cp++; /* tl = size being new'ed */ if (tl == 0) tl = *pc.usp++; tcp = popaddr(); /* ptr to ptr being new'ed */ NEW(tcp, tl); if (_runtst) { blkclr(*((char **)(tcp)), tl); } continue; case O_DISPOSE: tl = *pc.cp++; /* tl = size being disposed */ if (tl == 0) tl = *pc.usp++; tcp = popaddr(); /* ptr to ptr being disposed */ DISPOSE(tcp, tl); *(char **)tcp = (char *)0; continue; case O_DFDISP: tl = *pc.cp++; /* tl = size being disposed */ if (tl == 0) tl = *pc.usp++; tcp = popaddr(); /* ptr to ptr being disposed */ DFDISPOSE(tcp, tl); *(char **)tcp = (char *)0; continue; case O_DATE: pc.cp++; DATE(popaddr()); continue; case O_TIME: pc.cp++; TIME(popaddr()); continue; case O_UNDEF: pc.cp++; pop8(); push2((short)(0)); continue; case O_ATAN: pc.cp++; if (_runtst) { push8(ATAN(pop8())); continue; } push8(atan(pop8())); continue; case O_COS: pc.cp++; if (_runtst) { push8(COS(pop8())); continue; } push8(cos(pop8())); continue; case O_EXP: pc.cp++; if (_runtst) { push8(EXP(pop8())); continue; } push8(exp(pop8())); continue; case O_LN: pc.cp++; if (_runtst) { push8(LN(pop8())); continue; } push8(log(pop8())); continue; case O_SIN: pc.cp++; if (_runtst) { push8(SIN(pop8())); continue; } push8(sin(pop8())); continue; case O_SQRT: pc.cp++; if (_runtst) { push8(SQRT(pop8())); continue; } push8(sqrt(pop8())); continue; case O_CHR2: case O_CHR4: pc.cp++; if (_runtst) { push2((short)(CHR(pop4()))); continue; } push2((short)(pop4())); continue; case O_ODD2: case O_ODD4: pc.cp++; tl = pop4(); push2((short)(tl & 1)); continue; case O_SUCC2: tl = *pc.cp++; if (tl == 0) tl = *pc.sp++; tl1 = pop4(); if (_runtst) { push2((short)(SUCC(tl1, tl, (long)(*pc.sp++)))); continue; } push2((short)(tl1 + 1)); pc.sp++; continue; case O_SUCC24: tl = *pc.cp++; if (tl == 0) tl = *pc.sp++; tl1 = pop4(); if (_runtst) { push4(SUCC(tl1, tl, (long)(*pc.sp++))); continue; } push4(tl1 + 1); pc.sp++; continue; case O_SUCC4: tl = *pc.cp++; if (tl == 0) tl = *pc.lp++; tl1 = pop4(); if (_runtst) { push4(SUCC(tl1, tl, (long)(*pc.lp++))); continue; } push4(tl1 + 1); pc.lp++; continue; case O_PRED2: tl = *pc.cp++; if (tl == 0) tl = *pc.sp++; tl1 = pop4(); if (_runtst) { push2((short)(PRED(tl1, tl, (long)(*pc.sp++)))); continue; } push2((short)(tl1 - 1)); pc.sp++; continue; case O_PRED24: tl = *pc.cp++; if (tl == 0) tl = *pc.sp++; tl1 = pop4(); if (_runtst) { push4(PRED(tl1, tl, (long)(*pc.sp++))); continue; } push4(tl1 - 1); pc.sp++; continue; case O_PRED4: tl = *pc.cp++; if (tl == 0) tl = *pc.lp++; tl1 = pop4(); if (_runtst) { push4(PRED(tl1, tl, (long)(*pc.lp++))); continue; } push4(tl1 - 1); pc.lp++; continue; case O_SEED: pc.cp++; push4(SEED(pop4())); continue; case O_RANDOM: pc.cp++; push8(RANDOM(pop8())); continue; case O_EXPO: pc.cp++; push4(EXPO(pop8())); continue; case O_SQR2: case O_SQR4: pc.cp++; tl = pop4(); push4(tl * tl); continue; case O_SQR8: pc.cp++; td = pop8(); push8(td * td); continue; case O_ROUND: pc.cp++; push4(ROUND(pop8())); continue; case O_TRUNC: pc.cp++; push4(TRUNC(pop8())); continue; default: ERROR("Panic: bad op code\n"); continue; } } }