}
};
-template<cS Name, func Body, auto *Prev = (const word_base *)nullptr>
-struct native_word : public word_base
-{
- constexpr static auto N = (sizeof(Name) + sizeof(cell) - 1) & ~(sizeof(cell) - 1);
- std::array<char, N> 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<const func Prol, cS Name, cS Body, auto *Prev = (const word_base *)nullptr>
-struct comp_word : public native_word<Name, Prol, Prev>
-{
- 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<bodyt, B> bodybuf {};
-
- consteval comp_word(addr flags = 0):
- native_word<Name, Prol, Prev>{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<cS Name, func Body, addr Flags, auto... Next>
-struct native_dict
-{
- constexpr static native_word<Name, Body,
- [] {
- if constexpr (sizeof...(Next))
- return &native_dict<Next...>::word;
- else
- return (const word_base *)nullptr;
- }()> word {Flags};
-};
-
-template<func Prol, auto *Prev, cS Name, cS Body, addr Flags, auto... Next>
-struct comp_dict
-{
- constexpr static comp_word<Prol, Name, Body,
- [] {
- if constexpr (sizeof...(Next))
- return &comp_dict<Prol, Prev, Next...>::word;
- else
- return Prev;
- }()> word {Flags};
-};
-
struct forth : public word_list
{
static constexpr bool enable_exceptions = true;
}
template<forth** fthp>
- static void initialize(cell *end_value)
- {
- assert<error::init_error>(*fthp);
-
- static auto& fth = **fthp;
-
- constexpr static func lit_impl = [](auto) {
- auto ptr = std::bit_cast<cell *>(++fth.ip);
- fth.push(*ptr);
- };
- auto f_dict = [](auto) { fth.push(std::bit_cast<cell>(&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<word_base *>(fth.next)->make_immediate(); };
- auto f_lit = [](auto) {
- //assert<error::compile_only_word>(fth.compiling);
- *fth.here++ = std::bit_cast<cell>(&lit_impl);
- *fth.here++ = fth.pop(); };
- auto f_peek = [](auto) { fth.push(*std::bit_cast<cell *>(fth.pop())); };
- auto f_poke = [](auto) {
- auto [p, v] = fth.pop<2>();
- *std::bit_cast<cell *>(p) = v; };
- auto f_cpeek = [](auto) { fth.push(*std::bit_cast<char *>(fth.pop())); };
- auto f_cpoke = [](auto) {
- auto [p, v] = fth.pop<2>();
- *std::bit_cast<char *>(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<cell>((*g)->body()));
- else
- fth.push(0); };
- auto f_colon = [](auto) {
- const auto prologue = forth::prologue<fthp>;
- auto w = fth.parse();
- fth.add(w);
- *fth.here++ = std::bit_cast<cell>(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<func **>(ptr) - 1;
- };
- auto f_jmp0 = [](auto) {
- auto ptr = ++fth.ip;
-
- if (fth.pop() == 0)
- fth.ip = *std::bit_cast<func **>(ptr) - 1;
- };
- auto f_postpone = [](auto) {
- assert<error::compile_only_word>(fth.compiling);
-
- auto w = fth.parse();
- auto g = fth.get(w);
-
- assert<error::word_not_found>(g.has_value());
-
- *fth.here++ = std::bit_cast<cell>((*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<forth::prologue<fthp>, &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;
std::array<func *, return_size> rstack;
};
+template<cS Name, func Body, auto *Prev = (const word_base *)nullptr>
+struct native_word : public word_base
+{
+ constexpr static auto N = (sizeof(Name) + sizeof(cell) - 1) & ~(sizeof(cell) - 1);
+ std::array<char, N> 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<const func Prol, cS Name, cS Body, auto *Prev = (const word_base *)nullptr>
+struct comp_word : public native_word<Name, Prol, Prev>
+{
+ 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<bodyt, B> bodybuf {};
+
+ consteval comp_word(addr flags = 0):
+ native_word<Name, Prol, Prev>{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<cS Name, func Body, addr Flags, auto... Next>
+struct native_dict
+{
+ constexpr static native_word<Name, Body,
+ [] {
+ if constexpr (sizeof...(Next))
+ return &native_dict<Next...>::word;
+ else
+ return (const word_base *)nullptr;
+ }()> word {Flags};
+};
+
+template<func Prol, auto *Prev, cS Name, cS Body, addr Flags, auto... Next>
+struct comp_dict
+{
+ constexpr static comp_word<Prol, Name, Body,
+ [] {
+ if constexpr (sizeof...(Next))
+ return &comp_dict<Prol, Prev, Next...>::word;
+ else
+ return Prev;
+ }()> word {Flags};
+};
+
std::optional<const word_base *> word_list::get(std::string_view sv) const
{
for (auto lt = next; lt; lt = lt->next) {
return {};
}
+template<forth** fthp>
+void forth::initialize(cell *end_value)
+{
+ assert<error::init_error>(*fthp);
+
+ static auto& fth = **fthp;
+ static auto _d = std::bit_cast<cell>(*fthp);
+
+ constexpr static func lit_impl = [](auto) {
+ auto ptr = std::bit_cast<cell *>(++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<word_base *>(fth.next)->make_immediate(); }, 0
+ , cS{"literal"}, [](auto) {
+ //assert<error::compile_only_word>(fth.compiling);
+ *fth.here++ = std::bit_cast<cell>(&lit_impl);
+ *fth.here++ = fth.pop(); }, word_base::immediate
+ , cS{"@" }, [](auto) { fth.push(*std::bit_cast<cell *>(fth.pop())); }, 0
+ , cS{"!" }, [](auto) { auto [p, v] = fth.pop<2>(); *std::bit_cast<cell *>(p) = v; }, 0
+ , cS{"c@" }, [](auto) { fth.push(*std::bit_cast<char *>(fth.pop())); }, 0
+ , cS{"c!" }, [](auto) { auto [p, v] = fth.pop<2>(); *std::bit_cast<char *>(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<cell>((*g)->body()) : 0); }, 0
+ , cS{":" }, [](auto) {
+ const auto prologue = forth::prologue<fthp>;
+ auto w = fth.parse();
+ fth.add(w);
+ *fth.here++ = std::bit_cast<cell>(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<func **>(ptr) - 1; }, 0
+ , cS{"_jmp0"}, [](auto) {
+ auto ptr = ++fth.ip;
+ if (fth.pop() == 0)
+ fth.ip = *std::bit_cast<func **>(ptr) - 1; }, 0
+ , cS{"chars"}, [](auto) {}, 0
+ , cS{"postpone"}, [](auto) {
+ assert<error::compile_only_word>(fth.compiling);
+ auto w = fth.parse();
+ auto g = fth.get(w);
+ assert<error::word_not_found>(g.has_value());
+ *fth.here++ = std::bit_cast<cell>((*g)->body()); }, word_base::immediate
+ >::word;
+ constexpr static auto& dict2 = comp_dict<forth::prologue<fthp>, &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));
projects / clyne / sforth.git / commitdiff