add looping words

1 files changed, 21 insertions, 0 deletions

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
+