Skip to content

Commit

Permalink
add PARSE; fixes to actually comply with all tests
Browse files Browse the repository at this point in the history
  • Loading branch information
tcsullivan committed Oct 28, 2023
1 parent 91566e2 commit 97a590f
Show file tree
Hide file tree
Showing 3 changed files with 18 additions and 8 deletions.
2 changes: 1 addition & 1 deletion README.md
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
12 changes: 10 additions & 2 deletions forth/core-ext.fth
Original file line number Diff line number Diff line change
Expand Up @@ -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 !
Expand All @@ -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
Expand Down Expand Up @@ -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 - ;

12 changes: 7 additions & 5 deletions forth/core.fth
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -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 ;
Expand Down

0 comments on commit 97a590f

Please sign in to comment.