/* Copyright (c) 1979 Regents of the University of California */
-static char sccsid[] = "@(#)interp.c 1.1 %G%";
+static char sccsid[] = "@(#)interp.c 1.8 %G%";
#include <math.h>
#include "vars.h"
#include "h01errs.h"
#include "libpc.h"
-/* debugging variables */
-char opc[10];
-long opcptr = 9;
-
/*
* program variables
*/
-struct disp _display[MAXLVL];
+union disply _display;
struct disp *_dp;
long _lino = 0;
int _argc;
char **_argv;
long _mode;
-long _nodump;
+long _runtst = TRUE;
+long _nodump = FALSE;
long _stlim = 500000;
long _stcnt = 0;
+long _seed = 1;
char *_minptr = (char *)0x7fffffff;
char *_maxptr = (char *)0;
long *_pcpcount = (long *)0;
1 /* fsize */
};
+/*
+ * Px profile array
+ */
+#ifdef PROFILE
+long _profcnts[NUMOPS];
+#endif PROFILE
+
+/*
+ * debugging variables
+ */
+#ifdef DEBUG
+char opc[10];
+long opcptr = 9;
+#endif DEBUG
+\f
interpreter(base)
char *base;
{
/*
* the following variables are used as scratch
*/
- double td, td1;
+ register char *tcp;
register long tl, tl1, tl2;
+ double td, td1;
+ struct sze8 t8;
long *tlp;
short *tsp, *tsp1;
- register char *tcp;
char *tcp1;
struct stack *tstp;
struct formalrtn *tfp;
union progcntr tpc;
struct iorec **ip;
+ /*
+ * 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
/*
* set up global environment, then ``call'' the main program
*/
- _display[0].locvars = pushsp(2 * sizeof(struct iorec *));
- *(struct iorec **)(_display[0].locvars + 4) = OUTPUT;
- *(struct iorec **)(_display[0].locvars) = INPUT;
- _display[0].locvars += 8; /* >>> kludge <<< */
- asm(" bispsw $0xe0"); /* enable overflow traps */
+ _display.frame[0].locvars = pushsp(2 * sizeof(struct iorec *));
+ _display.frame[0].locvars += 8; /* local offsets are negative */
+ *(struct iorec **)(_display.frame[0].locvars - 4) = OUTPUT;
+ *(struct iorec **)(_display.frame[0].locvars - 8) = INPUT;
stp = (struct stack *)pushsp(sizeof(struct stack));
- _dp = &_display[0];
+ _dp = &_display.frame[0];
pc.cp = base;
for(;;) {
+# ifdef DEBUG
if (++opcptr == 10)
opcptr = 0;
opc[opcptr] = *pc.ucp;
+# endif DEBUG
+# ifdef PROFILE
+ _profcnts[*pc.ucp]++;
+# endif PROFILE
switch (*pc.ucp++) {
default:
panic(PBADOP);
continue;
case O_NODUMP:
- _nodump++;
- asm(" bicpsw $0xe0");/* disable overflow checks */
+ _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.lp++; /* tl1 = local variable size */
- pc.lp++; /* skip over number of args */
- _lino = *pc.usp++; /* set new lino */
- pc.cp += tl; /* skip over name text */
+ tl1 = pc.hdrp->framesze;/* tl1 = size of frame */
+ _lino = pc.hdrp->offset;
+ _runtst = pc.hdrp->tests;
+ disableovrflo();
+ if (_runtst)
+ enableovrflo();
+ pc.cp += tl; /* skip over proc hdr info */
stp->file = curfile; /* save active file */
tcp = pushsp(tl1); /* tcp = new top of stack */
blkclr(tl1, tcp); /* zero stack frame */
+ tcp += tl1; /* offsets of locals are neg */
+ _dp->locvars = tcp; /* set new display pointer */
+ _dp->stp = stp;
stp->tos = pushsp(0); /* set top of stack pointer */
- _dp->stp = stp; /* set new display pointer */
- /* _dp->locvars = tcp; */
- _dp->locvars = (char *)stp; /* kludge, use prev line */
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[1])
+ if (_dp == &_display.frame[1])
return; /* exiting main proc ??? */
_lino = stp->lino; /* restore lino, pc, dp */
pc.cp = stp->pc.cp;
_dp = stp->dp;
- popsp(-stp->entry->framesze + /* pop local vars */
+ _runtst = stp->entry->tests;
+ disableovrflo();
+ if (_runtst)
+ enableovrflo();
+ popsp(stp->entry->framesze + /* pop local vars */
sizeof(struct stack) + /* pop stack frame */
stp->entry->nargs); /* pop parms */
continue;
stp->lino = _lino; /* save lino, pc, dp */
stp->pc.cp = pc.cp;
stp->dp = _dp;
- _dp = &_display[tl]; /* set up new display ptr */
+ _dp = &_display.frame[tl]; /* set up new display ptr */
pc.cp = tcp;
continue;
case O_FCALL:
stp->pc.cp = pc.cp;
stp->dp = _dp;
pc.cp = tfp->entryaddr; /* calc new entry point */
- tpc.sp = pc.sp + 1;
- tl -= tpc.hdrp->nargs;
- if (tl != 0) {
- if (tl > 0)
- tl += sizeof(int) - 1;
- else
- tl -= sizeof(int) - 1;
- ERROR(ENARGS, tl / sizeof(int));
+ if (_runtst) {
+ tpc.sp = pc.sp + 1;
+ tl -= tpc.hdrp->nargs;
+ if (tl != 0) {
+ if (tl > 0)
+ tl += sizeof(int) - 1;
+ else
+ tl -= sizeof(int) - 1;
+ ERROR(ENARGS, tl / sizeof(int));
+ }
}
- _dp = &_display[tfp->cbn];/* set up new display ptr */
+ _dp = &_display.frame[tfp->cbn];/* new display ptr */
blkcpy(sizeof(struct disp) * tfp->cbn,
- &_display[1], &tfp->disp[tfp->cbn]);
+ &_display.frame[1], &tfp->disp[tfp->cbn]);
blkcpy(sizeof(struct disp) * tfp->cbn,
- &tfp->disp[0], &_display[1]);
+ &tfp->disp[0], &_display.frame[1]);
continue;
case O_FRTN:
tl = *pc.cp++; /* tl = size of return obj */
blkcpy(tl, tcp, tcp + sizeof(struct formalrtn *));
popsp(sizeof(struct formalrtn *));
blkcpy(sizeof(struct disp) * tfp->cbn,
- &tfp->disp[tfp->cbn], &_display[1]);
+ &tfp->disp[tfp->cbn], &_display.frame[1]);
continue;
case O_FSAV:
tfp = (struct formalrtn *)popaddr();
tcp += sizeof(short);
tfp->entryaddr = base + *(long *)tcp;
blkcpy(sizeof(struct disp) * tfp->cbn,
- &_display[1], &tfp->disp[0]);
+ &_display.frame[1], &tfp->disp[0]);
pushaddr(tfp);
continue;
case O_SDUP2:
pc.cp = base + *pc.lp;
continue;
case O_GOTO:
- tstp = _display[*pc.cp++].stp; /* ptr to exit frame */
+ tstp = _display.frame[*pc.cp++].stp; /* ptr to
+ exit frame */
pc.cp = base + *pc.lp;
stp = _dp->stp;
while (tstp != stp) {
- if (_dp == &_display[1])
+ if (_dp == &_display.frame[1])
ERROR(EGOTO); /* exiting prog ??? */
PCLOSE(_dp->locvars); /* close local files */
curfile = stp->file; /* restore active file */
continue;
case O_IF:
pc.cp++;
- if (pop2())
+ if (pop2()) {
pc.sp++;
- else
- pc.cp += *pc.sp;
+ continue;
+ }
+ pc.cp += *pc.sp;
continue;
case O_REL2:
tl = pop2();
continue;
case O_AS8:
pc.cp++;
- td = pop8();
- *(double *)popaddr() = td;
+ t8 = popsze8();
+ *(struct sze8 *)popaddr() = t8;
continue;
case O_AS:
tl = *pc.cp++;
tl = *pc.usp++;
tl1 = pop2(); /* index */
tl2 = *pc.sp++;
- SUBSC(tl1, tl2, tl2 + *pc.usp++); /* range check */
pushaddr(popaddr() + (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 */
tl = *pc.usp++;
tl1 = pop4(); /* index */
tl2 = *pc.sp++;
- SUBSC(tl1, tl2, tl2 + *pc.usp++); /* range check */
pushaddr(popaddr() + (tl1 - tl2) * tl);
+ tl = *pc.usp++;
+ if (_runtst)
+ SUBSC(tl1, tl2, tl); /* range check */
continue;
case O_OFF:
tl = *pc.cp++;
push8(pop4() / td);
continue;
case O_RV1:
- tcp = _display[*pc.ucp++].locvars;
+ tcp = _display.raw[*pc.ucp++];
push2(*(tcp + *pc.sp++));
continue;
case O_RV14:
- tcp = _display[*pc.ucp++].locvars;
+ tcp = _display.raw[*pc.ucp++];
push4(*(tcp + *pc.sp++));
continue;
case O_RV2:
- tcp = _display[*pc.ucp++].locvars;
+ tcp = _display.raw[*pc.ucp++];
push2(*(short *)(tcp + *pc.sp++));
continue;
case O_RV24:
- tcp = _display[*pc.ucp++].locvars;
+ tcp = _display.raw[*pc.ucp++];
push4(*(short *)(tcp + *pc.sp++));
continue;
case O_RV4:
- tcp = _display[*pc.ucp++].locvars;
+ tcp = _display.raw[*pc.ucp++];
push4(*(long *)(tcp + *pc.sp++));
continue;
case O_RV8:
- tcp = _display[*pc.ucp++].locvars;
- push8(*(double *)(tcp + *pc.sp++));
+ tcp = _display.raw[*pc.ucp++];
+ pushsze8(*(struct sze8 *)(tcp + *pc.sp++));
continue;
case O_RV:
- tcp = _display[*pc.ucp++].locvars;
+ tcp = _display.raw[*pc.ucp++];
tcp += *pc.sp++;
tl = *pc.usp++;
- tcp1 = pushsp(tl);
+ tcp1 = pushsp((tl + 1) & ~1);
blkcpy(tl, tcp, tcp1);
continue;
case O_LV:
- tcp = _display[*pc.ucp++].locvars;
+ tcp = _display.raw[*pc.ucp++];
pushaddr(tcp + *pc.sp++);
continue;
case O_LRV1:
- tcp = _display[*pc.ucp++].locvars;
+ tcp = _display.raw[*pc.ucp++];
push2(*(tcp + *pc.lp++));
continue;
case O_LRV14:
- tcp = _display[*pc.ucp++].locvars;
+ tcp = _display.raw[*pc.ucp++];
push4(*(tcp + *pc.lp++));
continue;
case O_LRV2:
- tcp = _display[*pc.ucp++].locvars;
+ tcp = _display.raw[*pc.ucp++];
push2(*(short *)(tcp + *pc.lp++));
continue;
case O_LRV24:
- tcp = _display[*pc.ucp++].locvars;
+ tcp = _display.raw[*pc.ucp++];
push4(*(short *)(tcp + *pc.lp++));
continue;
case O_LRV4:
- tcp = _display[*pc.ucp++].locvars;
+ tcp = _display.raw[*pc.ucp++];
push4(*(long *)(tcp + *pc.lp++));
continue;
case O_LRV8:
- tcp = _display[*pc.ucp++].locvars;
- push8(*(double *)(tcp + *pc.lp++));
+ tcp = _display.raw[*pc.ucp++];
+ pushsze8(*(struct sze8 *)(tcp + *pc.lp++));
continue;
case O_LRV:
- tcp = _display[*pc.ucp++].locvars;
+ tcp = _display.raw[*pc.ucp++];
tcp += *pc.lp++;
tl = *pc.usp++;
tcp1 = pushsp(tl);
blkcpy(tl, tcp, tcp1);
continue;
case O_LLV:
- tcp = _display[*pc.ucp++].locvars;
+ tcp = _display.raw[*pc.ucp++];
pushaddr(tcp + *pc.lp++);
continue;
case O_IND1:
continue;
case O_IND8:
pc.cp++;
- push8(*(double *)(popaddr()));
+ pushsze8(*(struct sze8 *)(popaddr()));
continue;
case O_IND:
tl = *pc.cp++;
continue;
case O_STLIM:
pc.cp++;
- _stlim = pop4();
- _stcnt--;
- LINO();
+ STLIM();
+ popargs(1);
continue;
case O_LLIMIT:
pc.cp++;
if (tl1 == *tcp++)
break;
if (tl == 0) /* default case => error */
- ERROR(ECASE, tl2);
+ ERROR(ECASE, tl1);
pc.cp += *(tsp - tl);
continue;
case O_CASE2OP:
if (tl1 == *tsp1++)
break;
if (tl == 0) /* default case => error */
- ERROR(ECASE, tl2);
+ ERROR(ECASE, tl1);
pc.cp += *(tsp - tl);
continue;
case O_CASE4OP:
if (tl1 == *tlp++)
break;
if (tl == 0) /* default case => error */
- ERROR(ECASE, tl2);
+ ERROR(ECASE, tl1);
pc.cp += *(tsp - tl);
continue;
case O_ADDT:
continue;
case O_ASRT:
pc.cp++;
- ASRT(pop2());
+ ASRT(pop2(), "");
continue;
case O_FOR1U:
pc.cp++;
tcp = (char *)pop4(); /* tcp = ptr to index var */
if (*tcp < pop4()) { /* still going up */
- *tcp += 1; /* inc index var */
+ tl = *tcp + 1; /* inc index var */
+ tl1 = *pc.sp++; /* index lower bound */
+ tl2 = *pc.sp++; /* index upper bound */
+ if (_runtst)
+ RANG4(tl, tl1, tl2);
+ *tcp = tl; /* update index var */
pc.cp += *pc.sp;/* return to top of loop */
continue;
}
- pc.sp++; /* else fall through */
+ pc.sp += 3; /* else fall through */
continue;
case O_FOR2U:
pc.cp++;
tsp = (short *)pop4(); /* tsp = ptr to index var */
if (*tsp < pop4()) { /* still going up */
- *tsp += 1; /* inc index var */
+ tl = *tsp + 1; /* inc index var */
+ tl1 = *pc.sp++; /* index lower bound */
+ tl2 = *pc.sp++; /* index upper bound */
+ if (_runtst)
+ RANG4(tl, tl1, tl2);
+ *tsp = tl; /* update index var */
pc.cp += *pc.sp;/* return to top of loop */
continue;
}
- pc.sp++; /* else fall through */
+ pc.sp += 3; /* else fall through */
continue;
case O_FOR4U:
pc.cp++;
tlp = (long *)pop4(); /* tlp = ptr to index var */
if (*tlp < pop4()) { /* still going up */
- *tlp += 1; /* inc index var */
+ tl = *tlp + 1; /* inc index var */
+ tl1 = *pc.lp++; /* index lower bound */
+ tl2 = *pc.lp++; /* index upper bound */
+ if (_runtst)
+ RANG4(tl, tl1, tl2);
+ *tlp = tl; /* update index var */
pc.cp += *pc.sp;/* return to top of loop */
continue;
}
- pc.sp++; /* else fall through */
+ pc.sp += 5; /* else fall through */
continue;
case O_FOR1D:
pc.cp++;
tcp = (char *)pop4(); /* tcp = ptr to index var */
if (*tcp > pop4()) { /* still going down */
- *tcp -= 1; /* dec index var */
+ tl = *tcp - 1; /* inc index var */
+ tl1 = *pc.sp++; /* index lower bound */
+ tl2 = *pc.sp++; /* index upper bound */
+ if (_runtst)
+ RANG4(tl, tl1, tl2);
+ *tcp = tl; /* update index var */
pc.cp += *pc.sp;/* return to top of loop */
continue;
}
- pc.sp++; /* else fall through */
+ pc.sp += 3; /* else fall through */
continue;
case O_FOR2D:
pc.cp++;
tsp = (short *)pop4(); /* tsp = ptr to index var */
if (*tsp > pop4()) { /* still going down */
- *tsp -= 1; /* dec index var */
+ tl = *tsp - 1; /* inc index var */
+ tl1 = *pc.sp++; /* index lower bound */
+ tl2 = *pc.sp++; /* index upper bound */
+ if (_runtst)
+ RANG4(tl, tl1, tl2);
+ *tsp = tl; /* update index var */
pc.cp += *pc.sp;/* return to top of loop */
continue;
}
- pc.sp++; /* else fall through */
+ pc.sp += 3; /* else fall through */
continue;
case O_FOR4D:
pc.cp++;
tlp = (long *)pop4(); /* tlp = ptr to index var */
if (*tlp > pop4()) { /* still going down */
- *tlp -= 1; /* dec index var */
+ tl = *tlp - 1; /* inc index var */
+ tl1 = *pc.lp++; /* index lower bound */
+ tl2 = *pc.lp++; /* index upper bound */
+ if (_runtst)
+ RANG4(tl, tl1, tl2);
+ *tlp = tl; /* update index var */
pc.cp += *pc.sp;/* return to top of loop */
continue;
}
- pc.sp++; /* else fall through */
+ pc.sp += 5; /* else fall through */
continue;
case O_READE:
pc.cp++;
continue;
case O_WRITEC:
pc.cp++;
- WRITEC(curfile);
+ if (_runtst) {
+ WRITEC(curfile);
+ popargs(2);
+ continue;
+ }
+ fputc();
popargs(2);
continue;
case O_WRITES:
pc.cp++;
- WRITES(curfile);
+ if (_runtst) {
+ WRITES(curfile);
+ popargs(4);
+ continue;
+ }
+ fwrite();
popargs(4);
continue;
case O_WRITEF:
- WRITEF(curfile);
+ if (_runtst) {
+ WRITEF(curfile);
+ popargs(*pc.cp++);
+ continue;
+ }
+ fprintf();
popargs(*pc.cp++);
continue;
case O_WRITLN:
pc.cp++;
- WRITLN(curfile);
+ if (_runtst) {
+ WRITLN(curfile);
+ continue;
+ }
+ fputc('\n', ACTFILE(curfile));
continue;
case O_PAGE:
pc.cp++;
- PAGE(curfile);
+ if (_runtst) {
+ PAGE(curfile);
+ continue;
+ }
+ fputc('^L', ACTFILE(curfile));
continue;
case O_NAM:
pc.cp++;
if (tl == 0)
tl = *pc.usp++;
tl1 = pop4();
- push4(MAX(tl1, tl, *pc.usp++));
+ if (_runtst) {
+ push4(MAX(tl1, tl, *pc.usp++));
+ continue;
+ }
+ tl1 -= tl;
+ tl = *pc.usp++;
+ push4(tl1 > tl ? tl1 : tl);
continue;
case O_MIN:
tl = *pc.cp++;
PFLUSH();
curfile = ERR;
continue;
+ case O_PUT:
+ pc.cp++;
+ PUT(curfile);
+ continue;
case O_GET:
pc.cp++;
GET(curfile);
if (tl == 0)
tl = *pc.usp++;
tcp = popaddr(); /* ptr to ptr being new'ed */
- NEWZ(tcp, tl);
+ if (_runtst) {
+ NEWZ(tcp, tl);
+ continue;
+ }
+ NEW(tcp, tl);
continue;
case O_DATE:
pc.cp++;
continue;
case O_LN:
pc.cp++;
- push8(LN(pop8()));
+ if (_runtst) {
+ push8(LN(pop8()));
+ continue;
+ }
+ push8(log(pop8()));
continue;
case O_SIN:
pc.cp++;
continue;
case O_SQRT:
pc.cp++;
- push8(SQRT(pop8()));
+ if (_runtst) {
+ push8(SQRT(pop8()));
+ continue;
+ }
+ push8(sqrt(pop8()));
continue;
case O_CHR2:
case O_CHR4:
pc.cp++;
- push2(CHR(pop4()));
+ if (_runtst) {
+ push2(CHR(pop4()));
+ continue;
+ }
+ push2(pop4());
continue;
case O_ODD2:
case O_ODD4:
push2(pop4() & 1);
continue;
case O_SUCC2:
- /* Pi should be fixed to gen code for:
- * tl = *pc.cp++;
- * if (tl == 0)
- * tl = *pc.sp++;
- * tl1 = pop4();
- * push2(SUCC(tl1, tl, *pc.sp++));
- */
- pc.cp++;
- push2(pop4() + 1);
+ tl = *pc.cp++;
+ if (tl == 0)
+ tl = *pc.sp++;
+ tl1 = pop4();
+ if (_runtst) {
+ push2(SUCC(tl1, tl, *pc.sp++));
+ continue;
+ }
+ push2(tl1 + 1);
+ pc.sp++;
continue;
case O_SUCC24:
- /* Pi should be fixed to gen code for:
- * tl = *pc.cp++;
- * if (tl == 0)
- * tl = *pc.sp++;
- * tl1 = pop4();
- * push4(SUCC(tl1, tl, *pc.sp++));
- */
+ tl = *pc.cp++;
+ if (tl == 0)
+ tl = *pc.sp++;
+ tl1 = pop4();
+ if (_runtst) {
+ push4(SUCC(tl1, tl, *pc.sp++));
+ continue;
+ }
+ push4(tl1 + 1);
+ pc.sp++;
+ continue;
case O_SUCC4:
- /* Pi should be fixed to gen code for:
- * tl = *pc.cp++;
- * if (tl == 0)
- * tl = *pc.lp++;
- * tl1 = pop4();
- * push4(SUCC(tl1, tl, *pc.lp++));
- */
- pc.cp++;
- push4(pop4() + 1);
+ tl = *pc.cp++;
+ if (tl == 0)
+ tl = *pc.lp++;
+ tl1 = pop4();
+ if (_runtst) {
+ push4(SUCC(tl1, tl, *pc.lp++));
+ continue;
+ }
+ push4(tl1 + 1);
+ pc.lp++;
continue;
case O_PRED2:
- /* Pi should be fixed to gen code for:
- * tl = *pc.cp++;
- * if (tl == 0)
- * tl = *pc.sp++;
- * tl1 = pop4();
- * push2(PRED(tl1, tl, *pc.sp++));
- */
- pc.cp++;
- push2(pop4() - 1);
+ tl = *pc.cp++;
+ if (tl == 0)
+ tl = *pc.sp++;
+ tl1 = pop4();
+ if (_runtst) {
+ push2(PRED(tl1, tl, *pc.sp++));
+ continue;
+ }
+ push2(tl1 - 1);
+ pc.sp++;
continue;
case O_PRED24:
- /* Pi should be fixed to gen code for:
- * tl = *pc.cp++;
- * if (tl == 0)
- * tl = *pc.sp++;
- * tl1 = pop4();
- * push4(PRED(tl1, tl, *pc.sp++));
- */
+ tl = *pc.cp++;
+ if (tl == 0)
+ tl = *pc.sp++;
+ tl1 = pop4();
+ if (_runtst) {
+ push4(PRED(tl1, tl, *pc.sp++));
+ continue;
+ }
+ push4(tl1 - 1);
+ pc.sp++;
+ continue;
case O_PRED4:
- /* Pi should be fixed to gen code for:
- * tl = *pc.cp++;
- * if (tl == 0)
- * tl = *pc.lp++;
- * tl1 = pop4();
- * push4(PRED(tl1, tl, *pc.lp++));
- */
- pc.cp++;
- push4(pop4() - 1);
+ tl = *pc.cp++;
+ if (tl == 0)
+ tl = *pc.lp++;
+ tl1 = pop4();
+ if (_runtst) {
+ push4(PRED(tl1, tl, *pc.lp++));
+ continue;
+ }
+ push4(tl1 - 1);
+ pc.lp++;
continue;
case O_SEED:
pc.cp++;