add [COMPILE], fix :NONAME

optimize
Clyne 1 year ago
parent 79a15b78b1
commit ddba135e7d
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: **Missing** core extension words:
``` ```
PARSE PARSE-NAME REFILL RESTORE-INPUT S\" SAVE-INPUT SOURCE-ID [COMPILE] PARSE PARSE-NAME REFILL RESTORE-INPUT S\" SAVE-INPUT SOURCE-ID
``` ```
## Building ## Building

@ -16,29 +16,30 @@
: 2r@ ['] r> , ['] r> , ['] 2dup , ['] >r , ['] >r , ['] swap , ; imm : 2r@ ['] r> , ['] r> , ['] 2dup , ['] >r , ['] >r , ['] swap , ; imm
: compile, postpone literal postpone execute ; : compile, postpone literal postpone execute ;
: \ _source @ >in @ + : [compile] bl word find -1 = if , else compile, then ; imm
begin dup c@ while 0 over c! char+ repeat drop ; imm : \ _source @ >in @ +
: again postpone repeat ; imm begin dup c@ while 0 over c! char+ repeat drop ; imm
: ?do ['] 2dup , ['] _lit , here 0 , ['] >r , ['] = , postpone if : again postpone repeat ; imm
['] 2drop , postpone 2r> ['] drop , ['] >r , ['] leave , : ?do ['] 2dup , ['] _lit , here 0 , ['] >r , ['] = , postpone if
postpone then postpone 2>r here ; imm ['] 2drop , postpone 2r> ['] drop , ['] >r , ['] leave ,
postpone then postpone 2>r here ; imm
: .( [char] ) word count type ; imm
: c" state @ if ['] _jmp , here 0 , then : .( [char] ) word count type ; imm
[char] " word : c" state @ if ['] _jmp , here 0 , then
state @ 0= if exit then [char] " word
dup count nip allot state @ 0= if exit then
here rot ! dup count nip allot
postpone literal ; imm here rot !
postpone literal ; imm
: buffer: create allot ;
: value constant ; : buffer: create allot ;
: to ' 4 cells + state @ if postpone literal ['] ! , else ! then ; imm : value constant ;
: defer create does> @ execute ; : to ' 4 cells + state @ if postpone literal ['] ! , else ! then ; imm
: defer@ >body @ ; : defer create does> @ execute ;
: defer! >body ! ; : defer@ >body @ ;
: is state @ if postpone ['] postpone defer! else ' defer! then ; imm : defer! >body ! ;
: is state @ if postpone ['] postpone defer! else ' defer! then ; imm
: action-of state @ if postpone ['] postpone defer@ else ' defer@ then ; imm : action-of state @ if postpone ['] postpone defer@ else ' defer@ then ; imm
: erase 0 fill ; : erase 0 fill ;

@ -198,7 +198,7 @@
else dup emit rot 2dup c! char+ swap drop swap 1- then else dup emit rot 2dup c! char+ swap drop swap 1- then
repeat drop r> - 1 chars / ; repeat drop r> - 1 chars / ;
: :noname 0 , here ] ; : :noname here 0 , here swap ] ;
: evaluate _source @ >r _sourceu @ >r >in @ >r : evaluate _source @ >r _sourceu @ >r >in @ >r
0 >in ! _sourceu ! _source ! _ev 0 >in ! _sourceu ! _source ! _ev

Loading…
Cancel
Save