From 97a590fc8e2089cf757afb3a90ad61d65f9c3789 Mon Sep 17 00:00:00 2001
From: Clyne Sullivan <clyne@bitgloo.com>
Date: Sat, 28 Oct 2023 12:20:12 -0400
Subject: [PATCH] add PARSE; fixes to actually comply with all tests

---
 README.md          |  2 +-
 forth/core-ext.fth | 12 ++++++++++--
 forth/core.fth     | 12 +++++++-----
 3 files changed, 18 insertions(+), 8 deletions(-)

diff --git a/README.md b/README.md
index aaae13b..ffa1054 100644
--- a/README.md
+++ b/README.md
@@ -15,7 +15,7 @@ Alee Forth uses the [Forth 2012 test suite](https://github.com/gerryjackson/fort
 **Missing** core extension words:
 
 ```
-PARSE PARSE-NAME REFILL RESTORE-INPUT S\" SAVE-INPUT SOURCE-ID
+PARSE-NAME REFILL RESTORE-INPUT S\" SAVE-INPUT SOURCE-ID
 ```
 
 ## Building
diff --git a/forth/core-ext.fth b/forth/core-ext.fth
index 83dd666..0c263d9 100644
--- a/forth/core-ext.fth
+++ b/forth/core-ext.fth
@@ -28,7 +28,10 @@
 
 : .(        [char] ) word count type ; imm
 : c"        state @ if ['] _jmp , here 0 , then
-            [char] " word
+            [char] " here char+ begin
+            key dup 3 pick <> while
+            over c! char+ repeat drop
+            swap drop here - here c! here
             state @ 0= if exit then
             dup count nip 1+ allot
             here rot !
@@ -38,7 +41,7 @@
 : value     constant ;
 : to        ' 4 cells + state @ if postpone literal ['] ! , else ! then ; imm
 
-: defer     create does> @ execute ;
+: defer     create ['] exit , does> @ execute ;
 : defer@    >body @ ;
 : defer!    >body ! ;
 : is        state @ if postpone ['] postpone defer! else ' defer! then ; imm
@@ -66,3 +69,8 @@
 ( WORD uses HERE and must be at least 33 characters. )
 : pad      here 50 chars + align ;
 
+: parse     here dup >r swap begin
+            key? if key else dup then 2dup <> while
+            rot dup >r c! r> char+ swap repeat
+            2drop r> tuck - ;
+
diff --git a/forth/core.fth b/forth/core.fth
index c5cd8f4..8ec5b71 100644
--- a/forth/core.fth
+++ b/forth/core.fth
@@ -138,10 +138,12 @@
            begin dup c@ 0 = while _in repeat
            c@ 1 >in +! ;
 : key?     _source @ >in @ + c@ 0 <> ;
-: word     here dup >r char+ >r
-           begin key? if key 2dup <> else 0 0 then while
-           r> swap over c! char+ >r repeat
-           2drop r> r> swap over - 1- over c! ;
+: word     begin key? if key else -1 then 2dup <> until
+           key? 0= if 2drop 0 here c! here exit then
+           here begin char+ swap over c! swap
+           key? if key else dup then
+           2dup <> while rot repeat
+           2drop here - here c! here ;
 : count    dup char+ swap c@ ;
 : char     bl word char+ c@ ;
 : [char]   char postpone literal ; imm
@@ -166,7 +168,7 @@
            ['] _jmp over ! cell+ r> cell+ swap ! ;
 
 : does>    state @ if
-           here 3 cells + postpone literal ['] _does> , ['] exit , else
+           ['] _lit , here 2 cells + , ['] _does> , ['] exit , else
            here dup _does> dup _compxt ! 0 , ] then ; imm
 
 : variable create 1 cells allot ;