diff options
Diffstat (limited to 'forth/core-ext.fth')
| -rw-r--r-- | forth/core-ext.fth | 19 |
1 files changed, 10 insertions, 9 deletions
diff --git a/forth/core-ext.fth b/forth/core-ext.fth index 9dab169..83dd666 100644 --- a/forth/core-ext.fth +++ b/forth/core-ext.fth @@ -21,21 +21,23 @@ : \ _source @ >in @ + begin dup c@ while 0 over c! char+ repeat drop ; imm : again postpone repeat ; imm -: ?do ['] 2dup , ['] _lit , here 0 , ['] >r , ['] = , postpone if - ['] 2drop , postpone 2r> ['] drop , ['] >r , ['] leave , - postpone then postpone 2>r here ; imm + +: ?do ['] _lit , here 0 , ['] >r , ['] 2dup , postpone 2>r + ['] = , postpone if postpone leave postpone then + here ; imm : .( [char] ) word count type ; imm : c" state @ if ['] _jmp , here 0 , then [char] " word state @ 0= if exit then - dup count nip allot + dup count nip 1+ allot here rot ! postpone literal ; imm : buffer: create allot ; : value constant ; : to ' 4 cells + state @ if postpone literal ['] ! , else ! then ; imm + : defer create does> @ execute ; : defer@ >body @ ; : defer! >body ! ; @@ -48,11 +50,10 @@ : marker here _latest @ create , , does> dup @ _latest ! cell+ @ here - allot ; -: case ['] _lit , 1 here 0 , ['] drop , ; imm -: of ['] over , ['] = , postpone if ; imm -: endof ['] _jmp , here >r 0 , postpone then - swap 1+ swap r> tuck ! ; imm -: endcase swap 0 do dup @ swap here swap ! loop drop ['] drop , ; imm +: case 0 ; imm +: of ['] over , ['] = , postpone if ['] drop , ; imm +: endof postpone else ; imm +: endcase ['] drop , begin ?dup while postpone then repeat ; imm : holds begin dup while 1- 2dup + c@ hold repeat 2drop ; |