diff --git a/forp.c b/forp.c index 4876719..3be75fe 100755 --- a/forp.c +++ b/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 ;"); } diff --git a/forp.exe b/forp.exe index a57a2e9..ee51646 100755 Binary files a/forp.exe and b/forp.exe differ