rc2014: bingo!

Interpreter is functional in the emulator!

drv/acia.fs

@@ -9,59 +9,12 @@ CONFIGURATION
 
 ACIA_CTL: IO port for the ACIA's control registers
 ACIA_IO: IO port for the ACIA's data registers
+ACIA_MEM: Address in memory that can be used variables shared
+          with ACIA's native words. 8 bytes used.
 )
 
 0x20 CONSTANT ACIABUFSZ
 
-( Points to ACIA buf )
-(sysv) ACIA(
-( Points to ACIA buf end )
-(sysv) ACIA)
-( Read buf pointer. Pre-inc )
-(sysv) ACIAR>
-( Write buf pointer. Post-inc )
-(sysv) ACIAW>
-( This means that if W> == R>, buffer is full.
-  If R>+1 == W>, buffer is empty. )
-
-(entry) ~ACIA
-    AF PUSHqq,
-    HL PUSHqq,
-    DE PUSHqq,
-
-	( Read our character from ACIA into our BUFIDX )
-    ACIA_CTL INAn,
-    0x01 ANDn,   ( is ACIA rcv buf full? )
-    JRZ, L2 FWR ( end, no, wrong interrupt cause. )
-
-    ACIAW> @ LDHL(nn),
-    ( is it == to ACIAR>? )
-    DE ACIAR> @ LDdd(nn),
-    ( carry cleared from ANDn above )
-    DE SBCHLss,
-    JRZ, L3 FWR ( end, buffer full )
-
-    ( buffer not full, let's write )
-    ACIA_IO INAn,
-    (HL) A LDrr,
-
-    ( advance W> )
-    HL INCss,
-    DE ACIAR) @ LDdd(nn),
-    DE SUBHLss,
-    JRNZ, L4 FWR ( skip )
-    ( end of buffer reached )
-    ACIA( @ LDHL(nn),
-L4 FSET ( skip )
-    ACIAW> @ LD(nn)HL,
-L3 FSET L2 FSET ( end )
-
-    DE POPqq,
-    HL POPqq,
-    AF POPqq,
-    EI,
-    RETI,
-
 : ACIA$
     H@ DUP DUP ACIA( ! ACIAR> !
     1 + ACIAW> ! ( write index starts one position later )
@@ -76,9 +29,9 @@ L3 FSET L2 FSET ( end )
     0b10010110 ACIA_CTL PC!
 
 ( setup interrupt )
-    ( 51 == INTJUMP )
-    0xc3 0x51 RAM+ C! ( JP upcode )
-    ['] ~ACIA 0x52 RAM+ !
+    ( 4e == INTJUMP )
+    0xc3 0x4e RAM+ C! ( JP upcode )
+    ['] ~ACIA 0x4f RAM+ !
     (im1)
 ;
 
@@ -86,14 +39,15 @@ L3 FSET L2 FSET ( end )
     ( As long as R> == W>-1, it means that buffer is empty )
     BEGIN ACIAR> @ 1 + ACIAW> @ = NOT UNTIL
 
-    ACIAR> @ C@
+    ( inc then fetch )
     1 ACIAR> +!
+    ACIAR> @ C@
 ;
 
 : EMIT
     ( As long at CTL bit 1 is low, we are transmitting. wait )
     BEGIN ACIA_CTL PC@ 0x02 AND UNTIL
     ( The way is clear, go! )
-    ACIA_IO SWAP PC!
+    ACIA_IO PC!
 ;
 

drv/acia.z80

@@ -0,0 +1,55 @@
+( Save ACIA conf )
+ACIA_CTL
+: ACIA_CTL [ LITN ] ;
+ACIA_IO
+: ACIA_IO [ LITN ] ;
+( Points to ACIA buf )
+: ACIA( [ ACIA_MEM 4 + LITN ] ;
+( Points to ACIA buf end )
+: ACIA) [ ACIA_MEM 6 + LITN ] ;
+( Read buf pointer. Pre-inc )
+: ACIAR> [ ACIA_MEM LITN ] ;
+( Write buf pointer. Post-inc )
+: ACIAW> [ ACIA_MEM 2 + LITN ] ;
+( This means that if W> == R>, buffer is full.
+  If R>+1 == W>, buffer is empty. )
+
+(entry) ~ACIA
+    AF PUSHqq,
+    HL PUSHqq,
+    DE PUSHqq,
+
+	( Read our character from ACIA into our BUFIDX )
+    ACIA_CTL INAn,
+    0x01 ANDn,   ( is ACIA rcv buf full? )
+    JRZ, L2 FWR ( end, no, wrong interrupt cause. )
+
+    ACIAW> LDHL(nn),
+    ( is it == to ACIAR>? )
+    DE ACIAR> LDdd(nn),
+    ( carry cleared from ANDn above )
+    DE SBCHLss,
+    JRZ, L3 FWR ( end, buffer full )
+
+    DE ADDHLss, ( restore ACIAW> )
+    ( buffer not full, let's write )
+    ACIA_IO INAn,
+    (HL) A LDrr,
+
+    ( advance W> )
+    HL INCss,
+    ACIAW> LD(nn)HL,
+    DE ACIA) @ LDdd(nn),
+    DE SUBHLss,
+    JRNZ, L4 FWR ( skip )
+    ( end of buffer reached )
+    ACIA( @ LDHL(nn),
+    ACIAW> LD(nn)HL,
+L4 FSET ( skip )
+L3 FSET L2 FSET ( end )
+
+    DE POPqq,
+    HL POPqq,
+    AF POPqq,
+    EI,
+    RETI,

emul/Makefile

@@ -4,10 +4,12 @@ FORTHSRCS = core.fs print.fs str.fs parse.fs readln.fs fmt.fs z80a.fs
 FORTHSRC_PATHS = ${FORTHSRCS:%=../forth/%} forth/run.fs
 OBJS = emul.o libz80/libz80.o
 SLATEST = ../tools/slatest
+STRIPFC = ../tools/stripfc
 
 .PHONY: all
 all: $(TARGETS)
 
+$(STRIPFC):
 $(SLATEST):
 	$(MAKE) -C ../tools
 
@@ -27,8 +29,10 @@ forth/stage1: forth/stage.c $(OBJS) forth/forth0-bin.h
 forth/stage1dbg: forth/stage.c $(OBJS) forth/forth0-bin.h 
 	$(CC) -DDEBUG forth/stage.c $(OBJS) -o $@
 
+# We don't really need to use stripfc, but we do it anyway to test that we
+# don't mistakenly break our code with that tool. It's easier to debug here.
 forth/core.bin: $(FORTHSRC_PATHS) forth/stage1
-	cat $(FORTHSRC_PATHS) ./forth/stop.fs | ./forth/stage1 | tee $@ > /dev/null
+	cat $(FORTHSRC_PATHS) ./forth/stop.fs | $(STRIPFC) | ./forth/stage1 | tee $@ > /dev/null
 
 forth/forth1.bin: forth/core.bin $(SLATEST)
 	cat forth/boot.bin forth/z80c.bin forth/core.bin > $@

forth/notes.txt

@@ -115,7 +115,12 @@ those slots...) in boot binaries are made to jump to this address. If you use
 one of those slots for an interrupt, write a jump to the appropriate offset in
 that RAM location.
 
-SYSTEM SCRATCHPAD is reserved for temporary system storage.
+SYSTEM SCRATCHPAD is reserved for temporary system storage or can be reserved
+by low-level drivers. These are the current usages of this space throughout the
+project:
+
+* 0x51-0x53: (c<) pointer during in-memory initialization (see below)
+* 0x53-0x5b: ACIA buffer pointers in RC2014 recipes.
 
 *** Initialization sequence
 

forth/parse.fs

@@ -80,7 +80,7 @@
     (parseb) IF EXIT THEN
     (parsed) IF EXIT THEN
     ( nothing works )
-    ABORT" unknown word! "
+    LIT< (wnf) (find) DROP EXECUTE
 ;
 
 ' (parse) (parse*) !

forth/print.fs

@@ -28,3 +28,8 @@
 
 : (uflw) ABORT" stack underflow" ;
 : (wnf) ABORT" word not found" ;
+
+: BS 8 EMIT ;
+: LF 10 EMIT ;
+: CR 13 EMIT ;
+: SPC 32 EMIT ;

forth/readln.fs

@@ -1,4 +1,4 @@
-( requires core, parse )
+( requires core, parse, print )
 
 ( Managing variables in a core module is tricky. Sure, we
   have (sysv), but here we need to allocate a big buffer, and
@@ -76,5 +76,5 @@
     ( not EOL? good, inc and return )
     DUP IF 1 IN> +! EXIT THEN   ( c )
     ( EOL ? readline. we still return typed char though )
-    (rdln) (<c)                 ( c )
+    (rdln)                      ( c )
 ;

forth/str.fs

@@ -5,8 +5,3 @@
     1 +
     AGAIN
 ;
-
-: BS 8 EMIT ;
-: LF 10 EMIT ;
-: CR 13 EMIT ;
-: SPC 32 EMIT ;

recipes/rc2014/Makefile

@@ -1,25 +1,33 @@
 TARGET = os.bin
 BASEDIR = ../..
-FDIR = $(BASEDIR)/emul/forth
-STAGE1 = $(FDIR)/stage1
-FORTH0 = $(FDIR)/forth0.bin
+FDIR = $(BASEDIR)/forth
+EDIR = $(BASEDIR)/emul/forth
+STAGE2 = $(EDIR)/stage2
 EMUL = $(BASEDIR)/emul/hw/rc2014/classic
-SRCS = core.fs str.fs parse.fs readln.fs fmt.fs
-PATHS = conf.fs \
-	${SRCS:%=$(BASEDIR)/forth/%} \
+PATHS = pre.fs \
+	$(FDIR)/core.fs \
+	$(FDIR)/str.fs \
+	$(FDIR)/parse.fs \
 	$(BASEDIR)/drv/acia.fs \
-	run.fs \
-	$(FDIR)/stop.fs
+	$(FDIR)/print.fs \
+	$(FDIR)/readln.fs \
+	$(FDIR)/fmt.fs \
+	run.fs
 SLATEST = $(BASEDIR)/tools/slatest
+STRIPFC = $(BASEDIR)/tools/stripfc
 
 .PHONY: all
 all: $(TARGET) 
-$(TARGET): dict.bin $(FORTH0) $(SLATEST)
-	cat $(FORTH0) dict.bin > $@
+$(TARGET): boot.bin z80c.bin $(SLATEST) $(PATHS)
+	cat boot.bin z80c.bin > $@
 	$(SLATEST) $@
+	cat $(PATHS) | $(STRIPFC) >> $@
 
-dict.bin: conf.fs
-	cat $(PATHS) | $(STAGE1) > $@
+z80c.bin: boot.bin
+	cat conf.fs $(FDIR)/z80c.fs $(BASEDIR)/drv/acia.z80 $(FDIR)/icore.fs | $(STAGE2) | tee $@ > /dev/null
+
+boot.bin: conf.fs
+	cat conf.fs $(FDIR)/boot.fs | $(STAGE2) | tee $@ > /dev/null
 
 $(SLATEST):
 	$(MAKE) -C $(BASEDIR)/tools

recipes/rc2014/conf.fs

@@ -2,4 +2,5 @@
 0xf000 CONSTANT RS_ADDR
 0x80   CONSTANT ACIA_CTL
 0x81   CONSTANT ACIA_IO
+RAMSTART 0x53 + CONSTANT ACIA_MEM
 

recipes/rc2014/pre.fs

@@ -0,0 +1 @@
+96 RAM+ HERE !

recipes/rc2014/run.fs

@@ -1 +1,9 @@
-: INIT 5 5 PC! BYE ACIA$ INTERPRET ;
+: INIT
+    ACIA$
+    (c<$)
+    ." Collapse OS" LF
+    ( 0c == CINPTR )
+    ['] (c<) 0x0c RAM+ !
+;
+INIT
+

tools/.gitignore

@@ -5,3 +5,4 @@
 /ttysafe
 /pingpong
 /slatest
+/stripfc

tools/Makefile

@@ -5,8 +5,9 @@ FONTCOMPILE_TGT = fontcompile
 TTYSAFE_TGT = ttysafe
 PINGPONG_TGT = pingpong
 SLATEST_TGT = slatest
+STRIPFC_TGT = stripfc
 TARGETS = $(MEMDUMP_TGT) $(BLKDUMP_TGT) $(UPLOAD_TGT) $(FONTCOMPILE_TGT) \
-	$(TTYSAFE_TGT) $(PINGPONG_TGT) $(SLATEST_TGT)
+	$(TTYSAFE_TGT) $(PINGPONG_TGT) $(SLATEST_TGT) $(STRIPFC_TGT)
 OBJS = common.o
 
 all: $(TARGETS)
@@ -22,6 +23,7 @@ $(FONTCOMPILE_TGT): $(FONTCOMPILE_TGT).c
 $(TTYSAFE_TGT): $(TTYSAFE_TGT).c
 $(PINGPONG_TGT): $(PINGPONG_TGT).c
 $(SLATEST_TGT): $(SLATEST_TGT).c
+$(STRIPFC_TGT): $(STRIPFC_TGT).c
 $(TARGETS): $(OBJS)
 	$(CC) $(CFLAGS) $@.c $(OBJS) -o $@
 

tools/stripfc.c

@@ -0,0 +1,55 @@
+#include <stdio.h>
+
+/* read stdin and strip Forth-style comments before spitting in stdout. This
+also deduplicate spaces and newlines.
+
+THIS PARSING IS IMPERFECT. Only a Forth interpreter can reliably detect
+comments. For example, a naive parser misinterprets the "(" word definition as
+a comment.
+
+We work around this by considering as a comment opener only "(" chars preceeded
+by more than once space or by a newline. Hackish, but works.
+*/
+
+int main()
+{
+    int spccnt = 0;
+    int incomment = 0;
+    int c;
+    c = getchar();
+    while ( c != EOF ) {
+        if (c == '\n') {
+            // We still spit newlines whenever we see them, Forth interpreter
+            // doesn't like when they're not there...
+            putchar(c);
+            spccnt += 2;
+        } else if (c == ' ') {
+            spccnt++;
+        } else {
+            if (incomment) {
+                if ((c == ')') && spccnt) {
+                    incomment = 0;
+                }
+            } else {
+                if ((c == '(') && (spccnt > 1)) {
+                    putchar(' ');
+                    spccnt = 0;
+                    int next = getchar();
+                    if (next <= ' ') {
+                        incomment = 1;
+                        continue;
+                    }
+                    putchar(c);
+                    c = next;
+                }
+                if (spccnt) {
+                    putchar(' ');
+                }
+                putchar(c);
+            }
+            spccnt = 0;
+        }
+        c = getchar();
+    }
+    return 0;
+}