Forp: Refactor interpreter, inline VM loop, implement if/then and immediate words
This commit is contained in:
parent
b9fec53c09
commit
c0f19f7674
212
forp.c
212
forp.c
|
@ -28,6 +28,8 @@ cell *stack = stack_mem;
|
|||
|
||||
char *INPUT = NULL;
|
||||
|
||||
#define F_IMMEDIATE 0x80
|
||||
|
||||
#define CELL_OFFSET(cp, b) ((cell*)(((char *)(cp)) + b))
|
||||
#define TOP() (*(stack - 1))
|
||||
#define ST1() (*(stack - 2))
|
||||
|
@ -88,7 +90,6 @@ void f_rot() { // a b c -- b c a
|
|||
ST2() = b;
|
||||
}
|
||||
|
||||
|
||||
void f_key() {
|
||||
if (INPUT) {
|
||||
PUSHI(*INPUT);
|
||||
|
@ -166,23 +167,26 @@ void f_cdef() { // func name --
|
|||
DROP(1);
|
||||
}
|
||||
|
||||
|
||||
int RET = 0;
|
||||
void f_docolon() {
|
||||
RPUSH(IP);
|
||||
IP.p = W.p + 1;
|
||||
RPUSH(W);
|
||||
|
||||
while (!RET) {
|
||||
IP.p = W.p + 1;
|
||||
while (rstack != rstack_mem) {
|
||||
cell codeptr;
|
||||
W = *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() {
|
||||
|
@ -203,63 +207,100 @@ void f_streq() {
|
|||
TOP().i = result == 0;
|
||||
}
|
||||
|
||||
void f_lookup() { // name -- code pointer
|
||||
void f_lookup() { // name -- (codepointer flags) | (name 0)
|
||||
cell *entry = LATEST;
|
||||
while (entry) {
|
||||
f_dup();
|
||||
PUSHP(entry + 2);
|
||||
f_streq();
|
||||
if (TOP().i) {
|
||||
DROP(1);
|
||||
TOP().p = CELL_OFFSET(entry + 2, entry[1].u + 1);
|
||||
unsigned int flags = entry[1].u;
|
||||
TOP().u = flags;
|
||||
ST1().p = CELL_OFFSET(entry + 2, (flags & ~F_IMMEDIATE) + 1);
|
||||
return;
|
||||
}
|
||||
DROP(1);
|
||||
entry = entry->p;
|
||||
}
|
||||
TOP().p = NULL;
|
||||
PUSHU(0);
|
||||
}
|
||||
|
||||
void f_def() {
|
||||
cell *herebefore = HERE;
|
||||
cell *latestbefore = LATEST;
|
||||
void f_compileon() {
|
||||
STATE.i = 1;
|
||||
}
|
||||
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_create();
|
||||
PUSHP(f_docolon);
|
||||
f_comma();
|
||||
while(1) {
|
||||
f_word(); // w
|
||||
f_dup(); // w w
|
||||
f_lookup(); // w code
|
||||
if (TOP().p == NULL) {
|
||||
DROP(1); // w
|
||||
f_dup(); // w w
|
||||
f_number(); // w n isnum
|
||||
if (TOP().i) {
|
||||
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 {
|
||||
DROP(2); // w
|
||||
HERE = herebefore;
|
||||
LATEST = latestbefore;
|
||||
f_puts();
|
||||
PUSHS("?\n");
|
||||
f_puts();
|
||||
f_cr();
|
||||
return;
|
||||
}
|
||||
} else if (TOP().p->f == f_ret) {
|
||||
f_comma();
|
||||
DROP(1);
|
||||
return;
|
||||
f_compileon();
|
||||
}
|
||||
|
||||
void f_interpretword() { // codefield flags --
|
||||
if (!STATE.i || (TOP().u & F_IMMEDIATE)) {
|
||||
DROP(1);
|
||||
W = TOP(); // w code
|
||||
DROP(1);
|
||||
W.p->f();
|
||||
} else {
|
||||
DROP(1);
|
||||
f_comma();
|
||||
}
|
||||
}
|
||||
|
||||
void f_interpretnumber() { // number --
|
||||
if (STATE.i) {
|
||||
PUSHS("_DONUMBER");
|
||||
f_lookup();
|
||||
DROP(1);
|
||||
f_comma();
|
||||
f_comma();
|
||||
}
|
||||
}
|
||||
|
||||
void f_interpretunknown() { // name --
|
||||
f_puts();
|
||||
PUSHS("?\n");
|
||||
f_puts();
|
||||
}
|
||||
|
||||
void f_compileword() { // name --
|
||||
f_lookup();
|
||||
if (!TOP().u) { // name 0
|
||||
DROP(1); // name
|
||||
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 {
|
||||
f_comma();
|
||||
DROP(1);
|
||||
DROP(2); // name
|
||||
f_interpretunknown();
|
||||
}
|
||||
} else { // codepointer flags
|
||||
f_interpretword();
|
||||
}
|
||||
}
|
||||
|
||||
|
@ -273,26 +314,7 @@ void f_interpret(char *input) {
|
|||
DROP(1);
|
||||
return;
|
||||
}
|
||||
f_dup(); // w w
|
||||
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();
|
||||
f_compileword();
|
||||
if (stack < stack_mem) {
|
||||
stack = stack_mem;
|
||||
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;
|
||||
void f_quit() {
|
||||
DIE = 1;
|
||||
|
@ -309,12 +370,19 @@ void f_quit() {
|
|||
|
||||
#define CDEF(name, def) PUSHP(def); PUSHS(name); f_cdef()
|
||||
void f_init() {
|
||||
CDEF(":", f_def);
|
||||
CDEF(";", f_ret);
|
||||
CDEF("[", f_compileoff); f_immediate();
|
||||
CDEF("]", f_compileon);
|
||||
CDEF("immediate", f_immediate);
|
||||
CDEF("create", f_create);
|
||||
CDEF(":", f_colon);
|
||||
CDEF(";", f_semicolon); f_immediate();
|
||||
CDEF("+", f_add);
|
||||
CDEF("-", f_sub);
|
||||
CDEF("@", f_get);
|
||||
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("drop", f_drop);
|
||||
CDEF("swap", f_drop);
|
||||
|
@ -322,9 +390,11 @@ void f_init() {
|
|||
CDEF("emit", f_emit);
|
||||
CDEF("number", f_number);
|
||||
CDEF("_DONUMBER", f_donumber);
|
||||
CDEF("_RET", f_ret);
|
||||
CDEF(".", f_dot);
|
||||
CDEF(".s", f_puts);
|
||||
CDEF(",", f_comma);
|
||||
CDEF("noop", f_noop);
|
||||
CDEF("quit", f_quit);
|
||||
f_interpret(": -rot rot rot ;");
|
||||
}
|
||||
|
|
Loading…
Reference in a new issue