From c40f33695966572b0c7e820e32c3ff5ac8a4d357 Mon Sep 17 00:00:00 2001
From: Virgil Dupras <hsoft@hardcoded.net>
Date: Wed, 15 Apr 2020 10:41:27 -0400
Subject: [PATCH] icore: extract "_pdacc" from "(parsed)"

Makes boot binary a bit bigger, but that "_pdacc" word will be
reused in high level apps.
---
 emul/forth/z80c.bin | Bin 2196 -> 2241 bytes
 forth/icore.fs      |  57 ++++++++++++++++++++++++++++----------------
 2 files changed, 36 insertions(+), 21 deletions(-)

diff --git a/emul/forth/z80c.bin b/emul/forth/z80c.bin
index 5efc075d11ca13cee1ae76d027cd491d9efc998d..3bf4d8b78e8da3eed1b19cf328dfa901baba953c 100644
GIT binary patch
delta 421
zcmYk2y-UMT6vfYb$$LpVL?R-cO5B=3>f%tvDRyWnMM{z42c@)i(MX6c+QGd`hPb-B
z>F8F($)PUY3S9~n7ZLgo)ccHx+k5Ap`#bmETl?9548=_|=(O7HWk?Gn=3ou`B0w55
zdNX)%uz?9z75u9#7T%9Lg_A$G(&pq#<BJcu@_Wbyt?;7TagSgs{F$ae>nKxGCW$z}
zkdK9O57>mynMwq4dSb-X9Qj|;j43uFx55nQmpDEaN-c{4n^A9)=bpl_FpjhGS{%v|
zyN~arW4}nj3tGZR)Hj)B{rFS5+&1Ejk<I(EFJJYtHrERp!Mf*{;g!3iU{kqmcqmot
z#oAu2ShtZPE$$i*D-r3HQoVW%-J;nY_|lJaW^UJ)@0yxvYYEIk&v0N-Z7MZdewB{V
bG6R^1(11>QgLZwQ=m-_Ffic~(xe4|S_)cUm

delta 401
zcmY*VF-yZh7=3q1E@_8Ipg45UjLlGW(4m45h#gv`N~w~ih+>^YLUmCo{)B=N7k`8f
z7F``Hbm}H_Gp@p|4)wbp4h{$J-uLm|``(*(=RI|;n^JPvJ?|U`1voCo?9>>u7oNaG
zL_Z&8)U5<XWP}+;yk|*5fMgRcSp<!JtYE^`KCn;wc`S2<wMGsn|2U<P$2T95LRrg7
zX7NAk=V`_y(}odrzTg42i(a}VuB;_7X4mPv@V$Fs@rt1pH2WhKSUWA+!Oo``n)TUC
z1sj?bLq%4cq&MNAXwNnzO~|ElcG0~IHk8XixORkEqg8G0HmfZUIpWe=`>}9D{C2I?
zXv1{ravz}x(><rO8Hz6>qc+y(z+5zJA1=)X!l1k7smE0(frCC`>NONGUH?iU`dD;g
Ld`u%8tbzRkr)FH7

diff --git a/forth/icore.fs b/forth/icore.fs
index 2cd62f7..3f78412 100644
--- a/forth/icore.fs
+++ b/forth/icore.fs
@@ -52,37 +52,52 @@
 : < CMP -1 = ;
 : > CMP 1 = ;
 
+( r c -- r f )
+( Parse digit c and accumulate into result r.
+  Flag f is 0 when c was a valid digit, 1 when c was WS,
+  -1 when c was an invalid digit. )
+: _pdacc
+    DUP 0x21 < IF DROP 1 EXIT THEN
+    ( parse char )
+    '0' -
+    ( if bad, return "r -1" )
+    DUP 0 < IF DROP -1 EXIT THEN   ( bad )
+    DUP 9 > IF DROP -1 EXIT THEN   ( bad )
+    ( good, add to running result )
+    SWAP 10 * +                    ( r*10+n )
+    0                              ( good )
+;
+
 : (parsed)      ( a -- n f )
     ( read first char outside of the loop. it *has* to be
       nonzero. )
-    DUP C@                    ( a c )
-    DUP NOT IF EXIT THEN      ( a 0 )
+    DUP C@                        ( a c )
     ( special case: do we have a negative? )
     DUP '-' = IF
         ( Oh, a negative, let's recurse and reverse )
         DROP 1 +                  ( a+1 )
-        (parsed)                     ( n f )
-        SWAP 0 SWAP               ( f 0 n )
+        (parsed)                  ( n f )
+        0 ROT                     ( f 0 n )
         - SWAP EXIT               ( 0-n f )
     THEN
-    ( running result, staring at zero )
+    ( running result from first char )
     0 SWAP                               ( a r c )
-    ( Loop over chars )
-    BEGIN
-    ( parse char )
-    '0' -
-    ( if bad, return "a 0" )
-    DUP 0 < IF 2DROP 0 EXIT THEN   ( bad )
-    DUP 9 > IF 2DROP 0 EXIT THEN   ( bad )
-    ( good, add to running result )
-    SWAP 10 * +                    ( a r*10+n )
-    SWAP 1 + SWAP                  ( a+1 r )
-    ( read next char )
-    OVER C@
-    DUP NOT UNTIL
-    ( we're done and it's a success. We have "a r c", we want
-      "r 1". )
-    DROP SWAP DROP 1
+    _pdacc                               ( a r f )
+    DUP IF
+        ( first char was not a valid digit )
+        2DROP 0 EXIT                     ( a 0 )
+    THEN
+    BEGIN                         ( a r 0 )
+        DROP SWAP 1 +             ( r a+1 )
+        DUP C@                    ( r a c )
+        ROT SWAP                  ( a r c )
+        _pdacc                    ( a r f )
+    DUP UNTIL
+    ( a r f -- f is 1 on success, -1 on error, normalize
+      to bool. )
+    1 =         ( a r f )
+    ( we want "r f" )
+    ROT DROP
 ;
 
 ( This is only the "early parser" in earlier stages. No need