emul/forth/forth.c

@@ -8,13 +8,9 @@
 // in sync with glue.asm
 #define RAMSTART 0x900
 #define STDIO_PORT 0x00
-// This binary is also used for automated tests and those tests, when
-// failing, send a non-zero value to RET_PORT to indicate failure
-#define RET_PORT 0x01
 
 static int running;
 static FILE *fp;
-static int retcode = 0;
 
 static uint8_t iord_stdio()
 {
@@ -34,12 +30,6 @@ static void iowr_stdio(uint8_t val)
     }
 }
 
-static void iowr_ret(uint8_t val)
-{
-    retcode = val;
-}
-
-
 int main(int argc, char *argv[])
 {
     bool tty = false;
@@ -71,7 +61,6 @@ int main(int argc, char *argv[])
     m->ramstart = RAMSTART;
     m->iord[STDIO_PORT] = iord_stdio;
     m->iowr[STDIO_PORT] = iowr_stdio;
-    m->iowr[RET_PORT] = iowr_ret;
     // initialize memory
     for (int i=0; i<sizeof(KERNEL); i++) {
         m->mem[i] = KERNEL[i];
@@ -89,5 +78,5 @@ int main(int argc, char *argv[])
         emul_printdebug();
     }
     fclose(fp);
-    return retcode;
+    return 0;
 }

forth/dictionary.txt

@@ -194,7 +194,3 @@ PC!         c a --          Spit c to port a
 PC@         a -- c          Fetch c from port a
 WORD        -- a            Read one word from buffered input and push its addr
 
-There are also ascii const emitters:
-LF
-SPC
-

forth/parse.fs

@@ -27,7 +27,7 @@
 : (parseh)          ( a -- n f )
     ( '0': ASCII 0x30 'x': 0x78 0x7830: 30768 )
     DUP @ 30768 = NOT IF 0 EXIT THEN    ( a 0 )
-    ( We have "0x" prefix )
+    ( We have "0x" suffix )
     2 +
     ( validate slen )
     DUP SLEN                            ( a l )
@@ -44,40 +44,9 @@
     AGAIN
 ;
 
-( returns negative value on error )
-: bindig            ( c -- n )
-    ( '0' is ASCII 48 )
-    48 -
-    DUP 0 < IF EXIT THEN                ( bad )
-    DUP 2 < IF EXIT THEN                ( good )
-    ( bad )
-    255 -
-;
-
-: (parseb)          ( a -- n f )
-    ( '0': ASCII 0x30 'b': 0x62 0x6230: 25136 )
-    DUP @ 25136 = NOT IF 0 EXIT THEN    ( a 0 )
-    ( We have "0b" prefix )
-    2 +
-    ( validate slen )
-    DUP SLEN                            ( a l )
-    DUP 0 = IF DROP 0 EXIT THEN         ( a 0 )
-    16 > IF DROP 0 EXIT THEN            ( a 0 )
-    0 ( a r )
-    BEGIN
-    OVER C@
-    DUP 0 = IF DROP SWAP DROP 1 EXIT THEN ( r, 1 )
-    bindig                              ( a r n )
-    DUP 0 < IF DROP DROP 1 EXIT THEN    ( a 0 )
-    SWAP 2 * +                          ( a r*2+n )
-    SWAP 1 + SWAP                       ( a+1 r )
-    AGAIN
-;
-
 : (parse)           ( a -- n )
     (parsec) NOT SKIP? EXIT
     (parseh) NOT SKIP? EXIT
-    (parseb) NOT SKIP? EXIT
     (parsed) NOT SKIP? EXIT
     ( nothing works )
     ABORT" unknown word! "

forth/str.fs

@@ -5,6 +5,3 @@
     1 +
     AGAIN
 ;
-
-: LF 10 EMIT ;
-: SPC 32 EMIT ;

tests/Makefile

@@ -2,9 +2,8 @@ EMULDIR = ../emul
 
 .PHONY: run
 run:
-	$(MAKE) -C $(EMULDIR) zasm/zasm zasm/avra runbin/runbin shell/shell forth/forth
+	$(MAKE) -C $(EMULDIR) zasm/zasm zasm/avra runbin/runbin shell/shell
 	cd unit && ./runtests.sh
 	cd zasm && ./runtests.sh
 	cd avra && ./runtests.sh
 	cd shell && ./runtests.sh
-	cd forth && ./runtests.sh

tests/forth/harness.fs

@@ -1,9 +0,0 @@
-( Forth testing harness
-  "#" means "assert". We stop at first failure, indicating
-  the failure through IO on port 1 )
-
-: fail SPC ." failed" LF 1 1 PC! BYE ;
-
-: # SKIP? fail SPC ." pass" LF ;
-
-: #eq 2DUP SWAP . SPC '=' EMIT SPC . '?' EMIT = # ;

tests/forth/runtests.sh

@@ -1,27 +0,0 @@
-#!/bin/sh -e
-
-BASE=../..
-EXEC="${BASE}/emul/forth/forth"
-FDIR="${BASE}/forth"
-TMP=$(mktemp)
-
-chk() {
-    echo "Running test $1"
-    cat harness.fs $1 > ${TMP}
-    if ! ${EXEC} ${TMP}; then
-        exit 1
-    fi
-}
-
-if [ ! -z $1 ]; then
-    chk $1
-    exit 0
-fi
-
-# those tests run without any builtin
-for fn in test_*.fs; do
-    chk "${fn}"
-done
-
-echo "All tests passed!"
-rm ${TMP}

tests/forth/test_ari.fs

@@ -1,5 +0,0 @@
-48 13 + 61 #eq
-48 13 - 35 #eq
-48 13 * 624 #eq
-48 13 / 3 #eq
-48 13 MOD 9 #eq

tests/forth/test_parse.fs

@@ -1,2 +0,0 @@
-'b' 0x62 #eq
-0b1111010101 981 #eq