Forp: Lightweight suspendable round-robin task system
This commit is contained in:
parent
1a7d14b056
commit
0e36599524
61
defs.frp
61
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
|
||||
310
forp.c
310
forp.c
|
|
@ -1,53 +1,54 @@
|
|||
#include <stdio.h>
|
||||
#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 {
|
||||
INPUT->p = NULL;
|
||||
}
|
||||
} else {
|
||||
PUSHI(0);
|
||||
}
|
||||
}
|
||||
|
||||
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 (OUTPUT_FILE && TOP().i != 0) {
|
||||
fputc(TOP().i, OUTPUT_FILE);
|
||||
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) {
|
||||
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);
|
||||
}
|
||||
if (OUTPUT_FILE) {
|
||||
fputc(TOP().i, OUTPUT_FILE);
|
||||
}
|
||||
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,14 +401,18 @@ void f_immediate() {
|
|||
void f_compileword();
|
||||
|
||||
void f_semicolon() {
|
||||
PUSHS("_RET");
|
||||
PUSHS("ret");
|
||||
f_compileword();
|
||||
f_compileoff();
|
||||
}
|
||||
|
||||
void f_ret() {
|
||||
if (rstack == RUNNING + RSTACK_OFFSET) {
|
||||
IP.p = NULL;
|
||||
} else {
|
||||
IP = *RPOP();
|
||||
}
|
||||
}
|
||||
|
||||
void f_colon() {
|
||||
f_word();
|
||||
|
|
@ -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;
|
||||
}
|
||||
67
forp.h
Executable file
67
forp.h
Executable file
|
|
@ -0,0 +1,67 @@
|
|||
#include <stdio.h>
|
||||
|
||||
#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();
|
||||
|
||||
|
|
@ -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");
|
||||
|
|
|
|||
Loading…
Reference in a new issue