X-Git-Url: https://git.subgeniuskitty.com/unix-history/.git/blobdiff_plain/43017a6f2b3f1243af7439a9d361ecde177d5744..5b37c705c76a7facee6bc55b57a2832619a57314:/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..261b668e6b 100644 --- a/usr/src/usr.bin/pascal/px/interp.c +++ b/usr/src/usr.bin/pascal/px/interp.c @@ -1,6 +1,6 @@ /* Copyright (c) 1979 Regents of the University of California */ -static char sccsid[] = "@(#)interp.c 1.1 %G%"; +static char sccsid[] = "@(#)interp.c 1.6 %G%"; #include #include "vars.h" @@ -10,22 +10,20 @@ static char sccsid[] = "@(#)interp.c 1.1 %G%"; #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; @@ -87,6 +85,21 @@ struct iorechd _err = { 1 /* fsize */ }; +/* + * 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; { @@ -117,54 +130,64 @@ 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 */ + _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; @@ -177,7 +200,7 @@ interpreter(base) 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: @@ -190,20 +213,22 @@ interpreter(base) 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 */ @@ -214,7 +239,7 @@ interpreter(base) 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(); @@ -223,7 +248,7 @@ interpreter(base) 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: @@ -247,11 +272,12 @@ 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]) + if (_dp == &_display.frame[1]) ERROR(EGOTO); /* exiting prog ??? */ PCLOSE(_dp->locvars); /* close local files */ curfile = stp->file; /* restore active file */ @@ -280,10 +306,11 @@ interpreter(base) 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(); @@ -511,8 +538,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,8 +549,10 @@ 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++; @@ -789,73 +820,73 @@ interpreter(base) 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; + tcp = _display.raw[*pc.ucp++]; push8(*(double *)(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); 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; + tcp = _display.raw[*pc.ucp++]; push8(*(double *)(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: @@ -981,9 +1012,8 @@ interpreter(base) continue; case O_STLIM: pc.cp++; - _stlim = pop4(); - _stcnt--; - LINO(); + STLIM(); + popargs(1); continue; case O_LLIMIT: pc.cp++; @@ -1018,7 +1048,7 @@ interpreter(base) if (tl1 == *tcp++) break; if (tl == 0) /* default case => error */ - ERROR(ECASE, tl2); + ERROR(ECASE, tl1); pc.cp += *(tsp - tl); continue; case O_CASE2OP: @@ -1032,7 +1062,7 @@ interpreter(base) if (tl1 == *tsp1++) break; if (tl == 0) /* default case => error */ - ERROR(ECASE, tl2); + ERROR(ECASE, tl1); pc.cp += *(tsp - tl); continue; case O_CASE4OP: @@ -1046,7 +1076,7 @@ interpreter(base) if (tl1 == *tlp++) break; if (tl == 0) /* default case => error */ - ERROR(ECASE, tl2); + ERROR(ECASE, tl1); pc.cp += *(tsp - tl); continue; case O_ADDT: @@ -1112,67 +1142,97 @@ interpreter(base) 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++; @@ -1204,25 +1264,48 @@ interpreter(base) 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++; @@ -1234,7 +1317,13 @@ interpreter(base) 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++; @@ -1260,6 +1349,10 @@ interpreter(base) PFLUSH(); curfile = ERR; continue; + case O_PUT: + pc.cp++; + PUT(curfile); + continue; case O_GET: pc.cp++; GET(curfile); @@ -1344,7 +1437,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++; @@ -1373,7 +1470,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,12 +1482,20 @@ 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(CHR(pop4())); + continue; + } + push2(pop4()); continue; case O_ODD2: case O_ODD4: @@ -1394,64 +1503,76 @@ interpreter(base) 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++;