add PARSE; fixes to actually comply with all tests

optimize
Clyne 11 months ago
parent 91566e20e8
commit 97a590fc8e
Signed by: clyne
GPG Key ID: 3267C8EBF3F9AFC7

@ -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

@ -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 - ;

@ -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 ;

Loading…
Cancel
Save