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 + diff --git a/forth.hpp b/forth.hpp index af6ecc9..560cafd 100644 --- 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(++fth.ip); + fth.push(*ptr); + }; auto f_dict = [](auto) { fth.push(reinterpret_cast(&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(fth.latest)->make_immediate(); }; auto f_lit = [](auto) { - static auto lit_impl = +[] { - auto ptr = reinterpret_cast(++fth.ip); - fth.push(*ptr); - }; - - assert(fth.compiling); + //assert(fth.compiling); *fth.here++ = reinterpret_cast(&lit_impl); *fth.here++ = fth.pop(); }; auto f_peek = [](auto) { fth.push(*reinterpret_cast(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};