#include <tuple>
#include <utility>
-struct forth
+using cell = std::intptr_t;
+using addr = std::uintptr_t;
+using func = void (*)(const void *);
+
+struct word_base;
+
+struct word_list
{
- using cell = std::intptr_t;
- using addr = std::uintptr_t;
- using func = void (*)(const void *);
+ const word_base *next;
+
+ constexpr word_list(const word_base *n = nullptr): next{n} {}
+
+ std::optional<const word_base *> get(std::string_view sv) const;
+
+ static constexpr auto parse(const char *source, std::size_t& sourcei) -> std::string_view {
+ const std::string_view sv {source};
+ const auto e = sv.find_first_of(" \t\r\n", sourcei);
+ const auto word = e != std::string_view::npos ?
+ sv.substr(sourcei, e - sourcei) : sv.substr(sourcei);
+
+ sourcei = sv.find_first_not_of(" \t\r\n", e);
+ return word;
+ }
+};
+
+struct word_base : public word_list
+{
+ static constexpr addr immediate = 1 << 8;
+
+ addr flags_len;
+
+ constexpr word_base(const word_base *n, addr fl):
+ word_list{n}, flags_len{fl} {}
+
+ std::string_view name() const {
+ return {std::bit_cast<const char *>(this + 1)};
+ }
+
+ const func *body() const {
+ const auto ptr = std::bit_cast<const std::uint8_t *>(this + 1);
+ const auto fptr = ptr + (flags_len & 0xFF);
+ return std::bit_cast<const func *>(fptr);
+ }
+
+ constexpr void make_immediate() {
+ flags_len |= immediate;
+ }
+};
+
+template<unsigned N>
+struct ctstring {
+ char data[N];
+
+ consteval ctstring(const char (&s)[N]) {
+ std::copy(s, s + N, data);
+ }
+ consteval operator const char *() const {
+ return data;
+ }
+ consteval auto size() const {
+ return N;
+ }
+};
+
+template<ctstring Name, ctstring Body, auto& Prev>
+struct comp_word : public word_base
+{
+ constexpr static auto N = (sizeof(Name) + sizeof(cell) - 1) & ~(sizeof(cell) - 1);
+ 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);
+
+ b++;
+ if (!Prev.get_ct(word))
+ b++;
+ }
+ return b;
+ }();
+
+ union bodyt {
+ const func *f;
+ cell c;
+ };
+
+ std::array<char, N> namebuf;
+ const func prologue;
+ std::array<bodyt, B> bodybuf;
+
+ consteval const func *get_ct(std::string_view name) const {
+ if (name == std::string_view{Name.data})
+ return &prologue;
+ else
+ return Prev.get_ct(name);
+ }
+
+ consteval comp_word(const func prol, addr flags = 0):
+ word_base{&Prev, N | flags}, namebuf{}, prologue{prol}, bodybuf{}
+ {
+ 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);
+
+ auto w = get_ct(word);
+ if (w) {
+ bptr->f = get_ct(word);
+ bptr++;
+ } else {
+ cell n;
+ std::from_chars(word.cbegin(), word.cend(), n, 10);
+
+ bptr->f = get_ct("_lit");
+ bptr++;
+ bptr->c = n;
+ bptr++;
+ }
+ }
+ }
+};
+
+template<ctstring Name, 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(func bod, addr flags = 0):
+ word_base{Prev, N | flags}, namebuf{}, body{bod}
+ {
+ std::copy(Name.data, Name.data + sizeof(Name), namebuf.data());
+ }
+};
+
+struct forth : public word_list
+{
static constexpr bool enable_exceptions = true;
static constexpr int data_size = 16;
static constexpr int return_size = 16;
}
}
- struct word_base {
- static constexpr addr immediate = 1 << 8;
-
- const word_base *next;
- addr flags_len;
-
- auto name() const -> std::string_view {
- return {std::bit_cast<const char *>(this + 1)};
- }
-
- auto body() const -> const func * {
- const auto ptr = std::bit_cast<const std::uint8_t *>(this + 1);
- const auto fptr = ptr + (flags_len & 0xFF);
- return std::bit_cast<const func *>(fptr);
- }
-
- constexpr void make_immediate() {
- flags_len |= immediate;
- }
- };
-
- template<std::size_t L>
- struct word : public word_base {
- std::array<char, L> name;
- func body;
-
- template<std::size_t N>
- consteval word(const char (&nam)[N],
- func bod = nullptr,
- const word_base *prev = nullptr,
- addr flags = 0):
- word_base{prev, L | flags}, name{}, body{bod}
- {
- std::copy(nam, nam + N, name.begin());
- }
- };
-
- template<std::size_t N>
- word(const char (&nam)[N], func b = nullptr, const word_base *w = nullptr,
- addr flags = 0) -> word<(N + sizeof(cell)) & ~(sizeof(cell) - 1)>;
-
void push(cell v) {
assert<error::stack_overflow>(sp != dstack.begin());
*--sp = v;
//assert<error::dictionary_overflow>(state->here + size < &dictionary.back());
const auto h = std::exchange(here, here + size);
- latest = new (h) word_base (latest, namesz);
+ next = new (h) word_base (next, namesz);
std::copy(name.begin(), name.end(),
std::bit_cast<char *>(h) + sizeof(word_base));
if (entry)
return *this;
}
+ auto parse() -> std::string_view {
+ return word_list::parse(source, sourcei);
+ }
+
void parse_line(std::string_view sv) {
source = sv.data();
sourcei = sv.find_first_not_of(" \t\r\n");
}
}
- auto parse() -> std::string_view {
- const std::string_view sv {source};
-
- const auto e = sv.find_first_of(" \t\r\n", sourcei);
- const auto word = e != npos ? sv.substr(sourcei, e - sourcei)
- : sv.substr(sourcei);
-
- sourcei = sv.find_first_not_of(" \t\r\n", e);
- return word;
- }
-
void execute(const func *body) {
assert<error::execute_error>(body && *body);
(*body)(body);
}
- auto get(std::string_view sv) -> std::optional<const word_base *> {
- for (auto lt = latest; lt; lt = lt->next) {
- if (sv == lt->name())
- return lt;
- }
-
- return {};
- }
-
template<forth **fthp>
- static void prologue(func *body) {
+ static void prologue(const void *bodyf) {
static auto& fth = **fthp;
+ auto body = (func *)bodyf;
fth.rpush(fth.ip);
for (fth.ip = body + 1; *fth.ip; fth.ip++)
auto f_lbrac = [](auto) { fth.compiling = false; };
auto f_rbrac = [](auto) { fth.compiling = true; };
auto f_imm = [](auto) {
- const_cast<word_base *>(fth.latest)->make_immediate(); };
+ 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++ = std::bit_cast<cell>((*g)->body());
};
- constexpr static word w_dict {"_d", f_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};
- constexpr static word w_mod {"mod", f_mod, &w_divide};
- constexpr static word w_bitand {"and", f_bitand, &w_mod};
- constexpr static word w_bitor {"or", f_bitor, &w_bitand};
- constexpr static word w_bitxor {"xor", f_bitxor, &w_bitor};
- constexpr static word w_lshift {"lshift", f_lshift, &w_bitxor};
- constexpr static word w_rshift {"rshift", f_rshift, &w_lshift};
- constexpr static word w_lbrac {"[", f_lbrac, &w_rshift, word_base::immediate};
- constexpr static word w_rbrac {"]", f_rbrac, &w_lbrac};
- constexpr static word w_imm {"immediate", f_imm, &w_rbrac};
- constexpr static word w_lit {"literal", f_lit, &w_imm, word_base::immediate};
- constexpr static word w_peek {"@", f_peek, &w_lit};
- constexpr static word w_poke {"!", f_poke, &w_peek};
- constexpr static word w_cpeek {"c@", f_cpeek, &w_poke};
- constexpr static word w_cpoke {"c!", f_cpoke, &w_cpeek};
- constexpr static word w_swap {"swap", f_swap, &w_cpoke};
- constexpr static word w_drop {"drop", f_drop, &w_swap};
- constexpr static word w_dup {"dup", f_dup, &w_drop};
- constexpr static word w_rot {"rot", f_rot, &w_dup};
- constexpr static word w_eq {"=", f_eq, &w_rot};
- constexpr static word w_lt {"<", f_lt, &w_eq};
- constexpr static word w_tick {"\'", f_tick, &w_lt};
- constexpr static word w_colon {":", f_colon, &w_tick};
- constexpr static word w_semic {";", f_semic, &w_colon, word_base::immediate};
- constexpr static word w_comm {"\\", f_comm, &w_semic, word_base::immediate};
- constexpr static word w_cell {"cell", f_cell, &w_comm};
- constexpr static word w_jmp {"_jmp", f_jmp, &w_cell};
- constexpr static word w_jmp0 {"_jmp0", f_jmp0, &w_jmp};
- constexpr static word w_postp {"postpone", f_postpone, &w_jmp0, word_base::immediate};
-
- fth.latest = &w_postp;
+ constexpr static native_word<"_d"> w_dict {f_dict};
+ constexpr static native_word<"_lit", &w_dict> w_liti {lit_impl};
+ constexpr static native_word<"swap", &w_liti> w_swap {f_swap};
+ constexpr static native_word<"drop", &w_swap> w_drop {f_drop};
+ constexpr static native_word<"dup", &w_drop> w_dup {f_dup};
+ constexpr static native_word<"rot", &w_dup> w_rot {f_rot};
+ constexpr static native_word<"+", &w_rot> w_add {f_add};
+ constexpr static native_word<"-", &w_add> w_minus {f_minus};
+ constexpr static native_word<"*", &w_minus> w_times {f_times};
+ constexpr static native_word<"/", &w_times> w_divid {f_divide};
+ constexpr static native_word<"mod", &w_divid> w_mod {f_mod};
+ constexpr static native_word<"and", &w_mod> w_and {f_bitand};
+ constexpr static native_word<"or", &w_and> w_or {f_bitor};
+ constexpr static native_word<"xor", &w_or> w_xor {f_bitxor};
+ constexpr static native_word<"lshift", &w_xor> w_lsh {f_lshift};
+ constexpr static native_word<"rshift", &w_lsh> w_rsh {f_rshift};
+ constexpr static native_word<"[", &w_rsh> w_lbrac {f_lbrac,
+ word_base::immediate};
+ constexpr static native_word<"]", &w_lbrac> w_rbrac {f_rbrac};
+ constexpr static native_word<"immediate", &w_rbrac> w_imm {f_imm};
+ constexpr static native_word<"literal", &w_imm> w_lit {f_lit,
+ word_base::immediate};
+ constexpr static native_word<"@", &w_lit> w_peek {f_peek};
+ constexpr static native_word<"!", &w_peek> w_poke {f_poke};
+ constexpr static native_word<"c@", &w_poke> w_cpeek {f_cpeek};
+ constexpr static native_word<"c!", &w_cpeek> w_cpoke {f_cpoke};
+ constexpr static native_word<"=", &w_cpoke> w_eq {f_eq};
+ constexpr static native_word<"<", &w_eq> w_lt {f_lt};
+ constexpr static native_word<"\'", &w_lt> w_tick {f_tick};
+ constexpr static native_word<":", &w_tick> w_colon {f_colon};
+ constexpr static native_word<";", &w_colon> w_semic {f_semic,
+ word_base::immediate};
+ constexpr static native_word<"\\", &w_semic> w_comm {f_comm,
+ word_base::immediate};
+ constexpr static native_word<"cell", &w_comm> w_cell {f_cell};
+ constexpr static native_word<"_jmp", &w_cell> w_jmp {f_jmp};
+ constexpr static native_word<"_jmp0", &w_jmp> w_jmp0 {f_jmp0};
+ constexpr static native_word<"postpone", &w_jmp0> w_postp {f_postpone,
+ word_base::immediate};
+ constexpr static comp_word<"cell+", "cell +", w_postp> w_cellp
+ {forth::prologue<fthp>};
+ constexpr static comp_word<"cells", "cell *", w_cellp> w_cells
+ {forth::prologue<fthp>};
+ constexpr static comp_word<"char+", "1 +", w_cells> w_charp
+ {forth::prologue<fthp>};
+ constexpr static comp_word<"1+", "1 +", w_charp> w_inc
+ {forth::prologue<fthp>};
+ constexpr static comp_word<"1-", "1 -", w_inc> w_dec
+ {forth::prologue<fthp>};
+
+ fth.next = &w_dec;
fth.end = end_value;
}
func **rp;
func *ip = nullptr;
cell *here = std::bit_cast<cell *>(this + 1);
- const word_base *latest = nullptr;
const char *source = nullptr;
std::size_t sourcei = npos;
cell compiling = false;
std::array<func *, return_size> rstack;
};
-static_assert(offsetof(forth::word_base, flags_len) == 1 * sizeof(forth::cell));
-static_assert(offsetof(forth, rp) == 1 * sizeof(forth::cell));
-static_assert(offsetof(forth, ip) == 2 * sizeof(forth::cell));
-static_assert(offsetof(forth, here) == 3 * sizeof(forth::cell));
-static_assert(offsetof(forth, latest) == 4 * sizeof(forth::cell));
-static_assert(offsetof(forth, source) == 5 * sizeof(forth::cell));
-static_assert(offsetof(forth, sourcei) == 6 * sizeof(forth::cell));
-static_assert(offsetof(forth, compiling) == 7 * sizeof(forth::cell));
-static_assert(offsetof(forth, end) == 8 * sizeof(forth::cell));
-static_assert(offsetof(forth, base) == 9 * sizeof(forth::cell));
+std::optional<const word_base *> word_list::get(std::string_view sv) const
+{
+ for (auto lt = next; lt; lt = lt->next) {
+ if (sv == lt->name())
+ return lt;
+ }
+
+ return {};
+}
+
+//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));
+//static_assert(offsetof(forth, ip) == 3 * sizeof(cell));
+//static_assert(offsetof(forth, here) == 4 * sizeof(cell));
+//static_assert(offsetof(forth, source) == 5 * sizeof(cell));
+//static_assert(offsetof(forth, sourcei) == 6 * sizeof(cell));
+//static_assert(offsetof(forth, compiling) == 7 * sizeof(cell));
+//static_assert(offsetof(forth, end) == 8 * sizeof(cell));
+//static_assert(offsetof(forth, base) == 9 * sizeof(cell));
#endif // SFORTH_HPP
projects / clyne / sforth.git / commitdiff