diff --git a/core.fth b/core.fth index b90287a..96dc0f2 100644 --- a/core.fth +++ b/core.fth @@ -85,24 +85,34 @@ : decimal 10 base ! ; : hex 16 base ! ; -: begin 0 here ; immediate -: while swap 1+ swap postpone if -rot ; immediate -: repeat ['] _jmp , , if postpone then then ; immediate -: until ['] _jmp0 , , drop ; immediate - -: do ['] _lit , here 0 , ['] >r , postpone 2>r here ; immediate -: unloop postpone 2r> ['] 2drop , ['] r> , ['] drop , ; immediate -: leave postpone 2r> ['] 2drop , ['] exit , ; immediate -: +loop ['] r> , ['] 2dup , ['] + , - postpone r@ ['] swap , ['] >r , - ['] - , ['] 2dup , ['] + , ['] over , ['] xor , - ['] rot , ['] rot , ['] xor , ['] and , ['] _lit , 0 , - ['] < , ['] _jmp0 , , - postpone unloop here 1 cells - swap ! ; immediate -: loop postpone 2r> ['] 1+ , ['] 2dup , - postpone 2>r ['] = , ['] _jmp0 , , - postpone unloop here 1 cells - swap ! ; immediate -: i postpone r@ ; immediate -: j postpone 2r> ['] r> , postpone r@ ['] swap , - ['] >r , ['] -rot , postpone 2>r ; immediate - +: begin 0 here ; immediate +: while swap 1+ swap postpone if -rot ; immediate +: repeat ['] _jmp , , if postpone then then ; immediate +: until ['] _jmp0 , , drop ; immediate + +: do ['] _lit , here 0 , ['] >r , postpone 2>r here ; immediate +: unloop postpone 2r> ['] 2drop , ['] r> , ['] drop , ; immediate +: leave postpone 2r> ['] 2drop , ['] exit , ; immediate +: +loop ['] r> , ['] 2dup , ['] + , + postpone r@ ['] swap , ['] >r , + ['] - , ['] 2dup , ['] + , ['] over , ['] xor , + ['] rot , ['] rot , ['] xor , ['] and , ['] _lit , 0 , + ['] < , ['] _jmp0 , , + postpone unloop here 1 cells - swap ! ; immediate +: loop postpone 2r> ['] 1+ , ['] 2dup , + postpone 2>r ['] = , ['] _jmp0 , , + postpone unloop here 1 cells - swap ! ; immediate +: i postpone r@ ; immediate +: j postpone 2r> ['] r> , postpone r@ ['] swap , + ['] >r , ['] -rot , postpone 2>r ; immediate + +: create : here [ 4 cells ] literal + postpone literal postpone ; 0 , ; +: >body [ 2 cells ] literal + @ ; + +: _does> latest dup cell+ @ [ 5 cells ] literal + + + ['] _jmp over ! cell+ ! ; + +: does> here 4 cells + postpone literal ['] _does> , 0 , ; immediate + +: variable create cell allot ; +: constant create , does> @ ;