diff --git a/forp.c b/forp.c index 3be75fe..1f4ab57 100755 --- a/forp.c +++ b/forp.c @@ -44,6 +44,18 @@ void PUSHS(char *s) { stack->s = s; stack++; } void RPUSH(cell c) { *rstack = c; rstack++; } #define RPOP() (--rstack) +void f_here() { + PUSHCP(HERE); +} + +void f_latest() { + PUSHCP(LATEST); +} + +void f_state() { + PUSHC(STATE); +} + void f_add() { cell r = TOP(); DROP(1); @@ -64,6 +76,7 @@ void f_set() { cell *p = TOP().p; DROP(1); (*p) = TOP(); + DROP(1); } void f_drop() { @@ -75,10 +88,10 @@ void f_dup() { } void f_swap() { - cell top = ST1(); - cell st1 = TOP(); - ST1() = st1; - TOP() = top; + cell top = TOP(); + cell st1 = ST1(); + TOP() = st1; + ST1() = top; } void f_rot() { // a b c -- b c a @@ -128,16 +141,24 @@ void f_emit() { DROP(1); } -void f_dot() { - printf("%d ", TOP().i); +void f_puts() { + char *s = TOP().s; + while (s && *s) { + PUSHI(*s); + f_emit(); + s++; + } DROP(1); } -void f_puts() { - printf("%s", TOP().s); - DROP(1); +void f_dot() { + static char num[16]; + sprintf(num, "%d ", TOP().i); + TOP().s = num; + f_puts(); } + void f_cr() { PUSHI('\n'); f_emit(); @@ -189,7 +210,7 @@ void f_docolon() { void f_noop() { } -void f_donumber() { +void f_push_() { PUSHC(*IP.p); IP.p++; } @@ -225,6 +246,21 @@ void f_lookup() { // name -- (codepointer flags) | (name 0) PUSHU(0); } +void f_revlookup() { // codepointer -- name + cell *entry = LATEST; + while (entry) { + unsigned int length = entry[1].u & ~F_IMMEDIATE; + cell *name = entry + 2; + cell *cp = CELL_OFFSET(name, length + 1); + if (cp == TOP().p) { + TOP().p = name; + return; + } + entry = entry->p; + } + TOP().p = NULL; +} + void f_compileon() { STATE.i = 1; } @@ -236,12 +272,11 @@ void f_immediate() { cell *flags = LATEST + 1; flags->u |= F_IMMEDIATE; } +void f_compileword(); void f_semicolon() { PUSHS("_RET"); - f_lookup(); - DROP(1); - f_comma(); + f_compileword(); f_compileoff(); } @@ -271,10 +306,8 @@ void f_interpretword() { // codefield flags -- void f_interpretnumber() { // number -- if (STATE.i) { - PUSHS("_DONUMBER"); - f_lookup(); - DROP(1); - f_comma(); + PUSHS("PUSH_"); + f_compileword(); f_comma(); } } @@ -325,37 +358,34 @@ void f_interpret(char *input) { } void f_if() { - if (STATE.i) { - PUSHC(W); - f_comma(); - PUSHP(HERE); - PUSHP(NULL); - f_comma(); + PUSHS("IF_"); + f_compileword(); + PUSHP(HERE); + PUSHP(NULL); + f_comma(); +} + +void f_if_() { + if (TOP().u) { + IP.p ++; } else { - if (TOP().u) { - IP.p ++; - } else { - IP.p = IP.p->p; // skip to then - } - DROP(1); + IP.p = IP.p->p; // skip to else or then } + DROP(1); } void f_else() { - if (STATE.i) { + PUSHS("GOTO_"); + f_compileword(); + PUSHP(NULL); + f_comma(); - PUSHC(W); - f_comma(); + TOP().p->p = HERE; // make false condition of IF come here + TOP().p = HERE - 1; // make THEN patch our goto +} - TOP().p->p = HERE + 1; - TOP().p = HERE; - - PUSHP(NULL); - f_comma(); - - } else { - IP.p = IP.p->p; - } +void f_goto_() { + IP.p = IP.p->p; } void f_then() { @@ -363,6 +393,17 @@ void f_then() { DROP(1); } +void f_quote() { + if (STATE.i) { + PUSHS("PUSH_"); + f_compileword(); + } else { + f_word(); + f_lookup(); + DROP(1); + } +} + int DIE = 0; void f_quit() { DIE = 1; @@ -372,31 +413,41 @@ void f_quit() { void f_init() { CDEF("[", f_compileoff); f_immediate(); CDEF("]", f_compileon); + CDEF("key", f_key); + CDEF("emit", f_emit); + CDEF("word", f_word); CDEF("immediate", f_immediate); CDEF("create", f_create); + CDEF("here", f_here); + CDEF("latest", f_latest); + CDEF("state", f_state); + CDEF("'", f_quote); f_immediate(); + CDEF("`", f_revlookup); 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); + CDEF("swap", f_swap); CDEF("rot", f_rot); CDEF("emit", f_emit); CDEF("number", f_number); - CDEF("_DONUMBER", f_donumber); + CDEF("PUSH_", f_push_); + CDEF("GOTO_", f_goto_); + CDEF("IF_", f_if_); 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 ;"); + f_interpret(": if ' IF_ , here 0 , ; immediate"); + f_interpret(": else ' GOTO_ , 0 , here swap ! here 2 - ; immediate"); + f_interpret(": then here swap ! ; immediate"); + } int main() { diff --git a/forp.exe b/forp.exe index ee51646..37caadb 100755 Binary files a/forp.exe and b/forp.exe differ