X-Git-Url: https://git.subgeniuskitty.com/unix-history/.git/blobdiff_plain/43017a6f2b3f1243af7439a9d361ecde177d5744..79029c32280d78322b4fb003d1cf99489dda7f1c:/usr/src/usr.bin/pascal/px/interp.c diff --git a/usr/src/usr.bin/pascal/px/interp.c b/usr/src/usr.bin/pascal/px/interp.c index d4e50dc109..8a24aba5a2 100644 --- a/usr/src/usr.bin/pascal/px/interp.c +++ b/usr/src/usr.bin/pascal/px/interp.c @@ -1,65 +1,54 @@ /* Copyright (c) 1979 Regents of the University of California */ -static char sccsid[] = "@(#)interp.c 1.1 %G%"; +static char sccsid[] = "@(#)interp.c 1.17 %G%"; #include +#include "whoami.h" +#include "objfmt.h" #include "vars.h" #include "panics.h" #include "h02opcs.h" #include "machdep.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; +bool _runtst = TRUE; +bool _nodump = FALSE; long _stlim = 500000; long _stcnt = 0; +long _seed = 1; +#ifdef VAX char *_minptr = (char *)0x7fffffff; +#else +char *_minptr = (char *)0xffff; +#endif VAX char *_maxptr = (char *)0; long *_pcpcount = (long *)0; long _cntrs = 0; long _rtns = 0; -/* - * 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 -}; - /* * standard files */ char _inwin, _outwin, _errwin; -struct iorechd input = { - &_inwin, /* fileptr */ +struct iorechd _err = { + &_errwin, /* fileptr */ 0, /* lcount */ 0x7fffffff, /* llimit */ - &_iob[0], /* fbuf */ - OUTPUT, /* fchain */ + &_iob[2], /* fbuf */ + FILNIL, /* fchain */ STDLVL, /* flev */ - "standard input", /* pfname */ - FTEXT | FREAD | SYNC, /* funit */ - 0, /* fblk */ + "Message file", /* pfname */ + FTEXT | FWRITE | EOFF, /* funit */ + 2, /* fblk */ 1 /* fsize */ }; struct iorechd output = { @@ -74,19 +63,55 @@ struct iorechd output = { 1, /* fblk */ 1 /* fsize */ }; -struct iorechd _err = { - &_errwin, /* fileptr */ +struct iorechd input = { + &_inwin, /* fileptr */ 0, /* lcount */ 0x7fffffff, /* llimit */ - &_iob[2], /* fbuf */ - FILNIL, /* fchain */ + &_iob[0], /* fbuf */ + OUTPUT, /* fchain */ STDLVL, /* flev */ - "Message file", /* pfname */ - FTEXT | FWRITE | EOFF, /* funit */ - 2, /* fblk */ + "standard input", /* pfname */ + FTEXT | FREAD | SYNC, /* 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; { @@ -97,17 +122,27 @@ interpreter(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; + register short *tsp, *tsp1, ts; + bool tb; char *tcp1; struct stack *tstp; struct formalrtn *tfp; union progcntr tpc; struct iorec **ip; + pcaddrp = &pc; + + /* + * 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 @@ -117,54 +152,68 @@ interpreter(base) /* * 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 */ - stp = (struct stack *)pushsp(sizeof(struct stack)); - _dp = &_display[0]; + _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 stack *)pushsp((long)(sizeof(struct stack))); + _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++) { - default: - panic(PBADOP); + case O_BPT: /* breakpoint trap */ + asm(".byte 0"); + pc.ucp--; 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 += (int)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 */ - 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 */ + if (_runtst) /* zero stack frame */ + blkclr(tl1, tcp); + 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[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; @@ -173,64 +222,62 @@ interpreter(base) tcp = base + *pc.lp++;/* calc new entry point */ tcp += sizeof(short); tcp = base + *(long *)tcp; - stp = (struct stack *)pushsp(sizeof(struct stack)); + stp = (struct stack *) + pushsp((long)(sizeof(struct stack))); 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: - tl = *pc.cp++; /* tl = number of args */ - if (tl == 0) - tl = *pc.lp++; + pc.cp++; + tcp = popaddr(); /* ptr to display save area */ tfp = (struct formalrtn *)popaddr(); - stp = (struct stack *)pushsp(sizeof(struct stack)); + stp = (struct stack *) + pushsp((long)(sizeof(struct stack))); stp->lino = _lino; /* save lino, pc, dp */ 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)); - } - _dp = &_display[tfp->cbn];/* set up new display ptr */ - blkcpy(sizeof(struct disp) * tfp->cbn, - &_display[1], &tfp->disp[tfp->cbn]); - blkcpy(sizeof(struct disp) * tfp->cbn, - &tfp->disp[0], &_display[1]); + pc.cp = tfp->fentryaddr;/* calc new entry point */ + _dp = &_display.frame[tfp->fbn];/* new display ptr */ + blkcpy(tfp->fbn * sizeof(struct disp), + &_display.frame[1], tcp); + blkcpy(tfp->fbn * sizeof(struct disp), + &tfp->fdisp[0], &_display.frame[1]); continue; case O_FRTN: tl = *pc.cp++; /* tl = size of return obj */ if (tl == 0) tl = *pc.usp++; - tcp = pushsp(0); + tcp = pushsp((long)(0)); tfp = *(struct formalrtn **)(tcp + tl); - blkcpy(tl, tcp, tcp + sizeof(struct formalrtn *)); - popsp(sizeof(struct formalrtn *)); - blkcpy(sizeof(struct disp) * tfp->cbn, - &tfp->disp[tfp->cbn], &_display[1]); + tcp1 = *(char **) + (tcp + tl + sizeof(struct formalrtn *)); + if (tl != 0) { + blkcpy(tl, tcp, tcp + sizeof(struct formalrtn *) + + sizeof(char *)); + } + popsp((long) + (sizeof(struct formalrtn *) + sizeof (char *))); + blkcpy(tfp->fbn * sizeof(struct disp), + tcp1, &_display.frame[1]); continue; case O_FSAV: tfp = (struct formalrtn *)popaddr(); - tfp->cbn = *pc.cp++; /* blk number of routine */ - tcp = base + *pc.lp++;/* calc new entry point */ + tfp->fbn = *pc.cp++; /* blk number of routine */ + tcp = base + *pc.lp++; /* calc new entry point */ tcp += sizeof(short); - tfp->entryaddr = base + *(long *)tcp; - blkcpy(sizeof(struct disp) * tfp->cbn, - &_display[1], &tfp->disp[0]); + tfp->fentryaddr = base + *(long *)tcp; + blkcpy(tfp->fbn * sizeof(struct disp), + &_display.frame[1], &tfp->fdisp[0]); pushaddr(tfp); continue; case O_SDUP2: pc.cp++; tl = pop2(); - push2(tl); - push2(tl); + push2((short)(tl)); + push2((short)(tl)); continue; case O_SDUP4: pc.cp++; @@ -247,12 +294,13 @@ interpreter(base) 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]) - ERROR(EGOTO); /* exiting prog ??? */ + 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 */ @@ -260,15 +308,19 @@ interpreter(base) stp = _dp->stp; } /* pop locals, stack frame, parms, and return values */ - popsp(stp->tos - pushsp(0)); + popsp((long)(stp->tos - pushsp((long)(0)))); continue; case O_LINO: - if (_dp->stp->tos != pushsp(0)) + if (_dp->stp->tos != pushsp((long)(0))) panic(PSTKNEMP); _lino = *pc.cp++; /* set line number */ if (_lino == 0) _lino = *pc.sp++; - LINO(); /* inc statement count */ + if (_runtst) { + LINO(); /* inc statement count */ + continue; + } + _stcnt++; continue; case O_PUSH: tl = *pc.cp++; @@ -276,14 +328,16 @@ interpreter(base) tl = *pc.usp++; tl = (-tl + 1) & ~1; tcp = pushsp(tl); - blkclr(tl, tcp); + if (_runtst) + blkclr(tl, tcp); 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(); @@ -329,62 +383,62 @@ interpreter(base) 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(0); /* tcp pts to first arg */ + tcp = pushsp((long)(0));/* tcp pts to first arg */ switch (tl2) { case releq: - tl = RELEQ(tl, tcp + tl1, tcp); + tb = RELEQ(tl, tcp + tl1, tcp); break; case relne: - tl = RELNE(tl, tcp + tl1, tcp); + tb = RELNE(tl, tcp + tl1, tcp); break; case rellt: - tl = RELSLT(tl, tcp + tl1, tcp); + tb = RELSLT(tl, tcp + tl1, tcp); break; case relgt: - tl = RELSGT(tl, tcp + tl1, tcp); + tb = RELSGT(tl, tcp + tl1, tcp); break; case relle: - tl = RELSLE(tl, tcp + tl1, tcp); + tb = RELSLE(tl, tcp + tl1, tcp); break; case relge: - tl = RELSGE(tl, tcp + tl1, tcp); + tb = RELSGE(tl, tcp + tl1, tcp); break; default: panic(PSYSTEM); break; } popsp(tl1 << 1); - push2(tl); + push2((short)(tb)); continue; case O_RELT: tl2 = *pc.cp++; /* tc has jump opcode */ tl1 = *pc.usp++; /* tl1 has comparison length */ - tcp = pushsp(0); /* tcp pts to first arg */ + tcp = pushsp((long)(0));/* tcp pts to first arg */ switch (tl2) { case releq: - tl = RELEQ(tl1, tcp + tl1, tcp); + tb = RELEQ(tl1, tcp + tl1, tcp); break; case relne: - tl = RELNE(tl1, tcp + tl1, tcp); + tb = RELNE(tl1, tcp + tl1, tcp); break; case rellt: - tl = RELTLT(tl1, tcp + tl1, tcp); + tb = RELTLT(tl1, tcp + tl1, tcp); break; case relgt: - tl = RELTGT(tl1, tcp + tl1, tcp); + tb = RELTGT(tl1, tcp + tl1, tcp); break; case relle: - tl = RELTLE(tl1, tcp + tl1, tcp); + tb = RELTLE(tl1, tcp + tl1, tcp); break; case relge: - tl = RELTGE(tl1, tcp + tl1, tcp); + tb = RELTGE(tl1, tcp + tl1, tcp); break; default: panic(PSYSTEM); break; } popsp(tl1 << 1); - push2(tl); + push2((short)(tb)); continue; case O_REL28: td = pop2(); @@ -483,15 +537,15 @@ interpreter(base) continue; case O_AS8: pc.cp++; - td = pop8(); - *(double *)popaddr() = td; + 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(0); + tcp = pushsp((long)(0)); blkcpy(tl, tcp, *(char **)(tcp + tl1)); popsp(tl1 + sizeof(char *)); continue; @@ -511,8 +565,10 @@ interpreter(base) 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 */ @@ -520,14 +576,16 @@ interpreter(base) 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++; if (tl == 0) tl = *pc.usp++; - push4(pop4() + tl); + pushaddr(popaddr() + tl); continue; case O_NIL: pc.cp++; @@ -535,7 +593,7 @@ interpreter(base) continue; case O_ADD2: pc.cp++; - push4(pop2() + pop2()); + push4((long)(pop2() + pop2())); continue; case O_ADD4: pc.cp++; @@ -613,7 +671,7 @@ interpreter(base) continue; case O_MUL2: pc.cp++; - push4(pop2() * pop2()); + push4((long)(pop2() * pop2())); continue; case O_MUL4: pc.cp++; @@ -662,7 +720,7 @@ interpreter(base) continue; case O_NEG2: pc.cp++; - push4(-pop2()); + push4((long)(-pop2())); continue; case O_NEG4: pc.cp++; @@ -732,7 +790,7 @@ interpreter(base) continue; case O_STOI: pc.cp++; - push4(pop2()); + push4((long)(pop2())); continue; case O_STOD: pc.cp++; @@ -746,7 +804,7 @@ interpreter(base) continue; case O_ITOS: pc.cp++; - push2(pop4()); + push2((short)(pop4())); continue; case O_DVD2: pc.cp++; @@ -789,82 +847,82 @@ interpreter(base) push8(pop4() / td); continue; case O_RV1: - tcp = _display[*pc.ucp++].locvars; - push2(*(tcp + *pc.sp++)); + tcp = _display.raw[*pc.ucp++]; + push2((short)(*(tcp + *pc.sp++))); continue; case O_RV14: - tcp = _display[*pc.ucp++].locvars; - push4(*(tcp + *pc.sp++)); + tcp = _display.raw[*pc.ucp++]; + push4((long)(*(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; - push4(*(short *)(tcp + *pc.sp++)); + tcp = _display.raw[*pc.ucp++]; + push4((long)(*(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; - push2(*(tcp + *pc.lp++)); + tcp = _display.raw[*pc.ucp++]; + push2((short)(*(tcp + *pc.lp++))); continue; case O_LRV14: - tcp = _display[*pc.ucp++].locvars; - push4(*(tcp + *pc.lp++)); + tcp = _display.raw[*pc.ucp++]; + push4((long)(*(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; - push4(*(short *)(tcp + *pc.lp++)); + tcp = _display.raw[*pc.ucp++]; + push4((long)(*(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 += *pc.lp++; + tcp = _display.raw[*pc.ucp++]; + tcp += (int)*pc.lp++; tl = *pc.usp++; - tcp1 = pushsp(tl); + tcp1 = pushsp((tl + 1) & ~1); 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: pc.cp++; - push2(*popaddr()); + push2((short)(*popaddr())); continue; case O_IND14: pc.cp++; - push4(*popaddr()); + push4((long)(*popaddr())); continue; case O_IND2: pc.cp++; @@ -872,7 +930,7 @@ interpreter(base) continue; case O_IND24: pc.cp++; - push4(*(short *)(popaddr())); + push4((long)(*(short *)(popaddr()))); continue; case O_IND4: pc.cp++; @@ -880,7 +938,7 @@ interpreter(base) continue; case O_IND8: pc.cp++; - push8(*(double *)(popaddr())); + pushsze8(*(struct sze8 *)(popaddr())); continue; case O_IND: tl = *pc.cp++; @@ -891,10 +949,10 @@ interpreter(base) blkcpy(tl, tcp, tcp1); continue; case O_CON1: - push2(*pc.cp++); + push2((short)(*pc.cp++)); continue; case O_CON14: - push4(*pc.cp++); + push4((long)(*pc.cp++)); continue; case O_CON2: pc.cp++; @@ -902,7 +960,7 @@ interpreter(base) continue; case O_CON24: pc.cp++; - push4(*pc.sp++); + push4((long)(*pc.sp++)); continue; case O_CON4: pc.cp++; @@ -910,7 +968,7 @@ interpreter(base) continue; case O_CON8: pc.cp++; - push8(*pc.dp++); + push8(*pc.dbp++); continue; case O_CON: tl = *pc.cp++; @@ -919,7 +977,16 @@ interpreter(base) tl = (tl + 1) & ~1; tcp = pushsp(tl); blkcpy(tl, pc.cp, tcp); - pc.cp += 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(tl1, pc.cp, tcp); + pc.cp += (int)((tl + 2) & ~1); continue; case O_LVCON: tl = *pc.cp++; @@ -927,28 +994,28 @@ interpreter(base) tl = *pc.usp++; tl = (tl + 1) & ~1; pushaddr(pc.cp); - pc.cp += tl; + pc.cp += (int)tl; continue; case O_RANG2: tl = *pc.cp++; if (tl == 0) tl = *pc.sp++; tl1 = pop2(); - push2(RANG4(tl1, tl, *pc.sp++)); + 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, *pc.sp++)); + push4(RANG4(tl1, tl, (long)(*pc.sp++))); continue; case O_RSNG2: tl = *pc.cp++; if (tl == 0) tl = *pc.sp++; tl1 = pop2(); - push2(RSNG4(tl1, tl)); + push2((short)(RSNG4(tl1, tl))); continue; case O_RSNG42: tl = *pc.cp++; @@ -958,40 +1025,45 @@ interpreter(base) push4(RSNG4(tl1, tl)); continue; case O_RANG4: - pc.cp++; - tl = *pc.lp++; + tl = *pc.cp++; + if (tl == 0) + tl = *pc.lp++; tl1 = pop4(); push4(RANG4(tl1, tl, *pc.lp++)); continue; case O_RANG24: - pc.cp++; - tl = *pc.lp++; + tl = *pc.cp++; + if (tl == 0) + tl = *pc.lp++; tl1 = pop2(); - push2(RANG4(tl1, tl, *pc.lp++)); + push2((short)(RANG4(tl1, tl, *pc.lp++))); continue; case O_RSNG4: - pc.cp++; - tl = pop4(); - push4(RSNG4(tl, *pc.lp++)); + tl = *pc.cp++; + if (tl == 0) + tl = *pc.lp++; + tl1 = pop4(); + push4(RSNG4(tl1, tl)); continue; case O_RSNG24: - pc.cp++; - tl = pop2(); - push2(RSNG4(tl, *pc.lp++)); + tl = *pc.cp++; + if (tl == 0) + tl = *pc.lp++; + tl1 = pop2(); + push2((short)(RSNG4(tl1, tl))); continue; case O_STLIM: pc.cp++; - _stlim = pop4(); - _stcnt--; - LINO(); + STLIM(); + popsp((long)(sizeof(long))); continue; case O_LLIMIT: pc.cp++; LLIMIT(); - popargs(2); + popsp((long)(sizeof(char *)+sizeof(long))); continue; case O_BUFF: - BUFF(*pc.cp++); + BUFF((long)(*pc.cp++)); continue; case O_HALT: pc.cp++; @@ -1001,7 +1073,7 @@ interpreter(base) pc.cp++; _cntrs = *pc.lp++; _rtns = *pc.lp++; - _pcpcount = (long *)calloc(_cntrs + 1, sizeof(long)); + NEWZ(&_pcpcount, (_cntrs + 1) * sizeof(long)); continue; case O_COUNT: pc.cp++; @@ -1018,7 +1090,7 @@ interpreter(base) if (tl1 == *tcp++) break; if (tl == 0) /* default case => error */ - ERROR(ECASE, tl2); + ERROR("Label of %D not found in case\n", tl1); pc.cp += *(tsp - tl); continue; case O_CASE2OP: @@ -1032,7 +1104,7 @@ interpreter(base) if (tl1 == *tsp1++) break; if (tl == 0) /* default case => error */ - ERROR(ECASE, tl2); + ERROR("Label of %D not found in case\n", tl1); pc.cp += *(tsp - tl); continue; case O_CASE4OP: @@ -1046,14 +1118,14 @@ interpreter(base) if (tl1 == *tlp++) break; if (tl == 0) /* default case => error */ - ERROR(ECASE, tl2); + ERROR("Label of %D not found in case\n", tl1); pc.cp += *(tsp - tl); continue; case O_ADDT: tl = *pc.cp++; /* tl has comparison length */ if (tl == 0) tl = *pc.usp++; - tcp = pushsp(0); /* tcp pts to first arg */ + tcp = pushsp((long)(0));/* tcp pts to first arg */ ADDT(tcp + tl, tcp + tl, tcp, tl >> 2); popsp(tl); continue; @@ -1061,7 +1133,7 @@ interpreter(base) tl = *pc.cp++; /* tl has comparison length */ if (tl == 0) tl = *pc.usp++; - tcp = pushsp(0); /* tcp pts to first arg */ + tcp = pushsp((long)(0));/* tcp pts to first arg */ SUBT(tcp + tl, tcp + tl, tcp, tl >> 2); popsp(tl); continue; @@ -1069,7 +1141,7 @@ interpreter(base) tl = *pc.cp++; /* tl has comparison length */ if (tl == 0) tl = *pc.usp++; - tcp = pushsp(0); /* tcp pts to first arg */ + tcp = pushsp((long)(0));/* tcp pts to first arg */ MULT(tcp + tl, tcp + tl, tcp, tl >> 2); popsp(tl); continue; @@ -1077,106 +1149,125 @@ interpreter(base) tl = *pc.cp++; /* tl has number of args */ if (tl == 0) tl = *pc.usp++; - tl1 = INCT(); - popargs(tl); - push2(tl1); + 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(0) + tl1; /* tcp pts to result space */ + tcp = pushsp((long)(0)) + tl1; /* tcp pts to result */ CTTOT(tcp); - popargs(tl); + popsp(tl*sizeof(long)); continue; case O_CARD: tl = *pc.cp++; /* tl has comparison length */ if (tl == 0) tl = *pc.usp++; - tcp = pushsp(0); /* tcp pts to set */ + tcp = pushsp((long)(0));/* tcp pts to set */ tl1 = CARD(tcp, tl); popsp(tl); - push2(tl1); + 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(0); /* tcp pts to set */ - tl2 = *pc.usp++; /* lower bound */ - tl1 = IN(tl1, tl2, *pc.usp++, tcp); + tcp = pushsp((long)(0));/* tcp pts to set */ + tl2 = *pc.sp++; /* lower bound */ + tb = IN(tl1, tl2, (long)(*pc.usp++), tcp); popsp(tl); - push2(tl1); + push2((short)(tb)); continue; case O_ASRT: pc.cp++; - ASRT(pop2()); + ts = pop2(); + ASRT(ts, ""); 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 */ - pc.cp += *pc.sp;/* return to top of loop */ - continue; - } - pc.sp++; /* else fall through */ - continue; + /* + * with the shadowing of for loop variables + * the variable is always sizeof(long) hence + * nullifying the need for shorter length + * assignments + */ case O_FOR2U: - pc.cp++; - tsp = (short *)pop4(); /* tsp = ptr to index var */ - if (*tsp < pop4()) { /* still going up */ - *tsp += 1; /* inc index var */ + tl1 = *pc.cp++; /* tl1 index lower bound */ + if (tl1 == 0) + tl1 = *pc.sp++; + tlp = (long *)popaddr(); /* tlp = ptr to index var */ + if (*tlp < pop4()) { /* still going up */ + tl = *tlp + 1; /* inc index var */ + tl2 = *pc.sp++; /* 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 += 2; /* else fall through */ continue; case O_FOR4U: - pc.cp++; - tlp = (long *)pop4(); /* tlp = ptr to index var */ + tl1 = *pc.cp++; /* tl1 index lower bound */ + if (tl1 == 0) + tl1 = *pc.lp++; + tlp = (long *)popaddr(); /* tlp = ptr to index var */ if (*tlp < pop4()) { /* still going up */ - *tlp += 1; /* inc index var */ + tl = *tlp + 1; /* inc index var */ + 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 += 3; /* 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 */ - pc.cp += *pc.sp;/* return to top of loop */ - continue; - } - pc.sp++; /* else fall through */ - continue; + /* + * with the shadowing of for loop variables + * the variable is always sizeof(long) hence + * nullifying the need for shorter length + * assignments + */ case O_FOR2D: - pc.cp++; - tsp = (short *)pop4(); /* tsp = ptr to index var */ - if (*tsp > pop4()) { /* still going down */ - *tsp -= 1; /* dec index var */ + tl1 = *pc.cp++; /* tl1 index lower bound */ + if (tl1 == 0) + tl1 = *pc.sp++; + tlp = (long *)popaddr(); /* tlp = ptr to index var */ + if (*tlp > pop4()) { /* still going down */ + tl = *tlp - 1; /* inc index var */ + tl2 = *pc.sp++; /* 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 += 2; /* else fall through */ continue; case O_FOR4D: - pc.cp++; - tlp = (long *)pop4(); /* tlp = ptr to index var */ + tl1 = *pc.cp++; /* tl1 index lower bound */ + if (tl1 == 0) + tl1 = *pc.lp++; + tlp = (long *)popaddr(); /* tlp = ptr to index var */ if (*tlp > pop4()) { /* still going down */ - *tlp -= 1; /* dec index var */ + tl = *tlp - 1; /* inc index var */ + 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 += 3; /* else fall through */ continue; case O_READE: pc.cp++; - push2(READE(curfile, base + *pc.lp++)); + push2((short)(READE(curfile, base + *pc.lp++))); continue; case O_READ4: pc.cp++; @@ -1184,7 +1275,7 @@ interpreter(base) continue; case O_READC: pc.cp++; - push2(READC(curfile)); + push2((short)(READC(curfile))); continue; case O_READ8: pc.cp++; @@ -1196,33 +1287,54 @@ interpreter(base) continue; case O_EOF: pc.cp++; - push2(TEOF(popaddr())); + push2((short)(TEOF(popaddr()))); continue; case O_EOLN: pc.cp++; - push2(TEOLN(popaddr())); + push2((short)(TEOLN(popaddr()))); continue; case O_WRITEC: - pc.cp++; - WRITEC(curfile); - popargs(2); + if (_runtst) { + WRITEC(curfile); + popsp((long)(*pc.cp++)); + continue; + } + fputc(); + popsp((long)(*pc.cp++)); continue; case O_WRITES: - pc.cp++; - WRITES(curfile); - popargs(4); + if (_runtst) { + WRITES(curfile); + popsp((long)(*pc.cp++)); + continue; + } + fwrite(); + popsp((long)(*pc.cp++)); continue; case O_WRITEF: - WRITEF(curfile); - popargs(*pc.cp++); + if (_runtst) { + WRITEF(curfile); + popsp((long)(*pc.cp++)); + continue; + } + fprintf(); + popsp((long)(*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(' ', ACTFILE(curfile)); continue; case O_NAM: pc.cp++; @@ -1234,7 +1346,13 @@ interpreter(base) if (tl == 0) tl = *pc.usp++; tl1 = pop4(); - push4(MAX(tl1, tl, *pc.usp++)); + 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++; @@ -1260,6 +1378,10 @@ interpreter(base) PFLUSH(); curfile = ERR; continue; + case O_PUT: + pc.cp++; + PUT(curfile); + continue; case O_GET: pc.cp++; GET(curfile); @@ -1271,17 +1393,17 @@ interpreter(base) case O_DEFNAME: pc.cp++; DEFNAME(); - popargs(4); + popsp((long)(2*sizeof(char *)+2*sizeof(long))); continue; case O_RESET: pc.cp++; RESET(); - popargs(4); + popsp((long)(2*sizeof(char *)+2*sizeof(long))); continue; case O_REWRITE: pc.cp++; REWRITE(); - popargs(4); + popsp((long)(2*sizeof(char *)+2*sizeof(long))); continue; case O_FILE: pc.cp++; @@ -1290,26 +1412,26 @@ interpreter(base) case O_REMOVE: pc.cp++; REMOVE(); - popargs(2); + popsp((long)(sizeof(char *)+sizeof(long))); continue; case O_FLUSH: pc.cp++; FLUSH(); - popargs(1); + popsp((long)(sizeof(char *))); continue; case O_PACK: pc.cp++; PACK(); - popargs(7); + popsp((long)(5*sizeof(long)+2*sizeof(char*))); continue; case O_UNPACK: pc.cp++; UNPACK(); - popargs(7); + popsp((long)(5*sizeof(long)+2*sizeof(char*))); continue; case O_ARGC: pc.cp++; - push4(_argc); + push4((long)_argc); continue; case O_ARGV: tl = *pc.cp++; /* tl = size of char array */ @@ -1344,7 +1466,11 @@ interpreter(base) 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++; @@ -1357,7 +1483,7 @@ interpreter(base) case O_UNDEF: pc.cp++; pop8(); - push2(0); + push2((short)(0)); continue; case O_ATAN: pc.cp++; @@ -1373,7 +1499,11 @@ interpreter(base) continue; case O_LN: pc.cp++; - push8(LN(pop8())); + if (_runtst) { + push8(LN(pop8())); + continue; + } + push8(log(pop8())); continue; case O_SIN: pc.cp++; @@ -1381,77 +1511,97 @@ interpreter(base) 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((short)(CHR(pop4()))); + continue; + } + push2((short)(pop4())); continue; case O_ODD2: case O_ODD4: pc.cp++; - push2(pop4() & 1); + push2((short)(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((short)(SUCC(tl1, tl, (long)(*pc.sp++)))); + continue; + } + push2((short)(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, (long)(*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, (long)(*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((short)(PRED(tl1, tl, (long)(*pc.sp++)))); + continue; + } + push2((short)(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, (long)(*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, (long)(*pc.lp++))); + continue; + } + push4(tl1 - 1); + pc.lp++; continue; case O_SEED: pc.cp++; @@ -1484,6 +1634,9 @@ interpreter(base) pc.cp++; push4(TRUNC(pop8())); continue; + default: + panic(PBADOP); + continue; } } }