From f88a775617bdc52e24c58e92a736e222bc2cc030 Mon Sep 17 00:00:00 2001 From: Clyne Sullivan Date: Sat, 30 Nov 2024 07:05:45 -0500 Subject: [PATCH] comp_dict --- core.fth | 20 ------ forth.hpp | 194 ++++++++++++++++++++++++++---------------------------- 2 files changed, 94 insertions(+), 120 deletions(-) diff --git a/core.fth b/core.fth index c3746c3..00f2c87 100644 --- a/core.fth +++ b/core.fth @@ -1,8 +1,4 @@ -: chars ; - : state [ _d 7 cells + ] literal ; -\ : [ 0 state ! ; immediate -\ : ] -1 state ! ; : sp [ _d cell+ ] literal ; : rp [ _d 2 cells + ] literal ; @@ -16,8 +12,6 @@ : base [ _d 9 cells + ] literal ; : latest _d @ ; -\ : dup sp@ @ ; -\ : drop sp@ cell+ sp ! ; : pick cells cell+ sp@ + @ ; : >r rp@ cell - rp ! rp@ cell+ @ rp@ ! @@ -25,11 +19,8 @@ : r> rp@ @ rp@ cell+ rp ! rp@ @ swap rp@ ! ; -\ : rot >r swap r> swap ; -: -rot rot rot ; : over 1 pick ; -: 2drop drop drop ; : 2dup over over ; : 2over 3 pick 3 pick ; : 2swap rot >r rot r> ; @@ -51,18 +42,8 @@ : 2! swap over ! cell+ ! ; : 2@ dup cell+ @ swap @ ; -: 0= 0 = ; -: 0< 0 < ; : <= 2dup < >r = r> or ; -: > swap < ; -: <> = 0= ; - -: 1+ 1 + ; -: 1- 1 - ; -: invert -1 xor ; -: negate -1 * ; -: 2* 2 * ; : _msb [ 1 cell 8 * 1- lshift ] literal ; : 2/ dup 1 rshift swap 0< if _msb or then ; @@ -75,7 +56,6 @@ : align here dup aligned swap - allot ; : cr 10 emit ; -: bl 32 ; : space bl emit ; \ : spaces begin dup 0 > while space 1- repeat drop ; diff --git a/forth.hpp b/forth.hpp index 8f71946..770eeb9 100644 --- a/forth.hpp +++ b/forth.hpp @@ -80,10 +80,10 @@ struct word_base : public word_list }; template -struct ctstring { +struct cS { char data[N]; - consteval ctstring(const char (&s)[N]) { + consteval cS(const char (&s)[N]) { std::copy(s, s + N, data); } consteval operator const char *() const { @@ -94,17 +94,39 @@ struct ctstring { } }; -template -struct comp_word : public word_base +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 = parse(Body.data, sourcei); + const auto word = word_list::parse(Body.data, sourcei); b++; if (!Prev->get_ct(word)) @@ -118,39 +140,26 @@ struct comp_word : public word_base cell c; }; - std::array namebuf; - const func prologue; - std::array bodybuf; - - consteval const func *get_ct(std::string_view name) const { - if (name == std::string_view{Name.data}) - return &prologue; - else if (Prev) - return Prev->get_ct(name); - else - return nullptr; - } + std::array bodybuf {}; - consteval comp_word(const func prol, addr flags = 0): - word_base{Prev, N | flags}, namebuf{}, prologue{prol}, bodybuf{} + consteval comp_word(addr flags = 0): + native_word{flags} { - std::copy(Name.data, Name.data + sizeof(Name), namebuf.data()); - 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 = parse(Body, sourcei); + const auto word = word_list::parse(Body, sourcei); - auto w = get_ct(word); + auto w = Prev->get_ct(word); if (w) { - bptr->f = get_ct(word); + bptr->f = Prev->get_ct(word); bptr++; } else { cell n; std::from_chars(word.cbegin(), word.cend(), n, 10); - bptr->f = get_ct("_lit"); + bptr->f = Prev->get_ct("_lit"); bptr++; bptr->c = n; bptr++; @@ -159,30 +168,7 @@ struct comp_word : public word_base } }; -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 +template struct native_dict { constexpr static native_word word {Flags}; }; -template +template struct comp_dict { - constexpr static comp_word::word; + return &comp_dict::word; else - return (const word_base *)nullptr; + return Prev; }()> word {Flags}; }; @@ -424,54 +410,62 @@ struct forth : public word_list *fth.here++ = std::bit_cast((*g)->body()); }; - constexpr static auto& asdf = native_dict< - ctstring{"_d"}, f_dict, 0, - ctstring{"_lit"}, lit_impl, 0, - ctstring{"swap"}, f_swap, 0, - ctstring{"drop"}, f_drop, 0, - ctstring{"dup"}, f_dup, 0, - ctstring{"rot"}, f_rot, 0, - ctstring{"+"}, f_add, 0, - ctstring{"-"}, f_minus, 0, - ctstring{"*"}, f_times, 0, - ctstring{"/"}, f_divide, 0, - ctstring{"mod"}, f_mod, 0, - ctstring{"and"}, f_bitand, 0, - ctstring{"or"}, f_bitor, 0, - ctstring{"xor"}, f_bitxor, 0, - ctstring{"lshift"}, f_lshift, 0, - ctstring{"rshift"}, f_rshift, 0, - ctstring{"["}, f_lbrac, word_base::immediate, - ctstring{"]"}, f_rbrac, 0, - ctstring{"immediate"}, f_imm, 0, - ctstring{"literal"}, f_lit, word_base::immediate, - ctstring{"@"}, f_peek, 0, - ctstring{"!"}, f_poke, 0, - ctstring{"c@"}, f_cpeek, 0, - ctstring{"c!"}, f_cpoke, 0, - ctstring{"="}, f_eq, 0, - ctstring{"<"}, f_lt, 0, - ctstring{"\'"}, f_tick, 0, - ctstring{":"}, f_colon, 0, - ctstring{";"}, f_semic, word_base::immediate, - ctstring{"\\"}, f_comm, word_base::immediate, - ctstring{"cell"}, f_cell, 0, - ctstring{"_jmp"}, f_jmp, 0, - ctstring{"_jmp0"}, f_jmp0, 0, - ctstring{"postpone"}, f_postpone, word_base::immediate + 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; - constexpr static comp_word<"cell+", "cell +", &asdf> w_cellp - {forth::prologue}; - constexpr static comp_word<"cells", "cell *", &w_cellp> w_cells - {forth::prologue}; - constexpr static comp_word<"char+", "1 +", &w_cells> w_charp - {forth::prologue}; - constexpr static comp_word<"1+", "1 +", &w_charp> w_inc - {forth::prologue}; - constexpr static comp_word<"1-", "1 -", &w_inc> w_dec - {forth::prologue}; - - fth.next = &w_dec; + + fth.next = &dict2; fth.end = end_value; }