diff --git a/boot.jor b/boot.jor new file mode 100755 index 0000000..f764b7a --- /dev/null +++ b/boot.jor @@ -0,0 +1,42 @@ +2 const cell +: cells cell * ; + +key ) const ')' + +10 const '\n' +key const sp + +128 const F_IMMEDIATE + +: cr '\n' emit ; +: bl sp emit ; + +: if ' BZ_ , here 0 , ; immediate +: else ' GOTO_ , 0 , here swap ! here cell - ; immediate +: then here swap ! ; immediate + +: begin here ; immediate +: while ' BZ_ , here 0 , ; immediate +: repeat ' GOTO_ , swap , here swap ! ; immediate +: again ' GOTO_ , , ; immediate +: until ' BZ_ , , ; immediate + +: ( begin key ')' = until ; immediate +: lit ' LIT_ , , ; + +: interpretword F_IMMEDIATE & state not or if execute else , then ; +: interpretnumber state if lit then ; +: interpretunknown type s" ?" type cr ; +: compileword lookup dup + if interpretword + else drop number + if interpretnumber + else interpretunknown + then + then ; +: interpreter + begin word dup b@ while compileword repeat + s" ok" type cr drop ; +: load-input swap-input r> r> interpreter r< r< swap-input ; +: loadstring ' key-string load-input drop drop ; +: loadfile ' key-file load-input drop close ; diff --git a/defs.jor b/defs.jor index cc50ffd..10f3b98 100755 --- a/defs.jor +++ b/defs.jor @@ -2,29 +2,6 @@ s" jorth.log" open const LOGFILE : log-emit LOGFILE fputc ; -2 const cell -: cells cell * ; - -key ) const ')' - -10 const '\n' -key const sp - -: cr '\n' emit ; -: bl sp emit ; - -: if ' BZ_ , here 0 , ; immediate -: else ' GOTO_ , 0 , here swap ! here cell - ; immediate -: then here swap ! ; immediate - -: begin here ; immediate -: while ' BZ_ , here 0 , ; immediate -: repeat ' GOTO_ , swap , here swap ! ; immediate -: again ' GOTO_ , , ; immediate -: until ' BZ_ , , ; immediate - -: ( begin key ')' = until ; immediate - ' cells @ const docolon ( get the colon execution token ) : :noname here docolon , ] ; @@ -39,8 +16,6 @@ key const sp 1 + ( cp i+1 ) repeat drop drop then drop ; -: lit ' LIT_ , , ; - ( tasks ) : mailbox 2 cells + ; : task-ip task-user-size cells + ; diff --git a/game.exe b/game.exe index 368ef8a..d067456 100755 Binary files a/game.exe and b/game.exe differ diff --git a/game.prj b/game.prj index 4e2502c..8927fc9 100755 Binary files a/game.prj and b/game.prj differ diff --git a/jorth.c b/jorth.c index 1795397..004a0ff 100755 --- a/jorth.c +++ b/jorth.c @@ -88,6 +88,11 @@ BINOP(f_uge, u, >=) BINOP(f_ugt, u, >) BINOP(f_ult, u, <) BINOP(f_ule, u, <=) +BINOP(f_and, u, &&) +BINOP(f_or, u, ||) +BINOP(f_bitand, u, &) +BINOP(f_bitor, u, |) +BINOP(f_bitxor, u, ^) void f_eq0() { TOP().i = (TOP().i == 0); @@ -146,6 +151,15 @@ void f_rot() { // a b c -- b c a ST2() = b; } +void f_rput() { + RPUSH(TOP()); + DROP(1); +} + +void f_rtake() { + PUSHC(*RPOP()); +} + void f_cexecute(); void f_key_string() { @@ -180,8 +194,9 @@ void f_key_file() { void f_key() { cell *keyword = RUNNING + TASK_USER_KEY; cell *echoword = RUNNING + TASK_USER_ECHO; - if (keyword->f) { - keyword->f(); + if (keyword->p) { + PUSHCP(keyword->p); + f_cexecute(); } else { PUSHI(0); } @@ -368,11 +383,15 @@ void f_lit_() { IP.p++; } -void f_number() { // str -- num isnum +void f_number() { // str -- (num 1 | str 0) int num = 0, result; result = sscanf(TOP().s, "%d", &num); - TOP().i = num; - PUSHI(result == 1); + if (result == 1) { + TOP().i = num; + PUSHI(result == 1); + } else { + PUSHI(0); + } } void f_streq() { @@ -381,16 +400,30 @@ void f_streq() { TOP().i = result == 0; } +void f_wordname() { + TOP().p = TOP().p + 2; +} +void f_wordflags() { + TOP().u = TOP().p[1].u; +} +void f_codepointer() { + unsigned int flags = TOP().p[1].u; + TOP().p = CELL_OFFSET(TOP().p + 2, (flags & ~F_IMMEDIATE) + 1); +} + void f_lookup() { // name -- (codepointer flags) | (name 0) cell *entry = LATEST; while (entry) { f_dup(); - PUSHP(entry + 2); + PUSHP(entry); + f_wordname(); f_streq(); if (TOP().i) { - unsigned int flags = entry[1].u; - TOP().u = flags; - ST1().p = CELL_OFFSET(entry + 2, (flags & ~F_IMMEDIATE) + 1); + TOP().p = entry; + f_codepointer(); + f_swap(); + TOP().p = entry; + f_wordflags(); return; } DROP(1); @@ -402,13 +435,15 @@ void f_lookup() { // name -- (codepointer flags) | (name 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; + PUSHCP(entry); + f_codepointer(); + if (TOP().p == ST1().p) { + DROP(1); + TOP().p = entry; + f_wordname(); return; } + DROP(1); entry = entry->p; } TOP().p = NULL; @@ -477,14 +512,12 @@ void f_compileword() { // name -- f_lookup(); if (!TOP().u) { // name 0 DROP(1); // name - f_dup(); // name name - f_number(); // name n isnum + f_number(); // n isnum if (TOP().i) { - f_rot(); // name n isnum -- n isnum name - DROP(2); // n isnum w -- n + DROP(1); f_interpretnumber(); } else { - DROP(2); // name + DROP(1); f_interpretunknown(); } } else { // codepointer flags @@ -512,37 +545,21 @@ void f_open() { } void f_close() { - fclose(TOP().fp); - DROP(1); -} - -void f__loadfile() { - cell *key = RUNNING + TASK_USER_KEY; - cell *keysrc = RUNNING + TASK_USER_KEYSRC; - cell oldKey = *key; - cell oldKeysrc = *keysrc; - key->f = f_key_file; - keysrc->fp = TOP().fp; - DROP(1); - f_interpreter(); - if (key->fp != NULL) { - fclose(key->fp); + if (TOP().fp) { + fclose(TOP().fp); } - *key = oldKey; - *keysrc = oldKeysrc; + DROP(1); } -void f_loadstring() { +void f_swapinput() { cell *key = RUNNING + TASK_USER_KEY; cell *keysrc = RUNNING + TASK_USER_KEYSRC; cell oldKey = *key; cell oldKeysrc = *keysrc; - key->f = f_key_string; - keysrc->s = TOP().s; - DROP(1); - f_interpreter(); - *key = oldKey; - *keysrc = oldKeysrc; + *key = TOP(); + *keysrc = ST1(); + TOP() = oldKey; + ST1() = oldKeysrc; } void f_taskemit() { @@ -650,12 +667,18 @@ void f_quote() { void f_loadfile(char *filename) { PUSHS(filename); f_open(); - f__loadfile(); + PUSHS("loadfile"); + f_lookup(); + DROP(1); + f_cexecute(); } void f_runstring(char *s) { PUSHS(s); - f_loadstring(); + PUSHS("loadstring"); + f_lookup(); + DROP(1); + f_cexecute(); } void f_quiet() { @@ -716,11 +739,13 @@ void f_rstacksize() { void f_taskusersize() { PUSHU(TASK_USER_SIZE); } -#define CDEF(name, def) PUSHP(def); PUSHS(name); f_cdef() + void f_init() { CDEF("[", f_compileoff); f_immediate(); CDEF("]", f_compileon); CDEF("key", f_key); + CDEF("key-string", f_key_string); + CDEF("key-file", f_key_file); CDEF("emit", f_emit); CDEF("word", f_word); CDEF("immediate", f_immediate); @@ -753,6 +778,11 @@ void f_init() { CDEF("u>", f_ugt); CDEF("u<", f_ult); CDEF("u<=", f_ule); + CDEF("and", f_and); + CDEF("or", f_or); + CDEF("&", f_bitand); + CDEF("|", f_bitor); + CDEF("^", f_bitxor); CDEF("@", f_get); CDEF("!", f_set); CDEF("b@", f_bget); @@ -762,9 +792,12 @@ void f_init() { CDEF("drop", f_drop); CDEF("swap", f_swap); CDEF("rot", f_rot); + CDEF("r>", f_rput); + CDEF("r<", f_rtake); CDEF("emit", f_emit); CDEF("task-emit", f_taskemit); CDEF("task-echo", f_taskecho); + CDEF("swap-input", f_swapinput); CDEF("putc", f_putc); CDEF("fputc", f_fputc); CDEF("number", f_number); @@ -784,8 +817,6 @@ void f_init() { CDEF("noop", f_noop); CDEF("open", f_open); CDEF("close", f_close); - CDEF("loadfile", f__loadfile); - CDEF("loadstring", f_loadstring); CDEF("quiet", f_quiet); CDEF("loud", f_loud); CDEF("task", f_task); @@ -796,6 +827,16 @@ void f_init() { CDEF("rstacksize", f_rstacksize); CDEF("task-user-size", f_taskusersize); + PUSHS("boot.jor"); + f_open(); + PUSHS("key-file"); + f_lookup(); + DROP(1); + f_swapinput(); + f_interpreter(); + f_swapinput(); + DROP(2); + f_loadfile("defs.jor"); } @@ -805,17 +846,11 @@ void f_quit() { } void f_repl() { - char inputbuf[256]; - CDEF("quit", f_quit); + char input[256]; + CDEF("quit", f_quit); + f_runstring("stdout"); while (!DIE) { - int len; - gets(inputbuf); - len = strlen(inputbuf); - inputbuf[len] = '\n'; - inputbuf[len + 1] = 0; - PUSHS(inputbuf); - f_runstring("REPL send"); - f_taskloop(); + f_runstring(gets(input)); } -} \ No newline at end of file +} diff --git a/jorth.h b/jorth.h index 256231b..348b18d 100755 --- a/jorth.h +++ b/jorth.h @@ -6,6 +6,7 @@ void f_init(); +void f_cdef(); #define CDEF(name, def) PUSHP(def); PUSHS(name); f_cdef() void f_immediate(); diff --git a/temp.jor b/temp.jor new file mode 100755 index 0000000..35ca569 --- /dev/null +++ b/temp.jor @@ -0,0 +1,13 @@ +: interpretword F_IMMEDIATE & state not or if execute else , then ; +: compileword lookup dup + if interpretword + else drop dup number + if swap drop interpretnumber + else drop interpretunknown + then + then ; +: interpreter + begin word dup b@ while compileword repeat + s" ok\n" type drop ; +: loadstring +: loadfile