JOPL adlib livecoding environment; stop including JIM files in git

I now have multiple executables that depend on the same .jor source files
and I am not diligent about ensuring that both are up-to-date and working.
As small changes to source files can cause .jim files to fail silently,
I've removed them from the repo for now.

.gitignore

@@ -3,4 +3,5 @@
 *.dsk
 *.swp
 *.log
+*.jim
 

adlib.c

@@ -1,8 +1,8 @@
-#include <dos.h>
+#include "adlib.h"
 
 static void adlib_wait(int delay) {
   int i;
-  for (i = 0; i < delay; i ++) inp(0x388);
+  for (i = 0; i < delay; i ++) adlib_read();
 }
 
 void adlib_write(int reg, int val) {
@@ -12,3 +12,15 @@ void adlib_write(int reg, int val) {
   outp(0x389, val);
   adlib_wait(35);
 }
+
+void adlib_reset() {
+  int i;
+  for (i = 0; i < 0xff; i ++) {
+    adlib_write(i, 0);
+  }
+}
+
+void adlib_init() {
+  adlib_reset();
+  atexit(adlib_reset);
+}

adlib.h

@@ -1 +1,6 @@
+#include <dos.h>
+
+void adlib_init();
+#define adlib_read() inp(0x388)
 void adlib_write(int reg, int val);
+void adlib_reset();

jopl.c

@@ -0,0 +1,55 @@
+#include "jorth.h"
+#include "adlib.h"
+#include "kbd.h"
+#include "timer.h"
+
+cell ontick = 0;
+void f_adlib_read() {
+  PUSHU(adlib_read());
+}
+
+void f_adlib_write() {
+  adlib_write(TOP().u & 0xff, ST1().u & 0xff);
+  DROP(2);
+}
+
+static void timer_callback() {
+  if (ontick.p) {
+    f_execcp(ontick);
+  }
+}
+
+int DONE = 0;
+static void f_quit() {
+  DONE = 1;
+}
+
+void do_repl() {
+  char buf[128];
+
+  adlib_init();
+
+  timer_init(TIMER_18HZ);
+  f_init();
+
+  CDEF("quit", f_quit);
+  CDEF("adlib!", f_adlib_write);
+  CDEF("adlib@", f_adlib_read);
+
+  f_loadfile("jopl.jor");
+  ontick = f_lookupcp("ontick");
+  timer_setcallback(timer_callback);
+
+  f_taskloop();
+
+  while (!DONE) {
+    PUSHS(gets(buf));
+    f_runstring("REPL send");
+    f_taskloop();
+  }
+}
+
+int main() {
+  do_repl();
+  return 0;
+}

jopl.jor

@@ -0,0 +1,152 @@
+' putc task-emit !
+
+: start-repl activate ' putc task-emit !
+  s" .:: J O P L ( jean OPL2 print loop) ::." type cr
+  begin receive loadstring s" ok" type cr again ;
+task const REPL
+REPL start-repl
+
+var voice
+var op
+
+: op-with-voice voice @
+  dup 2 > if 5 + then
+  dup 5 > if 5 + then
+  + op @ + ;
+: opreg create b, does> ub@ op-with-voice ;
+: voicereg create b, does> ub@ voice @ + ;
+
+0x20 opreg ar-flags
+0x40 opreg ar-level
+0x60 opreg ar-ad
+0x80 opreg ar-sr
+0xe0 opreg ar-wave
+0xc0 voicereg ar-alg
+
+0xa0 voicereg ar-freq
+0xb0 voicereg ar-note
+
+: op2 3 op ! ;
+: op1 0 op ! ;
+: loadop ( flags level ad sr wave -- )
+  ar-wave adlib!
+  ar-sr adlib!
+  ar-ad adlib!
+  ar-level adlib!
+  ar-flags adlib! ;
+
+: readop ( v -- )
+  r> r@ 4 + b@ r@ 3 + b@ r@ 2 + b@ r@ 1 + b@ r< b@ loadop ;
+
+: instrument ( alg f1 l1 ad1 sr1 w1 f2 l2 ad2 sr2 w2 -- )
+  create b, b, b, b, b, b, b, b, b, b, b, does>
+  dup dup 5 + op1 readop op2 readop
+  10 + b@ ar-alg adlib! ;
+
+0 0x01 0x10 0xf0 0x77 0 0x01 0x00 0xf0 0x77 0 instrument default
+
+: freqon ( oct freq -- )
+  dup 0xff & ar-freq adlib!
+  8 >> 0x03 & swap 2 << | 0x20 | ar-note adlib! ;
+: noteoff ( -- ) 0 ar-note adlib! ;
+
+array semitones
+3520 3520 />ratio ,
+3729 3520 />ratio ,
+3951 3520 />ratio ,
+4186 3520 />ratio ,
+4435 3520 />ratio ,
+4699 3520 />ratio ,
+4978 3520 />ratio ,
+5274 3520 />ratio ,
+5588 3520 />ratio ,
+5920 3520 />ratio ,
+6272 3520 />ratio ,
+6645 3520 />ratio ,
+
+: note dup 12 / 8 % swap 12 % cells semitones + @ 440 swap *<ratio ;
+: noteon noteoff note freqon ;
+
+: read-sbi-reg ( reg-cp -- )
+  fgetc swap execute adlib! ;
+
+: read-sbi-op-reg ( reg-cp -- )
+  dup op1 read-sbi-reg
+  op2 read-sbi-reg ;
+
+: loadsbi ( filename -- )
+  open 36 seek
+  ' ar-flags read-sbi-op-reg
+  ' ar-level read-sbi-op-reg
+  ' ar-ad read-sbi-op-reg
+  ' ar-sr read-sbi-op-reg
+  ' ar-wave read-sbi-op-reg
+  fgetc ar-alg adlib!
+  close ;
+
+: panic 9 -1 for i voice ! noteoff next ;
+
+var songticks
+
+var notestate
+var octave
+: rest songticks @ begin dup songticks @ != until drop ;
+: beat begin dup songticks @ swap % 0 != while rest repeat drop ;
+: %O octave ! ;
+: %V voice ! ;
+: mknote create b, does> ub@ octave @ 12 * + notestate @ if b, else noteon rest then ;
+: %loop 0xfe b, , ;
+: % notestate @ if 0xf0 b, else rest then ;
+: %% 0 for % next ;
+: %- notestate @ if 0xfd b, else noteoff then ;
+: %do 0xff b, , ;
+0  mknote A
+1  mknote A#
+2  mknote B
+3  mknote C
+4  mknote C#
+5  mknote D
+6  mknote D#
+7  mknote E
+8  mknote F
+9  mknote F#
+10 mknote G
+11 mknote G#
+
+array tracks 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 ,
+
+: track ( i -- p ) cells tracks + ;
+: dotrack ( ip -- ip )
+  dup if dup 1 + swap ub@ r>
+    r@ 0xff = if dup @ swap cell + swap execute then
+    r@ 0xfe = if @ dotrack then
+    r@ 0xfd = if noteoff then
+    r@ 0xf0 < if r@ noteon then
+  rdrop then ;
+
+: track-tick ( i -- )
+  track dup @ dotrack swap ! ;
+
+: :track create here 1 notestate ! does> voice @ track ! ;
+: ;track %loop 0 notestate ! ;
+: shush 0 voice @ track ! %- ;
+
+: player
+  songticks @ 1 + songticks !
+  voice @
+  0 10 for i voice ! i track-tick next
+  voice ! ;
+
+var t2
+: startt2
+  0x60 0x04 adlib!
+  0x80 0x04 adlib!
+  t2 @ 0x03 adlib!
+  0x42 0x04 adlib! ;
+
+: ontick adlib@ 0x20 & if startt2 player then ;
+
+:noname
+  default
+  startt2
+; ' onload redefine

jorth.c

@@ -153,6 +153,10 @@ void f_bget() {
   TOP().i = *((char*)TOP().p);
 }
 
+void f_ubget() {
+  TOP().u = *((unsigned char*)TOP().p);
+}
+
 void f_bset() {
   char *p = (char*)TOP().p;
   DROP(1);
@@ -1060,6 +1064,7 @@ void f_init() {
   CDEF("!", f_set);
   CDEF("+!", f_addset);
   CDEF("b@", f_bget);
+  CDEF("ub@", f_ubget);
   CDEF("b!", f_bset);
   CDEF("dup", f_dup);
   CDEF("over", f_over);
@@ -1129,6 +1134,22 @@ void f_init() {
   f_loadfile("defs.jor");
 }
 
+cell f_lookupcp(char *name) {
+  cell result = {0};
+  PUSHS(name);
+  f_lookup();
+  if (TOP().u) {
+    result = ST1();
+  }
+  DROP(2);
+  return result;
+}
+
+void f_execcp(cell cp) {
+  PUSHC(cp);
+  f_cexecute();
+}
+
 int DIE = 0;
 void f_quit() {
   DIE = 1;

jorth.h

@@ -66,6 +66,9 @@ void f_cdef(); // func name --
 void f_doconst();
 void f_compileword();
 
+cell f_lookupcp(char *name);
+void f_execcp(cell cp);
+
 #define CDEF(name, def) PUSHP(def); PUSHS(name); f_cdef()
 #define ICONST(name, v) CDEF(name, f_doconst); PUSHI(v); f_comma()
 #define PCONST(name, p) CDEF(name, f_doconst); PUSHP(p); f_comma()

temp.jor

@@ -1,13 +0,0 @@
-: interpretword F_IMMEDIATE & state not or if execute else , then ;
-: compileword lookup dup
-    if interpretword
-    else drop dup number
-      if swap drop interpretnumber
-      else drop interpretunknown
-      then
-    then ;
-: interpreter
-  begin word dup b@ while compileword repeat
-  s" ok\n" type drop ;
-: loadstring
-: loadfile

testbed.c

@@ -195,7 +195,7 @@ void f_drawportrait() {
 }
 
 void f_adlib() {
-  adlib_write(ST1().u, TOP().u);
+  adlib_write(TOP().u, ST1().u);
   DROP(2);
 }
 

timer.c

@@ -9,12 +9,18 @@
 volatile unsigned int timer_counter = 0;
 
 static void interrupt (*oldTimerISR)() = NULL;
+static void (*callback)() = NULL;
 
 static void interrupt timer_isr() {
   timer_counter ++;
+  if (callback) callback();
   oldTimerISR();
 }
 
+void timer_setcallback(void (*cb)()) {
+  callback = cb;
+}
+
 void timer_setrate(unsigned int rate) {
   outp(REG_8253_CTL, 0x3c);
   outp(REG_COUNTER0, rate & 0xff);

timer.h

@@ -9,3 +9,4 @@ extern volatile unsigned int timer_counter;
 
 void timer_init(unsigned int rate);
 void timer_setrate(unsigned int rate);
+void timer_setcallback(void (*cb)());