From c943ec606bfec0d5571609ff17dffd9b46ecb877 Mon Sep 17 00:00:00 2001 From: Clyne Sullivan Date: Thu, 28 Nov 2024 07:01:43 -0500 Subject: add looping words --- core.fth | 21 +++++++++++++++++++++ 1 file changed, 21 insertions(+) (limited to 'core.fth') diff --git a/core.fth b/core.fth index b325e58..b90287a 100644 --- a/core.fth +++ b/core.fth @@ -85,3 +85,24 @@ : 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 + -- cgit v1.2.3