forth: Implement "(parseh)"

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 ***
 

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! "

apps/forth/str.fs

@@ -0,0 +1,7 @@
+: SLEN      ( a -- n )
+    DUP     ( astart aend )
+    BEGIN
+    DUP C@ 0 = IF -^ EXIT THEN
+    1 +
+    AGAIN
+;

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