From 7d859d4f23331b2498def025ad7c22a0b3a27cb9 Mon Sep 17 00:00:00 2001
From: Jesse McDonald <nybble41@gmail.com>
Date: Fri, 6 Nov 2020 20:31:34 -0600
Subject: [PATCH] add support for # suffix to indicate double-cell numbers

---
 jumpforth.S | 33 +++++++++++++++++++--------------
 startup.4th | 29 +++++++++++++++++++++--------
 2 files changed, 40 insertions(+), 22 deletions(-)

diff --git a/jumpforth.S b/jumpforth.S
index a7c4bc9..bca38db 100644
--- a/jumpforth.S
+++ b/jumpforth.S
@@ -1450,10 +1450,10 @@ defword PARSENUMBER,,F_HIDDEN
    .int SWAP,ADD1,SWAP,BRANCH,(0b - .)
 5: .int DROP
 6: .int RDROP,RDROP
-7: .int TWODROP,FALSE,EXIT
+7: .int TWODROP,LIT,0,EXIT
 8: .int DROP,FROMR,FROMR,ZBRANCH,(9f - .)
    .int NEGATE
-9: .int TRUE,EXIT
+9: .int LIT,1,EXIT
 
 defword INTERPRET,,F_HIDDEN
    .int SKIP_SPACE
@@ -1466,21 +1466,26 @@ defword INTERPRET,,F_HIDDEN
    litstring "Tried to interpret a string literal\n"
    .int     TYPE,BAILOUT
    /*   ELSE */
-1: .int   PARSE_NAME,TWODUP,BOOTSTRAP_PARSENUMBER,ZBRANCH,(3f - .)
-   .int     STATE,FETCH,TWONIP,ZBRANCH,(2f - .)
-   .int       LIT,LIT,COMMA,COMMA
-2: .int     EXIT
-   /*     ELSE */
-3: .int     FIND_OR_BAILOUT,DROP
-   .int     STATE,FETCH,ZBRANCH,(4f - .)
-   /*       ( OR ) */
-   .int     DUP,ISIMMEDIATE,ZBRANCH,(5f - .)
-4: .int       EXECUTE,EXIT
+1: .int   PARSE_NAME,TWOTOR
+   .int   TWORFETCH,BOOTSTRAP_PARSENUMBER,QDUP,ZBRANCH,(4f - .)
+   .int     TWORDROP,STATE,FETCH,ZEQU,ZBRANCH,(2f - .)
+   .int       DROP,EXIT
+   /*       ELSE-IF */
+2: .int     LIT,2,EQU,ZBRANCH,(3f - .)
+   .int       LIT,TWOLIT,COMMA,COMMA,COMMA,EXIT
    /*       ELSE */
-5: .int       DUP,ISBOOTSTRAP,ZBRANCH,(6f - .)
+3: .int       LIT,LIT,COMMA,COMMA,EXIT
+   /*     ELSE */
+4: .int     TWOFROMR,FIND_OR_BAILOUT,DROP
+   .int     STATE,FETCH,ZBRANCH,(5f - .)
+   /*       ( OR ) */
+   .int     DUP,ISIMMEDIATE,ZBRANCH,(6f - .)
+5: .int       EXECUTE,EXIT
+   /*       ELSE */
+6: .int       DUP,ISBOOTSTRAP,ZBRANCH,(7f - .)
    litstring "Tried to compile bootstrap word: "
    .int       TYPE,TNAME,TYPE,EOL,BAILOUT
-6: .int       COMMA,EXIT
+7: .int       COMMA,EXIT
 
 defword QUIT,,F_HIDDEN
    .int R0,RSPSTORE
diff --git a/startup.4th b/startup.4th
index b4eb7e1..a7d4e81 100644
--- a/startup.4th
+++ b/startup.4th
@@ -1118,10 +1118,18 @@ CREATE DISPLAY-ITEM-LIMIT 6 ,
 >>UTILITY
 
 \ Parse a signed number; to succeed the entire input string must be consumed
-: PARSENUMBER  ( c-addr u -- n TRUE | FALSE )
-   DUP 0= IF NIP EXIT THEN ▪ OVER C@ [[ CHAR - ]] =
-   DUP >R IF 1/STRING DUP 0= IF RDROP NIP EXIT THEN THEN
-   >NUMBER R> 2NIP SWAP 0= DUP >R IF IF NEGATE THEN ELSE 2DROP THEN R> ;
+: PARSENUMBER  ( c-addr u -- 0 | n 1 | d 2 )
+   DUP 0= IF NIP EXIT THEN ▪ OVER C@ [[ CHAR - ]] = >R
+   R@ IF 1/STRING DUP 0= IF RDROP NIP EXIT THEN THEN
+   >NUMBER
+   R> IF 2SWAP DNEGATE 2SWAP THEN
+   DUP 1 = AND-THEN OVER C@ [[ CHAR # ]] = THEN IF
+      2DROP 2
+   ELSE-IF NIP 0= THEN-IF
+      DROP 1
+   ELSE
+      2DROP 0
+   THEN ;
 
 ' PARSENUMBER ' BOOTSTRAP-PARSENUMBER DEFER!
 
@@ -2078,13 +2086,18 @@ NULL 0 STRING-BUFFER 2!
             HERE SWAP DUP ALLOT CMOVE ALIGN
          THEN
       ELSE
-         PARSE-NAME
-         2DUP PARSENUMBER IF
-            STATE @ 2NIP IF
+         PARSE-NAME 2>R
+         2R@ PARSENUMBER ?DUP IF
+            2RDROP
+            STATE @ 0= IF
+               DROP
+            ELSE-IF 2 = THEN-IF
+               POSTPONE 2LITERAL
+            ELSE
                POSTPONE LITERAL
             THEN
          ELSE
-            FIND-OR-THROW
+            2R> FIND-OR-THROW
             \ -1 => immediate word; execute regardless of STATE
             \  1 => read STATE; compile if true, execute if false
             0< ▪ OR-ELSE STATE @ 0= THEN ▪ IF EXECUTE ELSE COMPILE, THEN