add PARSE; fixes to actually comply with all tests

diff --git a/README.md b/README.md
index aaae13ba3e7dcb20556753ace672e96c7fd6701c..ffa1054ba265bd95a88f0443f06a86442d48d4b5 100644 (file)
--- 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 83dd666b77b0a56ca797754ab502e1dea6feed3f..0c263d940179f4c39af06a6ec1ca3539073cdd99 100644 (file)
--- 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 c5cd8f49ad40de36048717021d7a3ae28b830a78..8ec5b71972ed80d458c0a3e9d84b15abcdb8106f 100644 (file)
--- 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 ;