diff --git a/defs.frp b/defs.frp index aa44704..f9ed1a5 100755 --- a/defs.frp +++ b/defs.frp @@ -1,3 +1,10 @@ +: stdout ' putc task-emit ! ; +s" forp.log" open const LOGFILE +: log-emit LOGFILE fputc ; + +stdout +' log-emit task-echo ! + 2 const cell : cells cell * ; @@ -16,16 +23,60 @@ key const sp : begin here ; immediate : while ' BZ_ , here 0 , ; immediate : repeat ' GOTO_ , swap , here swap ! ; immediate +: again ' GOTO_ , , ; immediate +: until ' BZ_ , , ; immediate -: ( begin key ')' != while repeat ; immediate +: ( begin key ')' = until ; immediate : 2dup over over ; : decompile - word lookup drop 1 begin ( cp i ) + word lookup if 1 begin ( cp i ) 2dup cells + @ ( cp i @cp+i ) - dup ' _RET != ( cp i @cp+i bool ) + dup ' ret != ( cp i @cp+i bool ) while - dup ` dup if .s drop else drop . then bl ( cp i ) + dup ` dup if type drop else drop . then bl ( cp i ) 1 + ( cp i+1 ) - repeat drop drop drop ; + repeat drop drop then drop ; + +: lit ' LIT_ , , ; + +( tasks ) +: mailbox 2 cells + ; +: task-ip task-user-size cells + ; +: task-sp task-user-size 1 + cells + ; +: task-rsp task-user-size 2 + cells + ; +: task-stack task-user-size 3 + cells + ; +: task-rstack task-stack stacksize cells + ; + +: doactivate ( task ip -- ) + over task-ip ! + dup task-stack over task-sp ! + dup task-rstack over task-rsp ! + drop +; + +: activate + here 4 cells + lit + ' doactivate , + ' ret , +; immediate + +: send ( val task -- ) + mailbox + begin dup @ while suspend repeat ( wait for empty mailbox ) + ! ; + +: receive ( -- val ) + running mailbox + begin dup @ not while suspend repeat ( wait for mail ) + dup @ 0 rot ! ; + + +: start-repl activate + stdout + ' log-emit task-echo ! + begin receive loadstring again ; +task const REPL + +REPL start-repl \ No newline at end of file diff --git a/forp.c b/forp.c index 1aca100..9f3ab96 100755 --- a/forp.c +++ b/forp.c @@ -1,53 +1,54 @@ #include +#include "forp.h" -#define MEM_SIZE 16384 -#define STACK_SIZE 64 -#define RSTACK_SIZE 32 +#define TASK_REGISTER_SIZE 3 +#define TASK_USER_SIZE 8 +#define TASK_HEADER_SIZE (TASK_USER_SIZE + TASK_REGISTER_SIZE) +#define TASK_SIZE (TASK_HEADER_SIZE + STACK_SIZE + RSTACK_SIZE) +#define STACK_OFFSET (TASK_HEADER_SIZE) +#define RSTACK_OFFSET (TASK_HEADER_SIZE + STACK_SIZE) -union cell_union; -typedef union cell_union cell; +#define TASK_USER_NEXT 0 +#define TASK_USER_STATE 1 +#define TASK_USER_MAILBOX 2 +#define TASK_USER_QUIET 3 +#define TASK_USER_KEY 4 +#define TASK_USER_KEYSRC 5 +#define TASK_USER_ECHO 6 +#define TASK_USER_EMIT 7 -union cell_union { - int i; - unsigned int u; - cell *p; - char *s; - void (*f)(); - FILE *fp; -}; - -char mem[MEM_SIZE]; -cell *HERE = (cell*)mem; +char mem[MEM_SIZE] = { 0 }; +cell *HERE = ((cell*)mem) + TASK_SIZE; 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; +#define STATE (*(RUNNING + TASK_USER_STATE)) +cell *RUNNING = (cell*)mem; +cell *TASKS = (cell*)mem; +cell *stack = ((cell*)mem) + STACK_OFFSET; +cell *rstack = ((cell*)mem) + RSTACK_OFFSET; char *INPUT = NULL; FILE *INPUT_FILE = NULL; FILE *OUTPUT_FILE = NULL; -cell QUIET = 0; +#define QUIET (*(RUNNING + TASK_USER_QUIET)) -#define F_IMMEDIATE 0x80 +void DROP(n) { + stack -= n; + if (stack < RUNNING + STACK_OFFSET) { + stack = RUNNING + STACK_OFFSET; + PUSHS("underflow!\n"); + f_puts(); + } +} -#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_here() { PUSHCP(HERE); @@ -60,6 +61,11 @@ void f_latest() { void f_state() { PUSHC(STATE); } + +void f_running() { + PUSHCP(RUNNING); +} + #define BINOP(name, op) \ void name() { \ cell r = TOP(); \ @@ -135,27 +141,49 @@ void f_rot() { // a b c -- b c a ST2() = b; } -void f_key() { - if (INPUT) { - PUSHI(*INPUT); - INPUT++; - if (TOP().i == 0) { - INPUT = NULL; - } - } else if (INPUT_FILE) { - int val = fgetc(INPUT_FILE); - if (val == EOF) { - fclose(INPUT_FILE); - INPUT_FILE = NULL; - PUSHI(0); +void f_execute(); + +void f_key_string() { + cell *INPUT = RUNNING + TASK_USER_KEYSRC; + if (INPUT->p) { + PUSHCP(INPUT->p); + f_bget(); + if (TOP().i != 0) { + INPUT->p = CELL_OFFSET(INPUT->p, 1); } else { - PUSHI(val); + INPUT->p = NULL; } } else { PUSHI(0); } - if (OUTPUT_FILE && TOP().i != 0) { - fputc(TOP().i, OUTPUT_FILE); +} + +void f_key_file() { + cell *INPUT = RUNNING + TASK_USER_KEYSRC; + int val = 0; + if (INPUT->fp) { + val = fgetc(INPUT->fp); + if (val == EOF) { + fclose(INPUT->fp); + INPUT->fp = NULL; + val = 0; + } + } + PUSHI(val); +} + +void f_key() { + cell *keyword = RUNNING + TASK_USER_KEY; + cell *echoword = RUNNING + TASK_USER_ECHO; + if (keyword->f) { + keyword->f(); + } else { + PUSHI(0); + } + if (!QUIET.i && echoword->p) { + f_dup(); + PUSHCP(echoword->p); + f_execute(); } } @@ -182,14 +210,30 @@ void f_word() { void f_emit() { if (!QUIET.i) { - printf("%c", TOP().i); - } - if (OUTPUT_FILE) { - fputc(TOP().i, OUTPUT_FILE); + cell *echoword = RUNNING + TASK_USER_ECHO; + cell *emitword = RUNNING + TASK_USER_EMIT; + if (echoword->p) { + f_dup(); + PUSHCP(echoword->p); + f_execute(); + } + if (emitword->p) { + PUSHCP(emitword->p); + f_execute(); + } } +} + +void f_putc() { + printf("%c", TOP().i); DROP(1); } +void f_fputc() { + fputc(ST1().i, TOP().fp); + DROP(2); +} + void f_puts() { char *s = TOP().s; while (s && *s) { @@ -207,6 +251,13 @@ void f_dot() { f_puts(); } +void f_printstack() { + cell *v = RUNNING + STACK_OFFSET; + while (v != stack) { + PUSHC(*v++); + f_dot(); + } +} void f_cr() { PUSHI('\n'); @@ -243,11 +294,27 @@ void f_cdef() { // func name -- DROP(1); } -void f_docolon() { - RPUSH(W); +void f_execute() { + cell oldW = W; + cell oldIP = IP; + cell *oldRstack; + cell retIP; + retIP.p = NULL; + RPUSH(retIP); + oldRstack = rstack; + W = TOP(); + DROP(1); + W.p->f(); + if (oldRstack == rstack) { + RPOP(); + } + W = oldW; + IP = oldIP; +} - IP.p = W.p + 1; - while (rstack != rstack_mem) { +void f_docolon(); +void f_colonloop() { + while (IP.p) { cell codeptr; W = *IP.p; IP.p++; @@ -261,6 +328,11 @@ void f_docolon() { } } +void f_docolon() { + IP.p = W.p + 1; + f_colonloop(); +} + void f_noop() { } @@ -329,13 +401,17 @@ void f_immediate() { void f_compileword(); void f_semicolon() { - PUSHS("_RET"); + PUSHS("ret"); f_compileword(); f_compileoff(); } void f_ret() { - IP = *RPOP(); + if (rstack == RUNNING + RSTACK_OFFSET) { + IP.p = NULL; + } else { + IP = *RPOP(); + } } void f_colon() { @@ -401,12 +477,6 @@ void f_interpreter() { return; } f_compileword(); - if (stack < stack_mem) { - stack = stack_mem; - PUSHS("stack underflow!\n"); - f_puts(); - return; - } } } @@ -422,26 +492,40 @@ void f_close() { } void f__loadfile() { - INPUT_FILE = TOP().fp; + 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 (INPUT_FILE != NULL) { - fclose(INPUT_FILE); - INPUT_FILE = NULL; + if (key->fp != NULL) { + fclose(key->fp); } + *key = oldKey; + *keysrc = oldKeysrc; } void f_loadstring() { - INPUT = TOP().s; + 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(); - INPUT = NULL; + *key = oldKey; + *keysrc = oldKeysrc; } -void f_appendlog() { - OUTPUT_FILE = TOP().fp; - fseek(OUTPUT_FILE, 0, SEEK_END); - DROP(1); +void f_taskemit() { + PUSHCP(RUNNING + TASK_USER_EMIT); +} + +void f_taskecho() { + PUSHCP(RUNNING + TASK_USER_ECHO); } void f_doconst() { @@ -544,6 +628,56 @@ void f_loud() { QUIET.i = 0; } +// task switching +void f_task() { + cell *task = HERE; + HERE += TASK_SIZE; + memset(task, 0, TASK_SIZE * 2); + task->p = TASKS; + TASKS = task; + PUSHP(task); +} + +void f_suspend() { + cell *registers = RUNNING + TASK_USER_SIZE; + registers[0] = IP; + registers[1].p = stack; + registers[2].p = rstack; + IP.p = 0; +} + +void f_restore() { + cell *registers = RUNNING + TASK_USER_SIZE; + IP = registers[0]; + stack = registers[1].p; + rstack = registers[2].p; +} + +// run all tasks once, except the task that triggered the loop +void f_taskloop() { + cell *task = RUNNING; + f_suspend(); + RUNNING = TASKS; + while (RUNNING) { + if (RUNNING != task) { + f_restore(); + f_colonloop(); + } + RUNNING = RUNNING->p; + } + RUNNING = task; + f_restore(); +} + +void f_stacksize() { + PUSHU(STACK_SIZE); +} +void f_rstacksize() { + PUSHU(RSTACK_SIZE); +} +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(); @@ -585,14 +719,19 @@ void f_init() { CDEF("swap", f_swap); CDEF("rot", f_rot); CDEF("emit", f_emit); + CDEF("task-emit", f_taskemit); + CDEF("task-echo", f_taskecho); + CDEF("putc", f_putc); + CDEF("fputc", f_fputc); CDEF("number", f_number); CDEF("LIT_", f_lit_); CDEF("GOTO_", f_goto_); CDEF("BZ_", f_bz_); CDEF("BNZ_", f_bnz_); - CDEF("_RET", f_ret); + CDEF("ret", f_ret); CDEF(".", f_dot); - CDEF(".s", f_puts); + CDEF("type", f_puts); + CDEF(".s", f_printstack); CDEF(",", f_comma); CDEF("b,", f_bcomma); CDEF("s\"", f_string); f_immediate(); @@ -604,13 +743,13 @@ void f_init() { CDEF("loadstring", f_loadstring); CDEF("quiet", f_quiet); CDEF("loud", f_loud); - CDEF("appendlog", f_appendlog); - - - PUSHS("forp.log"); - f_open(); - f_appendlog(); - + CDEF("task", f_task); + CDEF("suspend", f_suspend); + CDEF("taskloop", f_taskloop); + CDEF("running", f_running); + CDEF("stacksize", f_stacksize); + CDEF("rstacksize", f_rstacksize); + CDEF("task-user-size", f_taskusersize); f_loadfile("defs.frp"); } @@ -620,13 +759,18 @@ void f_quit() { DIE = 1; } -int main() { +void f_repl() { char inputbuf[256]; - f_init(); CDEF("quit", f_quit); while (!DIE) { - f_runstring(gets(inputbuf)); + int len; + gets(inputbuf); + len = strlen(inputbuf); + inputbuf[len] = '\n'; + inputbuf[len + 1] = 0; + PUSHS(inputbuf); + f_runstring("REPL send"); + f_taskloop(); } - return 0; } \ No newline at end of file diff --git a/forp.h b/forp.h new file mode 100755 index 0000000..256231b --- /dev/null +++ b/forp.h @@ -0,0 +1,67 @@ +#include + +#define MEM_SIZE 16384 +#define STACK_SIZE 64 +#define RSTACK_SIZE 32 + +void f_init(); + +#define CDEF(name, def) PUSHP(def); PUSHS(name); f_cdef() +void f_immediate(); + +void f_loadfile(char *filename); +void f_runstring(char *s); + +void f_quiet(); +void f_loud(); +void f_interpreter(); + +union cell_union; +typedef union cell_union cell; + +union cell_union { + int i; + unsigned int u; + cell *p; + char *s; + void (*f)(); + FILE *fp; +}; + +extern char mem[MEM_SIZE]; +extern cell *HERE; +extern cell *LATEST; +extern cell IP; +extern cell W; +extern cell *rstack; +extern cell *stack; + +#define F_IMMEDIATE 0x80 + +#define CELL_OFFSET(cp, b) ((cell*)(((char *)(cp)) + b)) +#define TOP() (*(stack - 1)) +#define ST1() (*(stack - 2)) +#define ST2() (*(stack - 3)) +void DROP(int n); +void PUSHC(cell c); +void PUSHI(int i); +void PUSHU(unsigned int u); +void PUSHCP(cell *c); +#define PUSHP(p) PUSHCP((cell*)p) +void PUSHS(char *s); +void RPUSH(cell c); +#define RPOP() (--rstack) +#define RTOP() (*(rstack - 1)) + +void f_key(); +void f_word(); +void f_emit(); +void f_puts(); +void f_dot(); +void f_cr(); +void f_comma(); +void f_bcomma(); +void f_create(); // name -- +void f_cdef(); // func name -- +void f_compileword(); + diff --git a/game.exe b/game.exe index 25249a6..0bc30de 100755 Binary files a/game.exe and b/game.exe differ diff --git a/game.prj b/game.prj index cfae453..e5c8197 100755 Binary files a/game.prj and b/game.prj differ diff --git a/testbed.c b/testbed.c index 5d032f0..f511b93 100755 --- a/testbed.c +++ b/testbed.c @@ -8,6 +8,7 @@ #include "tiff.h" #include "tiles.h" #include "serial.h" +#include "forp.h" /*** S C R A T C H ***/ @@ -148,6 +149,10 @@ void overworldThink() { } int main() { + f_init(); + f_repl(); +} +int main2() { game_init(); ser_init(SER_COM2, BAUD_19200, SER_8N1); ser_write("JORTS QUEST DEBUG OUTPUT\r\n");