From 548facac0b44143f9233a37af3e4eb6fe65b583b Mon Sep 17 00:00:00 2001
From: Virgil Dupras <hsoft@hardcoded.net>
Date: Wed, 18 Mar 2020 21:52:55 -0400
Subject: [PATCH] forth: Implement "(parseh)"

---
 apps/forth/dictionary.txt |  1 +
 apps/forth/parse.fs       | 45 +++++++++++++++++++++++++++++++++++----
 apps/forth/str.fs         |  7 ++++++
 emul/Makefile             |  2 +-
 4 files changed, 50 insertions(+), 5 deletions(-)
 create mode 100644 apps/forth/str.fs

diff --git a/apps/forth/dictionary.txt b/apps/forth/dictionary.txt
index 16d4376..397e62a 100644
--- a/apps/forth/dictionary.txt
+++ b/apps/forth/dictionary.txt
@@ -141,6 +141,7 @@ NOT         f -- f          Push the logical opposite of f
 *** Strings ***
 LITS x      -- a            Read following LIT and push its addr to a
 SCMP        a1 a2 -- n      Compare strings a1 and a2. See CMP
+SLEN        a -- n          Push length of str at a.
 
 *** I/O ***
 
diff --git a/apps/forth/parse.fs b/apps/forth/parse.fs
index ac5fc2c..f672dbe 100644
--- a/apps/forth/parse.fs
+++ b/apps/forth/parse.fs
@@ -1,15 +1,52 @@
-( requires core )
+( requires core, str )
+( string being sent to parse routines are always null
+  terminated )
 
 : (parsec)          ( a -- n f )
     ( apostrophe is ASCII 39 )
-    DUP C@ 39 = NOT IF 0 EXIT THEN      ( -- a 0 )
-    DUP 2 + C@ 39 = NOT IF 0 EXIT THEN  ( -- a 0 )
+    DUP C@ 39 = NOT IF 0 EXIT THEN      ( a 0 )
+    DUP 2 + C@ 39 = NOT IF 0 EXIT THEN  ( a 0 )
     ( surrounded by apos, good, return )
-    1 + C@ 1       ( -- n 1 )
+    1 + C@ 1                            ( n 1 )
+;
+
+( returns negative value on error )
+: hexdig            ( c -- n )
+    ( '0' is ASCII 48 )
+    48 -
+    DUP 0 < IF EXIT THEN                ( bad )
+    DUP 10 < IF EXIT THEN               ( good )
+    ( 'a' is ASCII 97. 59 = 97 - 48 )
+    49 -
+    DUP 0 < IF EXIT THEN                ( bad )
+    DUP 6 < IF 10 + EXIT THEN           ( good )
+    ( bad )
+    255 -
+;
+
+: (parseh)          ( a -- n f )
+    ( '0': ASCII 0x30 'x': 0x78 0x7830: 30768 )
+    DUP @ 30768 = NOT IF 0 EXIT THEN    ( a 0 )
+    ( We have "0x" suffix )
+    2 +
+    ( validate slen )
+    DUP SLEN                            ( a l )
+    DUP 0 = IF DROP 0 EXIT THEN         ( a 0 )
+    4 > IF DROP 0 EXIT THEN             ( a 0 )
+    0 ( a r )
+    BEGIN
+    OVER C@
+    DUP 0 = IF DROP SWAP DROP 1 EXIT THEN ( r, 1 )
+    hexdig                              ( a r n )
+    DUP 0 < IF DROP DROP 1 EXIT THEN    ( a 0 )
+    SWAP 16 * +                         ( a r*16+n )
+    SWAP 1 + SWAP                       ( a+1 r )
+    AGAIN
 ;
 
 : (parse)           ( a -- n )
     (parsec) NOT SKIP? EXIT
+    (parseh) NOT SKIP? EXIT
     (parsed) NOT SKIP? EXIT
     ( nothing works )
     ABORT" unknown word! "
diff --git a/apps/forth/str.fs b/apps/forth/str.fs
new file mode 100644
index 0000000..b877be0
--- /dev/null
+++ b/apps/forth/str.fs
@@ -0,0 +1,7 @@
+: SLEN      ( a -- n )
+    DUP     ( astart aend )
+    BEGIN
+    DUP C@ 0 = IF -^ EXIT THEN
+    1 +
+    AGAIN
+;
diff --git a/emul/Makefile b/emul/Makefile
index 043238d..14b5fb4 100644
--- a/emul/Makefile
+++ b/emul/Makefile
@@ -7,7 +7,7 @@ AVRABIN = zasm/avra
 SHELLAPPS = zasm ed
 SHELLTGTS = ${SHELLAPPS:%=cfsin/%}
 # Those Forth source files are in a particular order
-FORTHSRCS = core.fs parse.fs fmt.fs
+FORTHSRCS = core.fs str.fs parse.fs fmt.fs
 FORTHSRC_PATHS = ${FORTHSRCS:%=$(APPS)/forth/%}
 CFSIN_CONTENTS = $(SHELLTGTS) cfsin/user.h
 OBJS = emul.o libz80/libz80.o