void intern(int x, int imm) {
enter(*link);
*link = *dict-1;
w = *dict;
enter(0);
int slen = scant((char) 127, (char *)(disk+(*dict)));
int ilen = slen/PACK + (slen%PACK) ? 1 : 0;
disk[w] = slen;
*dict += slen/PACK + 1;
enter(imm);
enter(x);
mputs("interning ");
putnumstr(disk+w);
mputs(" @ ");
puts(itoa(*dict-1));
}
main( )
{
int pounds;
/* Read first weight in pounds */
printf("\n\n\tWeight in pounds?");
scant("%d",£s);
/* Loop until user signals halt with negatie integer. */
while(pounds>=0)
{
printf("\n\n\tEquivalent weight in ounces: %d", pounds * 16);
printf("\n\n\tWeight in pounds?");
printf("\n\n\tEnter a negative integer to quit.");
scanf("%d",£s);
}
}
void execute(int x) {
int op = disk[x];
char *s;
switch (op) {
case DOCOL:
w = ++IP;
RPUSH ++IP;
IP = disk[w];
break;
case KEY:
PUSH getchar();
NEXT;
break;
case WORD:
w = *dict;
enter(0);
int slen = scant((char) TOS, (char *)(disk + (*dict)));
DROP;
disk[w] = slen;
PUSH w;
*dict += slen/PACK + 1;
NEXT;
break;
case FIND:
w = *link;
while (!(streql(disk+TOS, (disk+w+1))) && w) {
w = disk[w];
}
if (!w) {
PUSH 1;
} else {
TOS = w + 2 + ((disk[w+1])/PACK + 2);
w = disk[TOS-1];
PUSH w;
}
NEXT;
break;
case EXIT:
RDROP;
NEXT;
break;
case PEEK:
TOS = disk[TOS];
NEXT;
break;
case POKE:
disk[TOS] = NTOS;
DROP;
DROP;
NEXT;
break;
case LIT:
PUSH disk[TORS++];
NEXT;
break;
case PUSNXT:
PUSH disk[NTORS++];
NEXT;
break;
case BRANCH:
TORS += disk[TORS] + 1; //was off by one
NEXT;
break;
case PDROP:
DROP;
NEXT;
break;
case TOR:
w = TORS;
TORS = TOS;
RPUSH w;
DROP;
NEXT;
break;
case FROMR:
PUSH NTORS;
w = TORS;
RDROP;
TORS = w;
NEXT;
break;
case DUP:
w = TOS;
PUSH w;
NEXT;
break;
case SWAP:
w = TOS;
TOS = NTOS;
NTOS = w;
NEXT;
break;
case ROT:
w = TOS;
TOS = disk[(*tosp)+2];
disk[(*tosp)+2] = NTOS;
NTOS = w;
NEXT;
break;
case PLUS:
TWOLEVEL(TOS + NTOS);
break;
case MINUS:
TWOLEVEL(NTOS - TOS);
break;
case MULT:
TWOLEVEL(TOS * NTOS);
break;
case DIV:
TWOLEVEL(NTOS / TOS);
break;
case RSHIFT:
NTOS >>= TOS;
DROP;
NEXT;
break;
case LSHIFT:
NTOS <<= TOS;
DROP;
NEXT;
break;
case LESS:
TWOLEVEL(NTOS < TOS ? -1 : 0);
break;
case GREAT:
TWOLEVEL(NTOS > TOS ? -1 : 0);
break;
case EQL:
NTOS = NTOS == TOS ? -1 : 0;
DROP;
NEXT;
break;
case EMIT:
mputchar(TOS);
DROP;
NEXT;
break;
case PUTS:
putnumstr(disk+TOS);
DROP;
NEXT;
break;
case ATOI:
w = TOS+1;
TOS = (int) strtol((char *)(disk+w),&s, 10);
if(s == (char *)(disk+w)){
DROP;
mputs("NO NUMBER FOUND: ");
putnumstr(disk+w-1);
puts("");
}
NEXT;
break;
case PNUM:
puts(itoa(TOS));
DROP;
NEXT;
break;
case AND:
NTOS &= TOS;
DROP;
NEXT;
break;
case OR:
NTOS |= TOS;
DROP;
NEXT;
break;
case XOR:
NTOS ^= TOS;
DROP;
NEXT;
break;
case NOT:
TOS = ~TOS;
NEXT;
break;
default: //this should be unreachable
mputs("execute fallthrough: ");
puts(itoa(op));
dumpstack(3,tosp);
dumpstack(5,rsp);
dumpstack(15, disk+(*link));
mputs("IP = ");
puts(itoa(IP));
stat();
*rsp = DSIZE-(RSSIZE+STSIZE+1);
IP = cs;
}
}
