Forp is now Jorth ( Jean Forth) - hook timer interrupt and expose ticks

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

game.frp

@@ -1,7 +0,0 @@
-: start-repl activate
-  ' seremit task-emit !
-  ' log-emit task-echo !
-  begin receive loadstring again ;
-task const REPL
-
-REPL start-repl

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

jorth.c

@@ -1,5 +1,6 @@
 #include <stdio.h>
-#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,27 +311,25 @@ 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_colonloop() {
-  while (IP.p) {
+void f_colondispatch() {
   cell codeptr;
-    W = *IP.p;
-    IP.p++;
+
   codeptr = *W.p;
   if (codeptr.f == f_docolon) {
     RPUSH(IP);
@@ -324,6 +338,13 @@ void f_colonloop() {
     codeptr.f();
   }
 }
+
+void f_colonloop() {
+  while (IP.p) {
+    W = *IP.p;
+    IP.p++;
+    f_colondispatch();
+  }
 }
 
 void f_docolon() {
@@ -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;

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

timer.c

@@ -0,0 +1,36 @@
+#include <stdio.h>
+#include <dos.h>
+#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);
+}

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