diff --git a/forp.c b/forp.c new file mode 100755 index 0000000..4876719 --- /dev/null +++ b/forp.c @@ -0,0 +1,340 @@ +#include + +#define MEM_SIZE 16384 +#define STACK_SIZE 64 +#define RSTACK_SIZE 32 + +union cell_union; +typedef union cell_union cell; + +union cell_union { + int i; + unsigned int u; + cell *p; + char *s; + void (*f)(); +}; + +char mem[MEM_SIZE]; +cell *HERE = (cell*)mem; +cell *LATEST = NULL; +cell IP = NULL; +cell W = NULL; +cell STATE = 0; +cell rstack_mem[RSTACK_SIZE]; +cell *rstack = rstack_mem; +cell stack_mem[STACK_SIZE]; +cell *stack = stack_mem; + +char *INPUT = NULL; + +#define CELL_OFFSET(cp, b) ((cell*)(((char *)(cp)) + b)) +#define TOP() (*(stack - 1)) +#define ST1() (*(stack - 2)) +#define ST2() (*(stack - 3)) +#define DROP(n) (stack -= n) +void PUSHC(cell c) { *stack = c; stack++; } +void PUSHI(int i) { stack->i = i; stack++; } +void PUSHU(unsigned int u) { stack->u = u; stack++; } +void PUSHCP(cell *c) { stack->p = c; stack++; } +#define PUSHP(p) PUSHCP((cell*)p) +void PUSHS(char *s) { stack->s = s; stack++; } +void RPUSH(cell c) { *rstack = c; rstack++; } +#define RPOP() (--rstack) + +void f_add() { + cell r = TOP(); + DROP(1); + TOP().i += r.i; +} + +void f_sub() { + cell r = TOP(); + DROP(1); + TOP().i -= r.i; +} + +void f_get() { + TOP() = (*(TOP().p)); +} + +void f_set() { + cell *p = TOP().p; + DROP(1); + (*p) = TOP(); +} + +void f_drop() { + DROP(1); +} + +void f_dup() { + PUSHC(TOP()); +} + +void f_swap() { + cell top = ST1(); + cell st1 = TOP(); + ST1() = st1; + TOP() = top; +} + +void f_rot() { // a b c -- b c a + cell c = TOP(); + cell b = ST1(); + cell a = ST2(); + TOP() = a; + ST1() = c; + ST2() = b; +} + + +void f_key() { + if (INPUT) { + PUSHI(*INPUT); + INPUT++; + if (TOP().i == 0) { + INPUT = NULL; + } + } else { + PUSHI(0); + } +} + +void f_word() { + static char buf[32] = {0}; + int key = ' '; + int ibuf = 0; + + while (key == ' ' || key == '\n' || key == '\r') { + f_key(); + key = TOP().i; + DROP(1); + } + + while (key != ' ' && key != '\n' && key != '\r' && key != 0) { + buf[ibuf++] = key; + f_key(); + key = TOP().i; + DROP(1); + } + buf[ibuf] = 0; + PUSHS(buf); +} + +void f_emit() { + printf("%c", TOP().i); + DROP(1); +} + +void f_dot() { + printf("%d ", TOP().i); + DROP(1); +} + +void f_puts() { + printf("%s", TOP().s); + DROP(1); +} + +void f_cr() { + PUSHI('\n'); + f_emit(); +} + +void f_comma() { + *HERE++ = TOP(); + DROP(1); +} + +void f_create() { // name -- + int namelen; + HERE->p = LATEST; + LATEST = HERE; + HERE++; + namelen = strlen(TOP().s); + HERE->u = namelen; HERE ++; + memcpy(HERE, TOP().s, namelen + 1); + HERE = CELL_OFFSET(HERE, namelen + 1); + DROP(1); +} + +void f_cdef() { // func name -- + f_create(); + HERE->p = TOP().p; + HERE ++; + DROP(1); +} + + +int RET = 0; +void f_docolon() { + RPUSH(IP); + IP.p = W.p + 1; + + while (!RET) { + W = *IP.p; + IP.p++; + W.p->f(); + } + RET = 0; + IP = *RPOP(); +} + +void f_ret() { + RET = 1; +} + +void f_donumber() { + PUSHC(*IP.p); + IP.p++; +} + +void f_number() { // str -- num isnum + int num = 0, result; + result = sscanf(TOP().s, "%d", &num); + TOP().i = num; + PUSHI(result == 1); +} + +void f_streq() { + int result = strcmp(TOP().s, ST1().s); + DROP(1); + TOP().i = result == 0; +} + +void f_lookup() { // name -- code pointer + 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); + return; + } + DROP(1); + entry = entry->p; + } + TOP().p = NULL; +} + +void f_def() { + cell *herebefore = HERE; + cell *latestbefore = LATEST; + 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; + } else { + f_comma(); + DROP(1); + } + } +} + +void f_interpret(char *input) { + INPUT = input; + while(1) { + f_word(); // w + if (TOP().s[0] == '\0') { + PUSHS("ok\n"); + f_puts(); + 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(); + if (stack < stack_mem) { + stack = stack_mem; + PUSHS("stack underflow!\n"); + f_puts(); + return; + } + } +} + +int DIE = 0; +void f_quit() { + DIE = 1; +} + +#define CDEF(name, def) PUSHP(def); PUSHS(name); f_cdef() +void f_init() { + CDEF(":", f_def); + CDEF(";", f_ret); + CDEF("+", f_add); + CDEF("-", f_sub); + CDEF("@", f_get); + CDEF("!", f_set); + CDEF("dup", f_dup); + CDEF("drop", f_drop); + CDEF("swap", f_drop); + CDEF("rot", f_rot); + CDEF("emit", f_emit); + CDEF("number", f_number); + CDEF("_DONUMBER", f_donumber); + CDEF(".", f_dot); + CDEF(".s", f_puts); + CDEF(",", f_comma); + CDEF("quit", f_quit); + f_interpret(": -rot rot rot ;"); +} + +int main() { + char inputbuf[256]; + f_init(); + + while (!DIE) { + f_interpret(gets(inputbuf)); + } + return 0; +} \ No newline at end of file diff --git a/forp.exe b/forp.exe new file mode 100755 index 0000000..a57a2e9 Binary files /dev/null and b/forp.exe differ diff --git a/game.prj b/game.prj index 3135e19..cfae453 100755 Binary files a/game.prj and b/game.prj differ