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

Compare commits

base: clyne:f88a775617bdc52e24c58e92a736e222bc2cc030
Branches Tags
clyne:main
..
compare: clyne:9b90d6fe67e80a782c69791a8e3ef916cb6a4499
Branches Tags
clyne:main

No commits in common. 'f88a775617bdc52e24c58e92a736e222bc2cc030' and '9b90d6fe67e80a782c69791a8e3ef916cb6a4499' have entirely different histories.
f88a775617 ... 9b90d6fe67

2 changed files with 114 additions and 111 deletions
Show Stats

20
core.fth
Unescape Escape View File

@ -1,4 +1,8 @@
: chars ;
: state [ _d 7 cells + ] literal ; : state [ _d 7 cells + ] literal ;
\ : [ 0 state ! ; immediate
\ : ] -1 state ! ;
: sp [ _d cell+ ] literal ; : sp [ _d cell+ ] literal ;
: rp [ _d 2 cells + ] literal ; : rp [ _d 2 cells + ] literal ;
@ -12,6 +16,8 @@
: base [ _d 9 cells + ] literal ; : base [ _d 9 cells + ] literal ;
: latest _d @ ; : latest _d @ ;
\ : dup sp@ @ ;
\ : drop sp@ cell+ sp ! ;
: pick cells cell+ sp@ + @ ; : pick cells cell+ sp@ + @ ;
: >r rp@ cell - rp ! : >r rp@ cell - rp !
rp@ cell+ @ rp@ ! rp@ cell+ @ rp@ !
@ -19,8 +25,11 @@
: r> rp@ @ : r> rp@ @
rp@ cell+ rp ! rp@ cell+ rp !
rp@ @ swap rp@ ! ; rp@ @ swap rp@ ! ;
\ : rot >r swap r> swap ;
: -rot rot rot ;
: over 1 pick ; : over 1 pick ;
: 2drop drop drop ;
: 2dup over over ; : 2dup over over ;
: 2over 3 pick 3 pick ; : 2over 3 pick 3 pick ;
: 2swap rot >r rot r> ; : 2swap rot >r rot r> ;
@ -42,8 +51,18 @@
: 2! swap over ! cell+ ! ; : 2! swap over ! cell+ ! ;
: 2@ dup cell+ @ swap @ ; : 2@ dup cell+ @ swap @ ;
: 0= 0 = ;
: 0< 0 < ;
: <= 2dup < >r = r> or ; : <= 2dup < >r = r> or ;
: > swap < ;
: <> = 0= ;
: 1+ 1 + ;
: 1- 1 - ;
: invert -1 xor ;
: negate -1 * ;
: 2* 2 * ;
: _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 ;
@ -56,6 +75,7 @@
: align here dup aligned swap - allot ; : align here dup aligned swap - allot ;
: cr 10 emit ; : cr 10 emit ;
: bl 32 ;
: space bl emit ; : space bl emit ;
\ : spaces begin dup 0 > while space 1- repeat drop ; \ : spaces begin dup 0 > while space 1- repeat drop ;

205
forth.hpp
Unescape Escape View File

@ -80,10 +80,10 @@ struct word_base : public word_list
}; };
template<unsigned N> template<unsigned N>
struct cS { struct ctstring {
char data[N]; char data[N];
consteval cS(const char (&s)[N]) { consteval ctstring(const char (&s)[N]) {
std::copy(s, s + N, data); std::copy(s, s + N, data);
} }
consteval operator const char *() const { consteval operator const char *() const {
@ -94,42 +94,20 @@ struct cS {
} }
}; };
template<cS Name, func Body, auto *Prev = (const word_base *)nullptr> template<ctstring Name, ctstring Body, auto& Prev>
struct native_word : public word_base struct comp_word : public word_base
{ {
constexpr static auto N = (sizeof(Name) + sizeof(cell) - 1) & ~(sizeof(cell) - 1); 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 = static constexpr std::size_t B =
[] { [] {
std::size_t b = 1; std::size_t b = 1;
std::string_view sv {Body.data}; std::string_view sv {Body.data};
auto sourcei = sv.find_first_not_of(" \t\r\n"); auto sourcei = sv.find_first_not_of(" \t\r\n");
while (sourcei != std::string_view::npos) { while (sourcei != std::string_view::npos) {
const auto word = word_list::parse(Body.data, sourcei); const auto word = parse(Body.data, sourcei);
b++; b++;
if (!Prev->get_ct(word)) if (!Prev.get_ct(word))
b++; b++;
} }
return b; return b;
@ -140,26 +118,37 @@ struct comp_word : public native_word<Name, Prol, Prev>
cell c; cell c;
}; };
std::array<bodyt, B> bodybuf {}; 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(addr flags = 0): consteval comp_word(const func prol, addr flags = 0):
native_word<Name, Prol, Prev>{flags} word_base{&Prev, N | flags}, namebuf{}, prologue{prol}, bodybuf{}
{ {
std::copy(Name.data, Name.data + sizeof(Name), namebuf.data());
auto bptr = bodybuf.begin(); auto bptr = bodybuf.begin();
std::string_view sv {Body}; std::string_view sv {Body};
auto sourcei = sv.find_first_not_of(" \t\r\n"); auto sourcei = sv.find_first_not_of(" \t\r\n");
while (sourcei != std::string_view::npos) { while (sourcei != std::string_view::npos) {
const auto word = word_list::parse(Body, sourcei); const auto word = parse(Body, sourcei);
auto w = Prev->get_ct(word); auto w = get_ct(word);
if (w) { if (w) {
bptr->f = Prev->get_ct(word); bptr->f = get_ct(word);
bptr++; bptr++;
} else { } else {
cell n; cell n;
std::from_chars(word.cbegin(), word.cend(), n, 10); std::from_chars(word.cbegin(), word.cend(), n, 10);
bptr->f = Prev->get_ct("_lit"); bptr->f = get_ct("_lit");
bptr++; bptr++;
bptr->c = n; bptr->c = n;
bptr++; bptr++;
@ -168,28 +157,27 @@ struct comp_word : public native_word<Name, Prol, Prev>
} }
}; };
template<cS Name, func Body, addr Flags, auto... Next> template<ctstring Name, auto *Prev = (const word_base *)nullptr>
struct native_dict struct native_word : public word_base
{ {
constexpr static native_word<Name, Body, constexpr static auto N = (sizeof(Name) + sizeof(cell) - 1) & ~(sizeof(cell) - 1);
[] { std::array<char, N> namebuf;
if constexpr (sizeof...(Next)) func body;
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> consteval const func *get_ct(std::string_view name) const {
struct comp_dict if (name == std::string_view{Name.data})
{ return &body;
constexpr static comp_word<Prol, Name, Body, else if constexpr (Prev != nullptr)
[] { return Prev->get_ct(name);
if constexpr (sizeof...(Next)) else
return &comp_dict<Prol, Prev, Next...>::word; return nullptr;
else }
return Prev;
}()> word {Flags}; 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 struct forth : public word_list
@ -410,62 +398,57 @@ struct forth : public word_list
*fth.here++ = std::bit_cast<cell>((*g)->body()); *fth.here++ = std::bit_cast<cell>((*g)->body());
}; };
constexpr static auto& dict1 = native_dict< constexpr static native_word<"_d"> w_dict {f_dict};
cS{"_d"}, f_dict, 0, constexpr static native_word<"_lit", &w_dict> w_liti {lit_impl};
cS{"_lit"}, lit_impl, 0, constexpr static native_word<"swap", &w_liti> w_swap {f_swap};
cS{"swap"}, f_swap, 0, constexpr static native_word<"drop", &w_swap> w_drop {f_drop};
cS{"drop"}, f_drop, 0, constexpr static native_word<"dup", &w_drop> w_dup {f_dup};
cS{"dup"}, f_dup, 0, constexpr static native_word<"rot", &w_dup> w_rot {f_rot};
cS{"rot"}, f_rot, 0, constexpr static native_word<"+", &w_rot> w_add {f_add};
cS{"+"}, f_add, 0, constexpr static native_word<"-", &w_add> w_minus {f_minus};
cS{"-"}, f_minus, 0, constexpr static native_word<"*", &w_minus> w_times {f_times};
cS{"*"}, f_times, 0, constexpr static native_word<"/", &w_times> w_divid {f_divide};
cS{"/"}, f_divide, 0, constexpr static native_word<"mod", &w_divid> w_mod {f_mod};
cS{"mod"}, f_mod, 0, constexpr static native_word<"and", &w_mod> w_and {f_bitand};
cS{"and"}, f_bitand, 0, constexpr static native_word<"or", &w_and> w_or {f_bitor};
cS{"or"}, f_bitor, 0, constexpr static native_word<"xor", &w_or> w_xor {f_bitxor};
cS{"xor"}, f_bitxor, 0, constexpr static native_word<"lshift", &w_xor> w_lsh {f_lshift};
cS{"lshift"}, f_lshift, 0, constexpr static native_word<"rshift", &w_lsh> w_rsh {f_rshift};
cS{"rshift"}, f_rshift, 0, constexpr static native_word<"[", &w_rsh> w_lbrac {f_lbrac,
cS{"["}, f_lbrac, word_base::immediate, word_base::immediate};
cS{"]"}, f_rbrac, 0, constexpr static native_word<"]", &w_lbrac> w_rbrac {f_rbrac};
cS{"immediate"}, f_imm, 0, constexpr static native_word<"immediate", &w_rbrac> w_imm {f_imm};
cS{"literal"}, f_lit, word_base::immediate, constexpr static native_word<"literal", &w_imm> w_lit {f_lit,
cS{"@"}, f_peek, 0, word_base::immediate};
cS{"!"}, f_poke, 0, constexpr static native_word<"@", &w_lit> w_peek {f_peek};
cS{"c@"}, f_cpeek, 0, constexpr static native_word<"!", &w_peek> w_poke {f_poke};
cS{"c!"}, f_cpoke, 0, constexpr static native_word<"c@", &w_poke> w_cpeek {f_cpeek};
cS{"="}, f_eq, 0, constexpr static native_word<"c!", &w_cpeek> w_cpoke {f_cpoke};
cS{"<"}, f_lt, 0, constexpr static native_word<"=", &w_cpoke> w_eq {f_eq};
cS{"\'"}, f_tick, 0, constexpr static native_word<"<", &w_eq> w_lt {f_lt};
cS{":"}, f_colon, 0, constexpr static native_word<"\'", &w_lt> w_tick {f_tick};
cS{";"}, f_semic, word_base::immediate, constexpr static native_word<":", &w_tick> w_colon {f_colon};
cS{"\\"}, f_comm, word_base::immediate, constexpr static native_word<";", &w_colon> w_semic {f_semic,
cS{"cell"}, f_cell, 0, word_base::immediate};
cS{"_jmp"}, f_jmp, 0, constexpr static native_word<"\\", &w_semic> w_comm {f_comm,
cS{"_jmp0"}, f_jmp0, 0, word_base::immediate};
cS{"chars"}, [](auto) {}, 0, constexpr static native_word<"cell", &w_comm> w_cell {f_cell};
cS{"postpone"}, f_postpone, word_base::immediate constexpr static native_word<"_jmp", &w_cell> w_jmp {f_jmp};
>::word; constexpr static native_word<"_jmp0", &w_jmp> w_jmp0 {f_jmp0};
constexpr static auto& dict2 = comp_dict<forth::prologue<fthp>, &dict1 constexpr static native_word<"postpone", &w_jmp0> w_postp {f_postpone,
, cS{"1-" }, cS{"1 -" }, 0 word_base::immediate};
, cS{"1+" }, cS{"1 +" }, 0 constexpr static comp_word<"cell+", "cell +", w_postp> w_cellp
, cS{"cell+" }, cS{"cell +"}, 0 {forth::prologue<fthp>};
, cS{"cells" }, cS{"cell *"}, 0 constexpr static comp_word<"cells", "cell *", w_cellp> w_cells
, cS{"char+" }, cS{"1 +" }, 0 {forth::prologue<fthp>};
, cS{"-rot" }, cS{"rot rot"}, 0 constexpr static comp_word<"char+", "1 +", w_cells> w_charp
, cS{"2drop" }, cS{"drop drop"}, 0 {forth::prologue<fthp>};
, cS{"0=" }, cS{"0 ="}, 0 constexpr static comp_word<"1+", "1 +", w_charp> w_inc
, cS{"0<" }, cS{"0 <"}, 0 {forth::prologue<fthp>};
, cS{"<>" }, cS{"= 0="}, 0 constexpr static comp_word<"1-", "1 -", w_inc> w_dec
, cS{">" }, cS{"swap <"}, 0 {forth::prologue<fthp>};
, cS{"invert"}, cS{"-1 xor"}, 0
, cS{"negate"}, cS{"-1 *"}, 0 fth.next = &w_dec;
, cS{"2*" }, cS{"2 *"}, 0
, cS{"bl" }, cS{"32"}, 0
>::word;
fth.next = &dict2;
fth.end = end_value; fth.end = end_value;
} }

Write Preview
Loading…
Cancel
Save