aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorClyne Sullivan <clyne@bitgloo.com>2023-10-28 12:20:12 -0400
committerClyne Sullivan <clyne@bitgloo.com>2023-10-28 12:20:12 -0400
commit97a590fc8e2089cf757afb3a90ad61d65f9c3789 (patch)
tree03709a29da265f3b97f4716127f8ac9b2fae3e84
parent91566e20e85cd2b504da7579dfca6df592ea7b30 (diff)
add PARSE; fixes to actually comply with all tests
-rw-r--r--README.md2
-rw-r--r--forth/core-ext.fth12
-rw-r--r--forth/core.fth12
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 ;