diff --git a/defs.frp b/defs.jor similarity index 87% rename from defs.frp rename to defs.jor index 47b8bf5..cc50ffd 100755 --- a/defs.frp +++ b/defs.jor @@ -1,5 +1,5 @@ : stdout ' putc task-emit ! ; -s" forp.log" open const LOGFILE +s" jorth.log" open const LOGFILE : log-emit LOGFILE fputc ; 2 const cell @@ -25,6 +25,9 @@ key const sp : ( begin key ')' = until ; immediate +' cells @ const docolon ( get the colon execution token ) +: :noname here docolon , ] ; + : 2dup over over ; : decompile diff --git a/game.exe b/game.exe index 309ff68..368ef8a 100755 Binary files a/game.exe and b/game.exe differ diff --git a/game.frp b/game.frp deleted file mode 100755 index 89c3051..0000000 --- a/game.frp +++ /dev/null @@ -1,7 +0,0 @@ -: start-repl activate - ' seremit task-emit ! - ' log-emit task-echo ! - begin receive loadstring again ; -task const REPL - -REPL start-repl diff --git a/game.jor b/game.jor new file mode 100755 index 0000000..9c4b4f5 --- /dev/null +++ b/game.jor @@ -0,0 +1,37 @@ +: blah + ' seremit task-emit ! + ' log-emit task-echo ! ; + +: start-repl activate blah + s" .:: J O R T H ( jean forth) ::." type cr + begin receive loadstring again ; +task const REPL +REPL start-repl + +task const TEST + +1 const ^ESC +28 const ^ENTER +29 const ^CTRL +56 const ^ALT +57 const ^SPACE +72 const ^UP +75 const ^LEFT +77 const ^RIGHT +80 const ^DOWN + +: wait-key ( k -- ) begin dup key-pressed not while suspend repeat drop ; +: udelta ( u u -- u ) + 2dup u> if + swap -1 swap - + 1 + + else + swap - + then ; +: sleep ( count -- ) + ticks swap begin over ticks udelta over u< while suspend repeat drop drop ; +: test TEST activate blah + ^SPACE wait-key + s" SPACE" type + 30 sleep + s" is big" type ; +test diff --git a/game.prj b/game.prj index 71e7b98..4e2502c 100755 Binary files a/game.prj and b/game.prj differ diff --git a/forp.c b/jorth.c similarity index 85% rename from forp.c rename to jorth.c index 38f4b87..1795397 100755 --- a/forp.c +++ b/jorth.c @@ -1,5 +1,6 @@ #include -#include "forp.h" +#include "jorth.h" +#include "serial.h" #define TASK_REGISTER_SIZE 3 #define TASK_USER_SIZE 8 @@ -66,23 +67,27 @@ void f_running() { PUSHCP(RUNNING); } -#define BINOP(name, op) \ +#define BINOP(name, type, op) \ void name() { \ cell r = TOP(); \ DROP(1); \ - TOP().i = TOP().i op r.i; \ + TOP().type = TOP().type op r.type; \ } -BINOP(f_add, +) -BINOP(f_sub, -) -BINOP(f_mul, *) -BINOP(f_div, /) -BINOP(f_eq, ==) -BINOP(f_neq, !=) -BINOP(f_ge, >=) -BINOP(f_gt, >) -BINOP(f_lt, <) -BINOP(f_le, <=) +BINOP(f_add, i, +) +BINOP(f_sub, i, -) +BINOP(f_mul, i, *) +BINOP(f_div, i, /) +BINOP(f_eq, i, ==) +BINOP(f_neq, i, !=) +BINOP(f_ge, i, >=) +BINOP(f_gt, i, >) +BINOP(f_lt, i, <) +BINOP(f_le, i, <=) +BINOP(f_uge, u, >=) +BINOP(f_ugt, u, >) +BINOP(f_ult, u, <) +BINOP(f_ule, u, <=) void f_eq0() { TOP().i = (TOP().i == 0); @@ -141,7 +146,7 @@ void f_rot() { // a b c -- b c a ST2() = b; } -void f_execute(); +void f_cexecute(); void f_key_string() { cell *INPUT = RUNNING + TASK_USER_KEYSRC; @@ -183,7 +188,7 @@ void f_key() { if (!QUIET.i && echoword->p) { f_dup(); PUSHCP(echoword->p); - f_execute(); + f_cexecute(); } } @@ -215,12 +220,16 @@ void f_emit() { if (echoword->p) { f_dup(); PUSHCP(echoword->p); - f_execute(); + f_cexecute(); } if (emitword->p) { PUSHCP(emitword->p); - f_execute(); + f_cexecute(); + } else { + DROP(1); } + } else { + DROP(1); } } @@ -251,6 +260,13 @@ void f_dot() { f_puts(); } +void f_udot() { + static char num[16]; + sprintf(num, "%u ", TOP().i); + TOP().s = num; + f_puts(); +} + void f_printstack() { cell *v = RUNNING + STACK_OFFSET; while (v != stack) { @@ -295,34 +311,39 @@ void f_cdef() { // func name -- } void f_docolon(); -// C code must always call a colon word through f_execute() -void f_execute() { +// C code must always call a colon word through f_cexecute() +void f_cexecute() { cell oldW = W; cell oldIP = IP; cell retIP; retIP.p = NULL; + W = TOP(); + DROP(1); if (W.p->f == f_docolon) { RPUSH(retIP); } - W = TOP(); - DROP(1); W.p->f(); W = oldW; IP = oldIP; } +void f_colondispatch() { + cell codeptr; + + codeptr = *W.p; + if (codeptr.f == f_docolon) { + RPUSH(IP); + IP.p = W.p + 1; + } else { + codeptr.f(); + } +} + void f_colonloop() { while (IP.p) { - cell codeptr; W = *IP.p; IP.p++; - codeptr = *W.p; - if (codeptr.f == f_docolon) { - RPUSH(IP); - IP.p = W.p + 1; - } else { - codeptr.f(); - } + f_colondispatch(); } } @@ -331,6 +352,14 @@ void f_docolon() { f_colonloop(); } +// this version of f_execute can be run from a colon word +// (though not currently from the interpreter?) +void f_execute() { + W = TOP(); + DROP(1); + f_colondispatch(); +} + void f_noop() { } @@ -423,7 +452,7 @@ void f_colon() { void f_interpretword() { // codefield flags -- if (!STATE.i || (TOP().u & F_IMMEDIATE)) { DROP(1); - f_execute(); + f_cexecute(); } else { DROP(1); f_comma(); @@ -536,6 +565,19 @@ void f_const() { f_comma(); } +void f_dovar() { + PUSHCP(W.p + 1); +} + +void f_var() { + f_word(); + f_create(); + PUSHP(f_dovar); + f_comma(); + PUSHI(0); + f_comma(); +} + void f_bz_() { if (!TOP().u) { IP.p = IP.p->p; // branch @@ -682,6 +724,7 @@ void f_init() { CDEF("emit", f_emit); CDEF("word", f_word); CDEF("immediate", f_immediate); + CDEF("execute", f_execute); CDEF("create", f_create); CDEF("here", f_here); CDEF("latest", f_latest); @@ -692,6 +735,7 @@ void f_init() { CDEF(":", f_colon); CDEF(";", f_semicolon); f_immediate(); CDEF("const", f_const); + CDEF("var", f_var); CDEF("+", f_add); CDEF("-", f_sub); CDEF("*", f_mul); @@ -705,6 +749,10 @@ void f_init() { CDEF("=", f_eq); CDEF("<", f_lt); CDEF("<=", f_le); + CDEF("u>=", f_uge); + CDEF("u>", f_ugt); + CDEF("u<", f_ult); + CDEF("u<=", f_ule); CDEF("@", f_get); CDEF("!", f_set); CDEF("b@", f_bget); @@ -726,6 +774,7 @@ void f_init() { CDEF("BNZ_", f_bnz_); CDEF("ret", f_ret); CDEF(".", f_dot); + CDEF("u.", f_udot); CDEF("type", f_puts); CDEF(".s", f_printstack); CDEF(",", f_comma); @@ -747,7 +796,7 @@ void f_init() { CDEF("rstacksize", f_rstacksize); CDEF("task-user-size", f_taskusersize); - f_loadfile("defs.frp"); + f_loadfile("defs.jor"); } int DIE = 0; diff --git a/forp.h b/jorth.h similarity index 100% rename from forp.h rename to jorth.h diff --git a/testbed.c b/testbed.c index e0e4b13..e44853c 100755 --- a/testbed.c +++ b/testbed.c @@ -8,7 +8,8 @@ #include "tiff.h" #include "tiles.h" #include "serial.h" -#include "forp.h" +#include "timer.h" +#include "jorth.h" /*** S C R A T C H ***/ @@ -94,6 +95,7 @@ void game_init() { atexit(vid_cleanup); kbd_init(); + timer_init(TIMER_30HZ); tile_init(); fillMap(); @@ -148,12 +150,6 @@ void overworldThink() { scroll(game.player.x - 152, game.player.y - 92); } -int main3() { - f_init(); - f_repl(); - return 0; -} - void f_seremit() { ser_write_byte(TOP().i); if (TOP().i == '\n') { @@ -175,6 +171,9 @@ void f_drawSprite() { // ( x y sprite -- ) void f_scroll() { // ( x y -- ) scroll(ST1().i, TOP().i); } +void f_ticks() { + PUSHU(timer_counter); +} void game_f_init() { f_init(); @@ -184,8 +183,9 @@ void game_f_init() { CDEF("sprite", f_drawSprite); CDEF("scroll", f_scroll); CDEF("draw", drawScreen); + CDEF("ticks", f_ticks); - f_loadfile("game.frp"); + f_loadfile("game.jor"); } void f_poll() { @@ -213,14 +213,14 @@ void f_poll() { line[i] = '\0'; } } + f_taskloop(); } int main() { + ser_init(SER_COM2, BAUD_19200, SER_8N1); game_init(); game_f_init(); - ser_init(SER_COM2, BAUD_19200, SER_8N1); - while (!keyIsDown(K_ESC)) { kbd_debounce(); f_poll(); diff --git a/timer.c b/timer.c new file mode 100755 index 0000000..283bd46 --- /dev/null +++ b/timer.c @@ -0,0 +1,36 @@ +#include +#include +#include "timer.h" + +#define TIMER_INTERRUPT 0x1c +#define REG_8253_CTL 0x43 +#define REG_COUNTER0 0x40 + +volatile unsigned int timer_counter = 0; + +static void interrupt (*oldTimerISR)() = NULL; + +static void interrupt timer_isr() { + timer_counter ++; + oldTimerISR(); +} + +void timer_setrate(unsigned int rate) { + outp(REG_8253_CTL, 0x3c); + outp(REG_COUNTER0, rate & 0xff); + outp(REG_COUNTER0, (rate >> 8) & 0xff); +} + +static void timer_cleanup() { + if (oldTimerISR != NULL) { + setvect(TIMER_INTERRUPT, oldTimerISR); + timer_setrate(TIMER_18HZ); + oldTimerISR = NULL; + } +} +void timer_init(unsigned int rate) { + timer_setrate(rate); + oldTimerISR = getvect(TIMER_INTERRUPT); + setvect(TIMER_INTERRUPT, timer_isr); + atexit(timer_cleanup); +} diff --git a/timer.h b/timer.h new file mode 100755 index 0000000..e896905 --- /dev/null +++ b/timer.h @@ -0,0 +1,11 @@ +#define TIMER_60HZ 0x4dae +#define TIMER_50HZ 0x5d37 +#define TIMER_40HZ 0x7486 +#define TIMER_30HZ 0x965c +#define TIMER_20HZ 0xe90b +#define TIMER_18HZ 0xffff + +extern volatile unsigned int timer_counter; + +void timer_init(unsigned int rate); +void timer_setrate(unsigned int rate);