diff options
Diffstat (limited to 'forth/core-ext.fth')
| -rw-r--r-- | forth/core-ext.fth | 21 |
1 files changed, 18 insertions, 3 deletions
diff --git a/forth/core-ext.fth b/forth/core-ext.fth index e38d9b1..620dd64 100644 --- a/forth/core-ext.fth +++ b/forth/core-ext.fth @@ -1,6 +1,8 @@ -1 constant true 0 constant false +: unused 1 sys ; + : hex 16 base ! ; : nip swap drop ; @@ -8,6 +10,9 @@ : 0> 0 > ; : 0<> 0= 0= ; +: u> swap u< ; + +: within over - >r - r> swap u> ; : 2r@ ['] r> , ['] r> , ['] 2dup , ['] >r , ['] >r , ['] swap , ; imm @@ -16,7 +21,7 @@ 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 , ['] exit , + ['] 2drop , postpone 2r> ['] drop , ['] >r , ['] leave , postpone then postpone 2>r here ; imm : .( [char] ) word count type ; imm @@ -36,7 +41,7 @@ : is state @ if postpone ['] postpone defer! else ' defer! then ; imm : action-of state @ if postpone ['] postpone defer@ else ' defer@ then ; imm -: erase begin dup 0 > while swap 0 over ! 1+ swap 1- repeat ; +: erase 0 fill ; : roll dup if swap >r 1- recurse r> swap exit then drop ; : marker create _latest @ , here , does> @@ -48,4 +53,14 @@ swap 1+ swap r> tuck ! ; imm : endcase swap 0 do dup @ swap here swap ! loop drop ['] drop , ; imm -: holds begin dup while 1- 2dup + c@ hold repeat 2drop ; +: holds begin dup while 1- 2dup + c@ hold repeat 2drop ; + +: .r over dup 0< if 1 else 0 then + begin 1+ swap base @ / dup 0<> while swap repeat + drop - spaces . ; +: u.r over 0 begin 1+ swap 0 base @ _/ dup 0<> while swap repeat + drop - spaces u. ; + +( WORD uses HERE and must be at least 33 characters. ) +: pad here 50 chars + align ; + |