Forp: Lightweight suspendable round-robin task system

This commit is contained in:
Jeremy Penner 2019-02-03 21:04:02 -05:00
parent 1a7d14b056
commit 0e36599524
6 changed files with 357 additions and 90 deletions

View file

@ -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
View file

@ -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
View 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();

BIN
game.exe

Binary file not shown.

BIN
game.prj

Binary file not shown.

View file

@ -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");