upload: use A! instead of C!

It makes the tool much more versatile. I'll have adev being included
in all recipes, so it can be assumed.

dictionary.txt

@@ -38,25 +38,31 @@ $ - Initialize
 ~ - Container for native code. Usually not an executable word.
 ? - Is it ...? (example: IMMED?)
 
-*** Defining words ***
+*** Entry management ***
 (find)      a -- a f        Read at a and find it in dict. If found, f=1 and
                             a = wordref. If not found, f=0 and a = string addr.
-: x ...     --              Define a new word
-;           R:I --          Exit a colon definition
-,           n --            Write n in HERE and advance it.
 ' x         -- a            Push addr of word x to a. If not found, aborts
 ['] x       --              *I* Like "'", but spits the addr as a number
                             literal. If not found, aborts.
-(           --              *I* Comment. Ignore rest of line until ")" is read.
+,           n --            Write n in HERE and advance it.
 ALLOT       n --            Move HERE by n bytes
 C,          b --            Write byte b in HERE and advance it.
+DELW        a --            Delete wordref at a. If it shadows another
+                            definition, that definition is unshadowed.
+FORGET x    --              Rewind the dictionary (both CURRENT and HERE) up to
+                            x's previous entry.
+PREV        a -- a          Return a wordref's previous entry.
+WHLEN       a -- n          Get word header length from wordref. That is, name
+                            length + 3. a is a wordref
+
+*** Defining words ***
+: x ...     --              Define a new word
+;           R:I --          Exit a colon definition
 CREATE x    --              Create cell named x. Doesn't allocate a PF.
 [COMPILE] x --              Compile word x and write it to HERE. IMMEDIATE
                             words are *not* executed.
 COMPILE x   --              Meta compiles. Kind of blows the mind. See below.
 CONSTANT x  n --            Creates cell x that when called pushes its value
-DELW        a --            Delete wordref at a. If it shadows another
-                            definition, that definition is unshadowed.
 DOES>       --              See description in usage.txt
 IMMED?      a -- f          Checks whether wordref at a is immediate.
 IMMEDIATE   --              Flag the latest defined word as immediate.
@@ -72,6 +78,7 @@ input stream is executed immediately. In this context, branching doesn't work.
 (br)        --              Branches by the number specified in the 2 following
                             bytes. Can be negative.
 (?br)       f --            Branch if f is false.
+(           --              *I* Comment. Ignore rest of line until ")" is read.
 [           --              Begin interetative mode. In a definition, words
                             between here and "]" will be executed instead of
                             compiled.

emul/Makefile

@@ -29,7 +29,7 @@ $(BIN2C):
 forth/forth0.bin: $(SLATEST)
 	cp forth/z80c.bin $@
 	$(SLATEST) $@
-	cat forth/emul.fs >> $@
+	cat forth/pre.fs forth/emul.fs >> $@
 
 forth/forth0-bin.h: forth/forth0.bin $(BIN2C)
 	$(BIN2C) KERNEL < forth/forth0.bin | tee $@ > /dev/null
@@ -43,14 +43,14 @@ forth/stage1dbg: forth/stage.c $(OBJS) forth/forth0-bin.h
 # 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 | $(STRIPFC) | ./forth/stage1 | tee $@ > /dev/null
+	cat $(FORTHSRC_PATHS) ./forth/stop.fs | $(STRIPFC) | ./forth/stage1 > $@
 
 forth/forth1.bin: forth/core.bin $(SLATEST)
 	cat forth/z80c.bin forth/core.bin > $@
 	$(SLATEST) $@
 
 forth/forth1-bin.h: forth/forth1.bin $(BIN2C)
-	$(BIN2C) KERNEL < forth/forth1.bin | tee $@ > /dev/null
+	$(BIN2C) KERNEL < forth/forth1.bin > $@
 
 forth/stage2: forth/stage.c $(OBJS) forth/forth1-bin.h 
 	$(CC) -DSTAGE2 forth/stage.c $(OBJS) -o $@

emul/forth/pre.fs

@@ -0,0 +1,2 @@
+CURRENT @ HERE !
+

emul/forth/run.fs

@@ -1 +1 @@
-: INIT RDLN$ Z80A$ INTERPRET ;
+: INIT CURRENT @ HERE ! RDLN$ Z80A$ INTERPRET ;

forth/boot.fs

@@ -118,12 +118,14 @@ PC ORG @ 1 + ! ( main )
     SP 0xfffa LDddnn,
     RAMSTART SP LD(nn)dd, ( RAM+00 == INITIAL_SP )
     IX RS_ADDR LDddnn,
+( HERE begins at RAMEND )
+    HL RAMSTART 0x80 + LDddnn,
+    RAMSTART 0x04 + LD(nn)HL, ( RAM+04 == HERE )
 ( LATEST is a label to the latest entry of the dict. It is
   written at offset 0x08 by the process or person building
   Forth. )
     0x08 LDHL(nn),
     RAMSTART 0x02 + LD(nn)HL, ( RAM+02 == CURRENT )
-    RAMSTART 0x04 + LD(nn)HL, ( RAM+04 == HERE )
     EXDEHL,
     HL L1 @ LDddnn,
     0x03 CALLnn,        ( 03 == find )

forth/core.fs

@@ -117,3 +117,22 @@
 : DELW
     1 - 0 SWAP C!
 ;
+
+: PREV
+    3 - DUP @                   ( a o )
+    -                           ( a-o )
+;
+
+: WHLEN
+    1 - C@      ( name len field )
+    127 AND     ( 0x7f. remove IMMEDIATE flag )
+    3 +         ( fixed header len )
+;
+
+: FORGET
+    ' DUP               ( w w )
+    ( HERE must be at the end of prev's word, that is, at the
+      beginning of w. )
+    DUP WHLEN - HERE !  ( w )
+    PREV CURRENT !
+;

forth/link.fs

@@ -39,15 +39,6 @@
     1 +
 ;
 
-( Get word header length from wordref. That is, name length
-  + 3. a is a wordref )
-( a -- n )
-: WHLEN
-    1 - C@      ( name len field )
-    0x7f AND    ( remove IMMEDIATE flag )
-    3 +         ( fixed header len )
-;
-
 ( Get word addr, starting at name's address )
 : '< ' DUP WHLEN - ;
 
@@ -121,13 +112,6 @@
 
 ( TODO implement RLCELL )
 
-( Get word's prev offset )
-( a -- a )
-: PREV
-    3 - DUP @                   ( a o )
-    -                           ( a-o )
-;
-
 ( Copy dict from target wordref, including header, up to HERE.
   We're going to compact the space between that word and its
   prev word. To do this, we're copying this whole memory area

notes.txt

@@ -170,8 +170,11 @@ advanced to the address following the null.
 *** Initialization sequence
 
 On boot, we jump to the "main" routine in boot.fs which does very few things.
-It sets up the SP register, CURRENT and HERE to LATEST (saved in stable ABI),
-then look for the BOOT word and calls it.
+
+1. Set SP to 0x10000-6
+2. Sets HERE to RAMEND (RAMSTART+0x80).
+3. Sets CURRENT to value of LATEST field in stable ABI.
+4. Look for the word "BOOT" and calls it.
 
 In a normal system, BOOT is in icore and does a few things:
 
@@ -192,9 +195,9 @@ as such until you set a new (c<).
 Note that there is no EMIT in a bare system. You have to take care of supplying
 one before your load core.fs and its higher levels.
 
-Also note that this initialization code is fighting for space with HERE: New
-entries to the dict will overwrite that code! Also, because we're barebone, we
-can't have comments. This leads to peculiar code in this area. If you see weird
-whitespace usage, it's probably because not using those whitespace would result
-in dict entry creation overwriting the code before it has the chance to be
-interpreted.
+In the "/emul" binaries, "HERE" is readjusted to "CURRENT @" so that we don't
+have to relocate compiled dicts. Note that in this context, the initialization
+code  is fighting for space with HERE: New entries to the dict will overwrite
+that code! Also, because we're barebone, we can't have comments. This can lead
+to peculiar code in this area where we try to "waste" space in initialization
+code.

recipes/rc2014/Makefile

@@ -1,4 +1,4 @@
-TARGET = os.bin
+TARGET = stage1.bin
 BASEDIR = ../..
 FDIR = $(BASEDIR)/forth
 EDIR = $(BASEDIR)/emul/forth
@@ -13,7 +13,7 @@ BOOTSRCS = conf.fs \
 	$(FDIR)/icore.fs \
 	$(EDIR)/xstop.fs
 
-PATHS = pre.fs \
+PATHS = \
 	$(FDIR)/core.fs \
 	$(FDIR)/cmp.fs \
 	$(FDIR)/str.fs \

recipes/rc2014/README.md

@@ -202,9 +202,9 @@ using our hex editor.
 
 Now are we ready yet? ALMOST! There's one last thing we need to do: add runtime
 source. In our case, because we have a compiled dict, the only source we need
-to include is `pre.fs` and `run.fs`:
+to include is `run.fs`:
 
-    cat stage2.bin pre.fs run.fs > stage2r.bin
+    cat stage2.bin run.fs > stage2r.bin
 
 That's it! our binary is ready to run!
 
@@ -212,7 +212,8 @@ That's it! our binary is ready to run!
 
 And there you have it, a stage2 binary that you've assembled yourself. Now,
 here's for your homework: use the same technique to add the contents of
-`readln.fs` to stage2 so that you have a full-featured interpreter.
+`readln.fs` and `adev.fs` to stage2 so that you have a full-featured
+interpreter.
 
 Name it `stage3.bin` (the version without any source code appended and no
 `INIT` word defined), you'll need this binary for sub-recipes written for the
@@ -221,9 +222,10 @@ RC2014.
 Here's a little cheatsheet, but seriously, you should figure most of it
 yourself. Tough love they call it.
 
-* `cat stage2.bin pre.fs ../../forth/readln.fs run.fs > stage2r.bin`
-* Don't forget `(c<$)`.
+* `cat stage2.bin ../../forth/readln.fs ../../forth/adev.fs run.fs > stage2r.bin`
+* Don't forget `RDLN$` and `ADEV$`.
 * `RLDICT` is like `RLCORE` but with a chosen target.
+* `stripfc` can help you deal with size constraints.
 
 [rc2014]: https://rc2014.co.uk
 [romwrite]: https://github.com/hsoft/romwrite

recipes/rc2014/pre.fs

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

tools/.gitignore

@@ -7,3 +7,4 @@
 /slatest
 /stripfc
 /bin2c
+/exec

tools/Makefile

@@ -7,9 +7,10 @@ PINGPONG_TGT = pingpong
 SLATEST_TGT = slatest
 STRIPFC_TGT = stripfc
 BIN2C_TGT = bin2c
+EXEC_TGT = exec
 TARGETS = $(MEMDUMP_TGT) $(BLKDUMP_TGT) $(UPLOAD_TGT) $(FONTCOMPILE_TGT) \
 	$(TTYSAFE_TGT) $(PINGPONG_TGT) $(SLATEST_TGT) $(STRIPFC_TGT) \
-	$(BIN2C_TGT)
+	$(BIN2C_TGT) $(EXEC_TGT)
 OBJS = common.o
 
 all: $(TARGETS)
@@ -27,6 +28,7 @@ $(PINGPONG_TGT): $(PINGPONG_TGT).c
 $(SLATEST_TGT): $(SLATEST_TGT).c
 $(STRIPFC_TGT): $(STRIPFC_TGT).c
 $(BIN2C_TGT): $(BIN2C_TGT).c
+$(EXEC_TGT): $(EXEC_TGT).c
 $(TARGETS): $(OBJS)
 	$(CC) $(CFLAGS) $@.c $(OBJS) -o $@
 

tools/common.c

@@ -1,5 +1,18 @@
 #include <stdlib.h>
 #include <unistd.h>
+#include <termios.h>
+#include <errno.h>
+#include <stdio.h>
+#include <string.h>
+
+void mread(int fd, char *s, int count)
+{
+    while (count) {
+        while (read(fd, s, 1) == 0);
+        s++;
+        count--;
+    }
+}
 
 void sendcmd(int fd, char *cmd)
 {
@@ -12,8 +25,8 @@ void sendcmd(int fd, char *cmd)
         // it breathe, it can choke.
         usleep(1000);
     }
-    write(fd, "\n", 1);
-    read(fd, &junk, 2); // sends back \r\n
+    write(fd, "\r", 1);
+    mread(fd, junk, 2); // sends back \r\n
     usleep(1000);
 }
 
@@ -22,5 +35,66 @@ void sendcmdp(int fd, char *cmd)
 {
     char junk[2];
     sendcmd(fd, cmd);
-    read(fd, &junk, 2);
+    mread(fd, junk, 2);
 }
+
+// from https://stackoverflow.com/a/6947758
+// discussion from https://stackoverflow.com/a/26006680 is interesting,
+// but we don't want POSIX compliance.
+
+int set_interface_attribs(int fd, int speed, int parity)
+{
+    struct termios tty;
+    if (tcgetattr (fd, &tty) != 0) {
+        fprintf(stderr, "error %d from tcgetattr", errno);
+        return -1;
+    }
+
+    if (speed) {
+        cfsetospeed (&tty, speed);
+        cfsetispeed (&tty, speed);
+    }
+
+    tty.c_cflag = (tty.c_cflag & ~CSIZE) | CS8;     // 8-bit chars
+    // disable IGNBRK for mismatched speed tests; otherwise receive break
+    // as \000 chars
+    tty.c_iflag &= ~IGNBRK;         // disable break processing
+    tty.c_lflag = 0;                // no signaling chars, no echo,
+                                    // no canonical processing
+    tty.c_oflag = 0;                // no remapping, no delays
+    tty.c_cc[VMIN]  = 0;            // read doesn't block
+    tty.c_cc[VTIME] = 5;            // 0.5 seconds read timeout
+
+    tty.c_iflag &= ~(IXON | IXOFF | IXANY); // shut off xon/xoff ctrl
+
+    tty.c_cflag |= (CLOCAL | CREAD);// ignore modem controls,
+                                    // enable reading
+    tty.c_cflag &= ~(PARENB | PARODD);      // shut off parity
+    tty.c_cflag |= parity;
+    tty.c_cflag &= ~CSTOPB;
+    tty.c_cflag &= ~CRTSCTS;
+
+    if (tcsetattr (fd, TCSANOW, &tty) != 0) {
+        fprintf(stderr, "error %d from tcsetattr", errno);
+        return -1;
+    }
+    return 0;
+}
+
+void set_blocking(int fd, int should_block)
+{
+    struct termios tty;
+    memset(&tty, 0, sizeof tty);
+    if (tcgetattr (fd, &tty) != 0) {
+        fprintf(stderr, "error %d from tggetattr", errno);
+        return;
+    }
+
+    tty.c_cc[VMIN]  = should_block ? 1 : 0;
+    tty.c_cc[VTIME] = 1;            // 0.1 seconds read timeout
+
+    if (tcsetattr (fd, TCSANOW, &tty) != 0) {
+        fprintf(stderr, "error %d setting term attributes", errno);
+    }
+}
+

tools/common.h

@@ -1,3 +1,6 @@
 void sendcmd(int fd, char *cmd);
 void sendcmdp(int fd, char *cmd);
+void mread(int fd, char *s, int count);
+int set_interface_attribs(int fd, int speed, int parity);
+void set_blocking(int fd, int should_block);
 

tools/exec.c

@@ -0,0 +1,38 @@
+#include <stdlib.h>
+#include <stdio.h>
+#include <fcntl.h>
+#include <unistd.h>
+
+#include "common.h"
+
+/* Execute code from stdin on the target machine.
+ */
+
+int main(int argc, char **argv)
+{
+    if (argc != 2) {
+        fprintf(stderr, "Usage: ./exec device\n");
+        return 1;
+    }
+    int fd = open(argv[1], O_RDWR|O_NOCTTY|O_SYNC);
+    if (fd < 0) {
+        fprintf(stderr, "Could not open %s\n", argv[1]);
+        return 1;
+    }
+    set_interface_attribs(fd, 0, 0);
+    set_blocking(fd, 0);
+    int c = getchar();
+    while (c != EOF) {
+        if (c == '\n') c = '\r';
+        write(fd, &c, 1);
+        while (read(fd, &c, 1) == 1) {
+            putchar(c);
+            fflush(stdout);
+        }
+        c = getchar();
+    }
+    printf("Done!\n");
+    return 0;
+}
+
+

tools/upload.c

@@ -5,7 +5,7 @@
 
 #include "common.h"
 
-/* Push specified file to specified device running the BASIC shell and verify
+/* Push specified file to specified device running Forth and verify
  * that the sent contents is correct.
  */
 
@@ -35,11 +35,17 @@ int main(int argc, char **argv)
         return 1;
     }
     rewind(fp);
-    int fd = open(argv[1], O_RDWR|O_NOCTTY);
+    int fd = open(argv[1], O_RDWR|O_NOCTTY|O_SYNC);
+    if (fd < 0) {
+        fprintf(stderr, "Could not open %s\n", argv[1]);
+        return 1;
+    }
+    set_interface_attribs(fd, 0, 0);
+    set_blocking(fd, 1);
     char s[0x40];
-    sprintf(s, "m=0x%04x", memptr);
-    sendcmdp(fd, s);
-    sprintf(s, "while m<0x%04x getc:puth a:poke m a:m=m+1", memptr+bytecount);
+    sprintf(s,
+        ": _ 0x%04x 0x%04x DO KEY DUP .x I A! LOOP ; _",
+        memptr+bytecount, memptr);
     sendcmd(fd, s);
 
     int returncode = 0;
@@ -49,7 +55,7 @@ int main(int argc, char **argv)
         unsigned char c = s[0];
         write(fd, &c, 1);
         usleep(1000); // let it breathe
-        read(fd, s, 2); // read hex pair
+        mread(fd, s, 2); // read hex pair
         s[2] = 0; // null terminate
         unsigned char c2 = strtol(s, NULL, 16);
         if (c != c2) {
@@ -60,6 +66,8 @@ int main(int argc, char **argv)
             returncode = 1;
         }
     }
+    mread(fd, s, 2); // "> " prompt
+    sendcmdp(fd, "FORGET _");
     printf("Done!\n");
     fclose(fp);
     return returncode;