Forp: Refactor interpreter, inline VM loop, implement if/then and immediate words

This commit is contained in:
Jeremy Penner 2019-01-30 22:12:28 -05:00
parent b9fec53c09
commit c0f19f7674
2 changed files with 141 additions and 71 deletions

204
forp.c
View file

@ -28,6 +28,8 @@ cell *stack = stack_mem;
char *INPUT = NULL; char *INPUT = NULL;
#define F_IMMEDIATE 0x80
#define CELL_OFFSET(cp, b) ((cell*)(((char *)(cp)) + b)) #define CELL_OFFSET(cp, b) ((cell*)(((char *)(cp)) + b))
#define TOP() (*(stack - 1)) #define TOP() (*(stack - 1))
#define ST1() (*(stack - 2)) #define ST1() (*(stack - 2))
@ -88,7 +90,6 @@ void f_rot() { // a b c -- b c a
ST2() = b; ST2() = b;
} }
void f_key() { void f_key() {
if (INPUT) { if (INPUT) {
PUSHI(*INPUT); PUSHI(*INPUT);
@ -166,23 +167,26 @@ void f_cdef() { // func name --
DROP(1); DROP(1);
} }
int RET = 0;
void f_docolon() { void f_docolon() {
RPUSH(IP); RPUSH(W);
IP.p = W.p + 1;
while (!RET) { IP.p = W.p + 1;
while (rstack != rstack_mem) {
cell codeptr;
W = *IP.p; W = *IP.p;
IP.p++; IP.p++;
W.p->f(); codeptr = *W.p;
if (codeptr.f == f_docolon) {
RPUSH(IP);
IP.p = W.p + 1;
} else {
codeptr.f();
}
} }
RET = 0;
IP = *RPOP();
} }
void f_ret() {
RET = 1; void f_noop() {
} }
void f_donumber() { void f_donumber() {
@ -203,63 +207,100 @@ void f_streq() {
TOP().i = result == 0; TOP().i = result == 0;
} }
void f_lookup() { // name -- code pointer void f_lookup() { // name -- (codepointer flags) | (name 0)
cell *entry = LATEST; cell *entry = LATEST;
while (entry) { while (entry) {
f_dup(); f_dup();
PUSHP(entry + 2); PUSHP(entry + 2);
f_streq(); f_streq();
if (TOP().i) { if (TOP().i) {
DROP(1); unsigned int flags = entry[1].u;
TOP().p = CELL_OFFSET(entry + 2, entry[1].u + 1); TOP().u = flags;
ST1().p = CELL_OFFSET(entry + 2, (flags & ~F_IMMEDIATE) + 1);
return; return;
} }
DROP(1); DROP(1);
entry = entry->p; entry = entry->p;
} }
TOP().p = NULL; PUSHU(0);
} }
void f_def() { void f_compileon() {
cell *herebefore = HERE; STATE.i = 1;
cell *latestbefore = LATEST; }
void f_compileoff() {
STATE.i = 0;
}
void f_immediate() {
cell *flags = LATEST + 1;
flags->u |= F_IMMEDIATE;
}
void f_semicolon() {
PUSHS("_RET");
f_lookup();
DROP(1);
f_comma();
f_compileoff();
}
void f_ret() {
IP = *RPOP();
}
void f_colon() {
f_word(); f_word();
f_create(); f_create();
PUSHP(f_docolon); PUSHP(f_docolon);
f_comma(); f_comma();
while(1) { f_compileon();
f_word(); // w }
f_dup(); // w w
f_lookup(); // w code void f_interpretword() { // codefield flags --
if (TOP().p == NULL) { if (!STATE.i || (TOP().u & F_IMMEDIATE)) {
DROP(1); // w DROP(1);
f_dup(); // w w W = TOP(); // w code
f_number(); // w n isnum DROP(1);
if (TOP().i) { W.p->f();
PUSHS("_DONUMBER");
f_lookup(); // w n isnum _donumber
f_comma();
PUSHI(ST1().i); // w n isnum n
f_comma(); // w n isnum
DROP(3);
} else { } else {
DROP(2); // w DROP(1);
HERE = herebefore; f_comma();
LATEST = latestbefore; }
}
void f_interpretnumber() { // number --
if (STATE.i) {
PUSHS("_DONUMBER");
f_lookup();
DROP(1);
f_comma();
f_comma();
}
}
void f_interpretunknown() { // name --
f_puts(); f_puts();
PUSHS("?\n"); PUSHS("?\n");
f_puts(); f_puts();
f_cr(); }
return;
} void f_compileword() { // name --
} else if (TOP().p->f == f_ret) { f_lookup();
f_comma(); if (!TOP().u) { // name 0
DROP(1); DROP(1); // name
return; f_dup(); // name name
f_number(); // name n isnum
if (TOP().i) {
f_rot(); // name n isnum -- n isnum name
DROP(2); // n isnum w -- n
f_interpretnumber();
} else { } else {
f_comma(); DROP(2); // name
DROP(1); f_interpretunknown();
} }
} else { // codepointer flags
f_interpretword();
} }
} }
@ -273,26 +314,7 @@ void f_interpret(char *input) {
DROP(1); DROP(1);
return; return;
} }
f_dup(); // w w f_compileword();
f_lookup(); // w code
if (TOP().p == NULL) {
DROP(1); // w
f_dup(); // w w
f_number(); // w n isnum
if (TOP().i) {
f_rot(); // w n isnum -- n isnum w
DROP(2); // n isnum w -- n
continue;
}
DROP(2); // w
f_puts();
PUSHS("?\n");
f_puts();
return;
}
W = TOP(); // w code
DROP(2);
W.p->f();
if (stack < stack_mem) { if (stack < stack_mem) {
stack = stack_mem; stack = stack_mem;
PUSHS("stack underflow!\n"); PUSHS("stack underflow!\n");
@ -302,6 +324,45 @@ void f_interpret(char *input) {
} }
} }
void f_if() {
if (STATE.i) {
PUSHC(W);
f_comma();
PUSHP(HERE);
PUSHP(NULL);
f_comma();
} else {
if (TOP().u) {
IP.p ++;
} else {
IP.p = IP.p->p; // skip to then
}
DROP(1);
}
}
void f_else() {
if (STATE.i) {
PUSHC(W);
f_comma();
TOP().p->p = HERE + 1;
TOP().p = HERE;
PUSHP(NULL);
f_comma();
} else {
IP.p = IP.p->p;
}
}
void f_then() {
TOP().p->p = HERE;
DROP(1);
}
int DIE = 0; int DIE = 0;
void f_quit() { void f_quit() {
DIE = 1; DIE = 1;
@ -309,12 +370,19 @@ void f_quit() {
#define CDEF(name, def) PUSHP(def); PUSHS(name); f_cdef() #define CDEF(name, def) PUSHP(def); PUSHS(name); f_cdef()
void f_init() { void f_init() {
CDEF(":", f_def); CDEF("[", f_compileoff); f_immediate();
CDEF(";", f_ret); CDEF("]", f_compileon);
CDEF("immediate", f_immediate);
CDEF("create", f_create);
CDEF(":", f_colon);
CDEF(";", f_semicolon); f_immediate();
CDEF("+", f_add); CDEF("+", f_add);
CDEF("-", f_sub); CDEF("-", f_sub);
CDEF("@", f_get); CDEF("@", f_get);
CDEF("!", f_set); CDEF("!", f_set);
CDEF("if", f_if); f_immediate();
CDEF("else", f_else); f_immediate();
CDEF("then", f_then); f_immediate();
CDEF("dup", f_dup); CDEF("dup", f_dup);
CDEF("drop", f_drop); CDEF("drop", f_drop);
CDEF("swap", f_drop); CDEF("swap", f_drop);
@ -322,9 +390,11 @@ void f_init() {
CDEF("emit", f_emit); CDEF("emit", f_emit);
CDEF("number", f_number); CDEF("number", f_number);
CDEF("_DONUMBER", f_donumber); CDEF("_DONUMBER", f_donumber);
CDEF("_RET", f_ret);
CDEF(".", f_dot); CDEF(".", f_dot);
CDEF(".s", f_puts); CDEF(".s", f_puts);
CDEF(",", f_comma); CDEF(",", f_comma);
CDEF("noop", f_noop);
CDEF("quit", f_quit); CDEF("quit", f_quit);
f_interpret(": -rot rot rot ;"); f_interpret(": -rot rot rot ;");
} }

BIN
forp.exe

Binary file not shown.