clyne
/
sforth
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

build up comp_dict

Browse Source
main
Clyne 3 weeks ago
parent f88a775617
commit d2cff5f967
Signed by: clyne
GPG Key ID: 1B74EE6C49C96795
2 changed files with 220 additions and 276 deletions
Show Stats Download Patch File Download Diff File

40
core.fth
Unescape Escape View File

@ -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 - ; : 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 : ['] ' [ ' literal , ] ; immediate
: if ['] _jmp0 , here 0 , ; immediate : if ['] _jmp0 , here 0 , ; immediate
@ -39,11 +10,6 @@
: 2>r ['] swap , ['] >r , ['] >r , ; immediate : 2>r ['] swap , ['] >r , ['] >r , ; immediate
: r@ ['] r> , ['] dup , ['] >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 ; : _msb [ 1 cell 8 * 1- lshift ] literal ;
: 2/ dup 1 rshift swap 0< if _msb or then ; : 2/ dup 1 rshift swap 0< if _msb or then ;
@ -52,16 +18,10 @@
: min 2dup <= if drop else swap drop then ; : min 2dup <= if drop else swap drop then ;
: max 2dup <= if swap drop else 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 ; : cr 10 emit ;
: space bl emit ; : space bl emit ;
\ : spaces begin dup 0 > while space 1- repeat drop ; \ : spaces begin dup 0 > while space 1- repeat drop ;
: decimal 10 base ! ;
: hex 16 base ! ;
: begin 0 here ; immediate : begin 0 here ; immediate
: while swap 1+ swap postpone if -rot ; immediate : while swap 1+ swap postpone if -rot ; immediate
: repeat ['] _jmp , , if postpone then then ; immediate : repeat ['] _jmp , , if postpone then then ; immediate

456
forth.hpp
Unescape Escape View File

@ -94,104 +94,6 @@ struct cS {
} }
}; };
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 struct forth : public word_list
{ {
static constexpr bool enable_exceptions = true; static constexpr bool enable_exceptions = true;
@ -330,144 +232,7 @@ struct forth : public word_list
} }
template<forth** fthp> template<forth** fthp>
static void initialize(cell *end_value) 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 auto error_string(error err) noexcept -> std::string_view { static auto error_string(error err) noexcept -> std::string_view {
using enum error; using enum error;
@ -504,6 +269,104 @@ struct forth : public word_list
std::array<func *, return_size> rstack; 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 std::optional<const word_base *> word_list::get(std::string_view sv) const
{ {
for (auto lt = next; lt; lt = lt->next) { for (auto lt = next; lt; lt = lt->next) {
@ -514,6 +377,127 @@ std::optional<const word_base *> word_list::get(std::string_view sv) const
return {}; 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(word_base, flags_len) == 1 * sizeof(cell));
//static_assert(offsetof(forth, sp) == 1 * sizeof(cell)); //static_assert(offsetof(forth, sp) == 1 * sizeof(cell));
//static_assert(offsetof(forth, rp) == 2 * sizeof(cell)); //static_assert(offsetof(forth, rp) == 2 * sizeof(cell));

Write Preview
Loading…
Cancel
Save