diff --git a/core.fth b/core.fth index 00f2c87..9c6b7cf 100644 --- a/core.fth +++ b/core.fth @@ -1,34 +1,5 @@ -: state [ _d 7 cells + ] literal ; - -: sp [ _d cell+ ] literal ; -: rp [ _d 2 cells + ] literal ; -: dp [ _d 4 cells + ] literal ; - -: sp@ sp @ ; -: rp@ rp @ cell+ ; -: ip [ _d 3 cells + ] literal ; -: here dp @ ; : unused [ _d 8 cells + ] literal @ here - ; -: base [ _d 9 cells + ] literal ; -: latest _d @ ; - -: pick cells cell+ sp@ + @ ; -: >r rp@ cell - rp ! - rp@ cell+ @ rp@ ! - rp@ cell+ ! ; -: r> rp@ @ - rp@ cell+ rp ! - rp@ @ swap rp@ ! ; -: over 1 pick ; - -: 2dup over over ; -: 2over 3 pick 3 pick ; -: 2swap rot >r rot r> ; -: +! dup >r swap r> @ + swap ! ; -: allot dp +! ; -: , here ! cell allot ; -: c, here c! 1 allot ; : ['] ' [ ' literal , ] ; immediate : if ['] _jmp0 , here 0 , ; immediate @@ -39,11 +10,6 @@ : 2>r ['] swap , ['] >r , ['] >r , ; immediate : r@ ['] r> , ['] dup , ['] >r , ; immediate -: 2! swap over ! cell+ ! ; -: 2@ dup cell+ @ swap @ ; - -: <= 2dup < >r = r> or ; - : _msb [ 1 cell 8 * 1- lshift ] literal ; : 2/ dup 1 rshift swap 0< if _msb or then ; @@ -52,16 +18,10 @@ : min 2dup <= if drop else swap drop then ; : max 2dup <= if swap drop else drop then ; -: aligned cell 1- + cell 1- invert and ; -: align here dup aligned swap - allot ; - : cr 10 emit ; : space bl emit ; \ : spaces begin dup 0 > while space 1- repeat drop ; -: 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 diff --git a/forth.hpp b/forth.hpp index 770eeb9..7357508 100644 --- a/forth.hpp +++ b/forth.hpp @@ -94,104 +94,6 @@ struct cS { } }; -template -struct native_word : public word_base -{ - constexpr static auto N = (sizeof(Name) + sizeof(cell) - 1) & ~(sizeof(cell) - 1); - std::array namebuf; - func body; - - consteval const func *get_ct(std::string_view name) const { - if (name == std::string_view{Name.data}) - return &body; - else if constexpr (Prev != nullptr) - return Prev->get_ct(name); - else - return nullptr; - } - - consteval native_word(addr flags = 0): - word_base{Prev, N | flags}, namebuf{}, body{Body} - { - std::copy(Name.data, Name.data + sizeof(Name), namebuf.data()); - } -}; - -template -struct comp_word : public native_word -{ - static constexpr std::size_t B = - [] { - std::size_t b = 1; - std::string_view sv {Body.data}; - auto sourcei = sv.find_first_not_of(" \t\r\n"); - while (sourcei != std::string_view::npos) { - const auto word = word_list::parse(Body.data, sourcei); - - b++; - if (!Prev->get_ct(word)) - b++; - } - return b; - }(); - - union bodyt { - const func *f; - cell c; - }; - - std::array bodybuf {}; - - consteval comp_word(addr flags = 0): - native_word{flags} - { - auto bptr = bodybuf.begin(); - std::string_view sv {Body}; - auto sourcei = sv.find_first_not_of(" \t\r\n"); - while (sourcei != std::string_view::npos) { - const auto word = word_list::parse(Body, sourcei); - - auto w = Prev->get_ct(word); - if (w) { - bptr->f = Prev->get_ct(word); - bptr++; - } else { - cell n; - std::from_chars(word.cbegin(), word.cend(), n, 10); - - bptr->f = Prev->get_ct("_lit"); - bptr++; - bptr->c = n; - bptr++; - } - } - } -}; - -template -struct native_dict -{ - constexpr static native_word::word; - else - return (const word_base *)nullptr; - }()> word {Flags}; -}; - -template -struct comp_dict -{ - constexpr static comp_word::word; - else - return Prev; - }()> word {Flags}; -}; - struct forth : public word_list { static constexpr bool enable_exceptions = true; @@ -330,144 +232,7 @@ struct forth : public word_list } template - static void initialize(cell *end_value) - { - assert(*fthp); - - static auto& fth = **fthp; - - constexpr static func lit_impl = [](auto) { - auto ptr = std::bit_cast(++fth.ip); - fth.push(*ptr); - }; - auto f_dict = [](auto) { fth.push(std::bit_cast(&fth)); }; - auto f_add = [](auto) { fth.top() += fth.pop(); }; - auto f_minus = [](auto) { fth.top() -= fth.pop(); }; - auto f_times = [](auto) { fth.top() *= fth.pop(); }; - auto f_divide = [](auto) { fth.top() /= fth.pop(); }; - auto f_mod = [](auto) { fth.top() %= fth.pop(); }; - auto f_bitand = [](auto) { fth.top() &= fth.pop(); }; - auto f_bitor = [](auto) { fth.top() |= fth.pop(); }; - auto f_bitxor = [](auto) { fth.top() ^= fth.pop(); }; - auto f_lshift = [](auto) { fth.top() <<= fth.pop(); }; - auto f_rshift = [](auto) { fth.top() >>= fth.pop(); }; - auto f_lbrac = [](auto) { fth.compiling = false; }; - auto f_rbrac = [](auto) { fth.compiling = true; }; - auto f_imm = [](auto) { - const_cast(fth.next)->make_immediate(); }; - auto f_lit = [](auto) { - //assert(fth.compiling); - *fth.here++ = std::bit_cast(&lit_impl); - *fth.here++ = fth.pop(); }; - auto f_peek = [](auto) { fth.push(*std::bit_cast(fth.pop())); }; - auto f_poke = [](auto) { - auto [p, v] = fth.pop<2>(); - *std::bit_cast(p) = v; }; - auto f_cpeek = [](auto) { fth.push(*std::bit_cast(fth.pop())); }; - auto f_cpoke = [](auto) { - auto [p, v] = fth.pop<2>(); - *std::bit_cast(p) = v; }; - auto f_swap = [](auto) { auto [a, b] = fth.pop<2>(); fth.push(a, b); }; - auto f_drop = [](auto) { fth.pop(); }; - auto f_dup = [](auto) { fth.push(fth.top()); }; - auto f_rot = [](auto) { auto [a, b, c] = fth.pop<3>(); fth.push(b, a, c); }; - auto f_eq = [](auto) { auto v = fth.pop(); fth.top() = -(fth.top() == v); }; - auto f_lt = [](auto) { auto v = fth.pop(); fth.top() = -(fth.top() < v); }; - auto f_tick = [](auto) { - auto w = fth.parse(); - - if (auto g = fth.get(w); g) - fth.push(std::bit_cast((*g)->body())); - else - fth.push(0); }; - auto f_colon = [](auto) { - const auto prologue = forth::prologue; - auto w = fth.parse(); - fth.add(w); - *fth.here++ = std::bit_cast(prologue); - fth.compiling = true; }; - auto f_semic = [](auto) { *fth.here++ = 0; fth.compiling = false; }; - auto f_comm = [](auto) { fth.sourcei = npos; }; - auto f_cell = [](auto) { fth.push(sizeof(cell)); }; - auto f_jmp = [](auto) { - auto ptr = ++fth.ip; - fth.ip = *std::bit_cast(ptr) - 1; - }; - auto f_jmp0 = [](auto) { - auto ptr = ++fth.ip; - - if (fth.pop() == 0) - fth.ip = *std::bit_cast(ptr) - 1; - }; - auto f_postpone = [](auto) { - assert(fth.compiling); - - auto w = fth.parse(); - auto g = fth.get(w); - - assert(g.has_value()); - - *fth.here++ = std::bit_cast((*g)->body()); - }; - - constexpr static auto& dict1 = native_dict< - cS{"_d"}, f_dict, 0, - cS{"_lit"}, lit_impl, 0, - cS{"swap"}, f_swap, 0, - cS{"drop"}, f_drop, 0, - cS{"dup"}, f_dup, 0, - cS{"rot"}, f_rot, 0, - cS{"+"}, f_add, 0, - cS{"-"}, f_minus, 0, - cS{"*"}, f_times, 0, - cS{"/"}, f_divide, 0, - cS{"mod"}, f_mod, 0, - cS{"and"}, f_bitand, 0, - cS{"or"}, f_bitor, 0, - cS{"xor"}, f_bitxor, 0, - cS{"lshift"}, f_lshift, 0, - cS{"rshift"}, f_rshift, 0, - cS{"["}, f_lbrac, word_base::immediate, - cS{"]"}, f_rbrac, 0, - cS{"immediate"}, f_imm, 0, - cS{"literal"}, f_lit, word_base::immediate, - cS{"@"}, f_peek, 0, - cS{"!"}, f_poke, 0, - cS{"c@"}, f_cpeek, 0, - cS{"c!"}, f_cpoke, 0, - cS{"="}, f_eq, 0, - cS{"<"}, f_lt, 0, - cS{"\'"}, f_tick, 0, - cS{":"}, f_colon, 0, - cS{";"}, f_semic, word_base::immediate, - cS{"\\"}, f_comm, word_base::immediate, - cS{"cell"}, f_cell, 0, - cS{"_jmp"}, f_jmp, 0, - cS{"_jmp0"}, f_jmp0, 0, - cS{"chars"}, [](auto) {}, 0, - cS{"postpone"}, f_postpone, word_base::immediate - >::word; - constexpr static auto& dict2 = comp_dict, &dict1 - , cS{"1-" }, cS{"1 -" }, 0 - , cS{"1+" }, cS{"1 +" }, 0 - , cS{"cell+" }, cS{"cell +"}, 0 - , cS{"cells" }, cS{"cell *"}, 0 - , cS{"char+" }, cS{"1 +" }, 0 - , cS{"-rot" }, cS{"rot rot"}, 0 - , cS{"2drop" }, cS{"drop drop"}, 0 - , cS{"0=" }, cS{"0 ="}, 0 - , cS{"0<" }, cS{"0 <"}, 0 - , cS{"<>" }, cS{"= 0="}, 0 - , cS{">" }, cS{"swap <"}, 0 - , cS{"invert"}, cS{"-1 xor"}, 0 - , cS{"negate"}, cS{"-1 *"}, 0 - , cS{"2*" }, cS{"2 *"}, 0 - , cS{"bl" }, cS{"32"}, 0 - >::word; - - fth.next = &dict2; - fth.end = end_value; - } + static void initialize(cell *end_value); static auto error_string(error err) noexcept -> std::string_view { using enum error; @@ -504,6 +269,104 @@ struct forth : public word_list std::array rstack; }; +template +struct native_word : public word_base +{ + constexpr static auto N = (sizeof(Name) + sizeof(cell) - 1) & ~(sizeof(cell) - 1); + std::array namebuf; + func body; + + consteval const func *get_ct(std::string_view name) const { + if (name == std::string_view{Name.data}) + return &body; + else if constexpr (Prev != nullptr) + return Prev->get_ct(name); + else + return nullptr; + } + + consteval native_word(addr flags = 0): + word_base{Prev, N | flags}, namebuf{}, body{Body} + { + std::copy(Name.data, Name.data + sizeof(Name), namebuf.data()); + } +}; + +template +struct comp_word : public native_word +{ + static constexpr std::size_t B = + [] { + std::size_t b = 1; + std::string_view sv {Body.data}; + auto sourcei = sv.find_first_not_of(" \t\r\n"); + while (sourcei != std::string_view::npos) { + const auto word = word_list::parse(Body.data, sourcei); + + b++; + if (!Prev->get_ct(word)) + b++; + } + return b; + }(); + + union bodyt { + const func *f; + cell c; + }; + + std::array bodybuf {}; + + consteval comp_word(addr flags = 0): + native_word{flags} + { + auto bptr = bodybuf.begin(); + std::string_view sv {Body}; + auto sourcei = sv.find_first_not_of(" \t\r\n"); + while (sourcei != std::string_view::npos) { + const auto word = word_list::parse(Body, sourcei); + + auto w = Prev->get_ct(word); + if (w) { + bptr->f = Prev->get_ct(word); + bptr++; + } else { + cell n; + std::from_chars(word.cbegin(), word.cend(), n, 10); + + bptr->f = Prev->get_ct("_lit"); + bptr++; + bptr->c = n; + bptr++; + } + } + } +}; + +template +struct native_dict +{ + constexpr static native_word::word; + else + return (const word_base *)nullptr; + }()> word {Flags}; +}; + +template +struct comp_dict +{ + constexpr static comp_word::word; + else + return Prev; + }()> word {Flags}; +}; + std::optional word_list::get(std::string_view sv) const { for (auto lt = next; lt; lt = lt->next) { @@ -514,6 +377,127 @@ std::optional word_list::get(std::string_view sv) const return {}; } +template +void forth::initialize(cell *end_value) +{ + assert(*fthp); + + static auto& fth = **fthp; + static auto _d = std::bit_cast(*fthp); + + constexpr static func lit_impl = [](auto) { + auto ptr = std::bit_cast(++fth.ip); + fth.push(*ptr); + }; + + constexpr static auto& dict1 = native_dict< + cS{"_d" }, [](auto) { fth.push(_d); }, 0 + , cS{"sp" }, [](auto) { fth.push(_d + sizeof(cell)); }, 0 + , cS{"rp" }, [](auto) { fth.push(_d + 2 * sizeof(cell)); }, 0 + , cS{"ip" }, [](auto) { fth.push(_d + 3 * sizeof(cell)); }, 0 + , cS{"dp" }, [](auto) { fth.push(_d + 4 * sizeof(cell)); }, 0 + , cS{"state"}, [](auto) { fth.push(_d + 7 * sizeof(cell)); }, 0 + , cS{"base" }, [](auto) { fth.push(_d + 9 * sizeof(cell)); }, 0 + , cS{"_lit" }, lit_impl, 0 + , cS{"swap" }, [](auto) { auto [a, b] = fth.pop<2>(); fth.push(a, b); }, 0 + , cS{"drop" }, [](auto) { fth.pop(); }, 0 + , cS{"dup" }, [](auto) { fth.push(fth.top()); }, 0 + , cS{"rot" }, [](auto) { auto [a, b, c] = fth.pop<3>(); fth.push(b, a, c); }, 0 + , cS{"+" }, [](auto) { fth.top() += fth.pop(); }, 0 + , cS{"-" }, [](auto) { fth.top() -= fth.pop(); }, 0 + , cS{"*" }, [](auto) { fth.top() *= fth.pop(); }, 0 + , cS{"/" }, [](auto) { fth.top() /= fth.pop(); }, 0 + , cS{"mod" }, [](auto) { fth.top() %= fth.pop(); }, 0 + , cS{"and" }, [](auto) { fth.top() &= fth.pop(); }, 0 + , cS{"or" }, [](auto) { fth.top() |= fth.pop(); }, 0 + , cS{"xor" }, [](auto) { fth.top() ^= fth.pop(); }, 0 + , cS{"lshift"}, [](auto) { fth.top() <<= fth.pop(); }, 0 + , cS{"rshift"}, [](auto) { fth.top() >>= fth.pop(); }, 0 + , cS{"[" }, [](auto) { fth.compiling = false; }, word_base::immediate + , cS{"]" }, [](auto) { fth.compiling = true; }, 0 + , cS{"immediate"}, [](auto) { const_cast(fth.next)->make_immediate(); }, 0 + , cS{"literal"}, [](auto) { + //assert(fth.compiling); + *fth.here++ = std::bit_cast(&lit_impl); + *fth.here++ = fth.pop(); }, word_base::immediate + , cS{"@" }, [](auto) { fth.push(*std::bit_cast(fth.pop())); }, 0 + , cS{"!" }, [](auto) { auto [p, v] = fth.pop<2>(); *std::bit_cast(p) = v; }, 0 + , cS{"c@" }, [](auto) { fth.push(*std::bit_cast(fth.pop())); }, 0 + , cS{"c!" }, [](auto) { auto [p, v] = fth.pop<2>(); *std::bit_cast(p) = v; }, 0 + , cS{"=" }, [](auto) { auto v = fth.pop(); fth.top() = -(fth.top() == v); }, 0 + , cS{"<" }, [](auto) { auto v = fth.pop(); fth.top() = -(fth.top() < v); }, 0 + , cS{"\'" }, [](auto) { + auto w = fth.parse(); + auto g = fth.get(w); + fth.push(g ? std::bit_cast((*g)->body()) : 0); }, 0 + , cS{":" }, [](auto) { + const auto prologue = forth::prologue; + auto w = fth.parse(); + fth.add(w); + *fth.here++ = std::bit_cast(prologue); + fth.compiling = true; }, 0 + , cS{";" }, [](auto) { *fth.here++ = 0; fth.compiling = false; }, word_base::immediate + , cS{"\\" }, [](auto) { fth.sourcei = npos; }, word_base::immediate + , cS{"cell" }, [](auto) { fth.push(sizeof(cell)); }, 0 + , cS{"_jmp" }, [](auto) { + auto ptr = ++fth.ip; + fth.ip = *std::bit_cast(ptr) - 1; }, 0 + , cS{"_jmp0"}, [](auto) { + auto ptr = ++fth.ip; + if (fth.pop() == 0) + fth.ip = *std::bit_cast(ptr) - 1; }, 0 + , cS{"chars"}, [](auto) {}, 0 + , cS{"postpone"}, [](auto) { + assert(fth.compiling); + auto w = fth.parse(); + auto g = fth.get(w); + assert(g.has_value()); + *fth.here++ = std::bit_cast((*g)->body()); }, word_base::immediate + >::word; + constexpr static auto& dict2 = comp_dict, &dict1 + , cS{"align" }, cS{"here dup aligned swap - allot"}, 0 + , cS{"aligned"}, cS{"cell 1- + cell 1- invert and"}, 0 + , cS{"decimal"}, cS{"10 base !"}, 0 + , cS{"hex" }, cS{"16 base !"}, 0 + , cS{"<=" }, cS{"2dup < >r = r> or"}, 0 + , cS{"2!" }, cS{"swap over ! cell+ !"}, 0 + , cS{"2@" }, cS{"dup cell+ @ swap @"}, 0 + , cS{"c," }, cS{"here c! 1 allot"}, 0 + , cS{"," }, cS{"here ! cell allot"}, 0 + , cS{"allot" }, cS{"dp +!"}, 0 + , cS{"+!" }, cS{"dup >r swap r> @ + swap !"}, 0 + , cS{"2swap" }, cS{"rot >r rot r>"}, 0 + , cS{"2dup" }, cS{"over over"}, 0 + , cS{"2over" }, cS{"3 pick 3 pick"}, 0 + , cS{">r" }, cS{"rp@ cell - rp ! rp@ cell+ @ rp@ ! rp@ cell+ !"}, 0 + , cS{"r>" }, cS{"rp@ @ rp@ cell+ rp ! rp@ @ swap rp@ !"}, 0 + , cS{"over" }, cS{"1 pick"}, 0 + , cS{"pick" }, cS{"cells cell+ sp@ + @"}, 0 + , cS{"sp@" }, cS{"sp @"}, 0 + , cS{"rp@" }, cS{"rp @ cell+"}, 0 + , cS{"here" }, cS{"dp @"}, 0 + , cS{"latest"}, cS{"_d @"}, 0 + , cS{"1-" }, cS{"1 -" }, 0 + , cS{"1+" }, cS{"1 +" }, 0 + , cS{"cell+" }, cS{"cell +"}, 0 + , cS{"cells" }, cS{"cell *"}, 0 + , cS{"char+" }, cS{"1 +" }, 0 + , cS{"-rot" }, cS{"rot rot"}, 0 + , cS{"2drop" }, cS{"drop drop"}, 0 + , cS{"0=" }, cS{"0 ="}, 0 + , cS{"0<" }, cS{"0 <"}, 0 + , cS{"<>" }, cS{"= 0="}, 0 + , cS{">" }, cS{"swap <"}, 0 + , cS{"invert"}, cS{"-1 xor"}, 0 + , cS{"negate"}, cS{"-1 *"}, 0 + , cS{"2*" }, cS{"2 *"}, 0 + , cS{"bl" }, cS{"32"}, 0 + >::word; + + fth.next = &dict2; + fth.end = end_value; +} + //static_assert(offsetof(word_base, flags_len) == 1 * sizeof(cell)); //static_assert(offsetof(forth, sp) == 1 * sizeof(cell)); //static_assert(offsetof(forth, rp) == 2 * sizeof(cell));