add looping words

diff --git a/core.fth b/core.fth
index b325e5809ec8480515faab52ff973c6d38404ebf..b90287ac1ffd56bc4b97b4798fe64c8eb7c73cf9 100644 (file)
--- 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
+

diff --git a/forth.hpp b/forth.hpp
index af6ecc9aa146b2969549454ade8d1b25283401b4..560cafdc66f38d59c28ec754327db681096ce42e 100644 (file)
--- a/forth.hpp
+++ b/forth.hpp
@@ -237,6 +237,10 @@ struct forth
 
         static auto& fth = **fthp;
 
+        constexpr static func lit_impl = [](auto) {
+            auto ptr = reinterpret_cast<cell *>(++fth.ip);
+            fth.push(*ptr);
+        };
         auto f_dict   = [](auto) { fth.push(reinterpret_cast<cell>(&fth)); };
         auto f_add    = [](auto) { fth.top() += fth.pop(); };
         auto f_minus  = [](auto) { fth.top() -= fth.pop(); };
@@ -253,12 +257,7 @@ struct forth
         auto f_imm    = [](auto) {
             const_cast<word_base *>(fth.latest)->make_immediate(); };
         auto f_lit    = [](auto) {
-            static auto lit_impl = +[] {
-                auto ptr = reinterpret_cast<cell *>(++fth.ip);
-                fth.push(*ptr);
-            };
-
-            assert<error::compile_only_word>(fth.compiling);
+            //assert<error::compile_only_word>(fth.compiling);
             *fth.here++ = reinterpret_cast<cell>(&lit_impl);
             *fth.here++ = fth.pop(); };
         auto f_peek = [](auto) { fth.push(*reinterpret_cast<cell *>(fth.pop())); };
@@ -312,7 +311,8 @@ struct forth
         };
 
         constexpr static word w_dict {"_d", f_dict};
-        constexpr static word w_add {"+", f_add, &w_dict};
+        constexpr static word w_liti {"_lit", lit_impl, &w_dict};
+        constexpr static word w_add {"+", f_add, &w_liti};
         constexpr static word w_minus {"-", f_minus, &w_add};
         constexpr static word w_times {"*", f_times, &w_minus};
         constexpr static word w_divide {"/", f_divide, &w_times};