Forp: Lightweight suspendable round-robin task system

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

forp.c

@@ -1,53 +1,54 @@
 #include <stdio.h>
+#include "forp.h"
 
-#define MEM_SIZE 16384
+#define TASK_REGISTER_SIZE 3
-#define STACK_SIZE 64
+#define TASK_USER_SIZE 8
-#define RSTACK_SIZE 32
+#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;
+#define TASK_USER_NEXT 0
-typedef union cell_union cell;
+#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 {
+char mem[MEM_SIZE] = { 0 };
-  int i;
+cell *HERE = ((cell*)mem) + TASK_SIZE;
-  unsigned int u;
-  cell *p;
-  char *s;
-  void (*f)();
-  FILE *fp;
-};
-
-char mem[MEM_SIZE];
-cell *HERE = (cell*)mem;
 cell *LATEST = NULL;
 cell IP = NULL;
 cell W = NULL;
-cell STATE = 0;
+#define STATE (*(RUNNING + TASK_USER_STATE))
-cell rstack_mem[RSTACK_SIZE];
+cell *RUNNING = (cell*)mem;
-cell *rstack = rstack_mem;
+cell *TASKS = (cell*)mem;
-cell stack_mem[STACK_SIZE];
+cell *stack = ((cell*)mem) + STACK_OFFSET;
-cell *stack = stack_mem;
+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() {
+void f_execute();
-  if (INPUT) {
+
-    PUSHI(*INPUT);
+void f_key_string() {
-    INPUT++;
+  cell *INPUT = RUNNING + TASK_USER_KEYSRC;
-    if (TOP().i == 0) {
+  if (INPUT->p) {
-      INPUT = NULL;
+    PUSHCP(INPUT->p);
-    }
+    f_bget();
-  } else if (INPUT_FILE) {
+    if (TOP().i != 0) {
-    int val = fgetc(INPUT_FILE);
+      INPUT->p = CELL_OFFSET(INPUT->p, 1);
-    if (val == EOF) {
-      fclose(INPUT_FILE);
-      INPUT_FILE = NULL;
-      PUSHI(0);
     } 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);
+    cell *echoword = RUNNING + TASK_USER_ECHO;
-  }
+    cell *emitword = RUNNING + TASK_USER_EMIT;
-  if (OUTPUT_FILE) {
+    if (echoword->p) {
-    fputc(TOP().i, OUTPUT_FILE);
+      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() {
+void f_execute() {
-  RPUSH(W);
+  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;
+void f_docolon();
-  while (rstack != rstack_mem) {
+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) {
+  if (key->fp != NULL) {
-    fclose(INPUT_FILE);
+    fclose(key->fp);
-    INPUT_FILE = NULL;
   }
+  *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() {
+void f_taskemit() {
-  OUTPUT_FILE = TOP().fp;
+  PUSHCP(RUNNING + TASK_USER_EMIT);
-  fseek(OUTPUT_FILE, 0, SEEK_END);
+}
-  DROP(1);
+
+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);
+  CDEF("task", f_task);
-
+  CDEF("suspend", f_suspend);
-
+  CDEF("taskloop", f_taskloop);
-  PUSHS("forp.log");
+  CDEF("running", f_running);
-  f_open();
+  CDEF("stacksize", f_stacksize);
-  f_appendlog();
+  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;
 }

forp.h

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

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