move more words to forth

llvm
Clyne 3 weeks ago
parent d27214a4dd
commit 8a6503cd7f
Signed by: clyne
GPG Key ID: 7BA5A2980566A649

@ -1,9 +1,14 @@
: ['] ' postpone literal ; immediate
: if ['] _jmp0 , here 0 , ; immediate
: then here swap ! ; immediate
: else ['] _jmp , here 0 , swap here swap ! ; immediate
\ : postpone _parse _get
\ dup cell+ @ 256 and if
\ >xt , else ['] _lit , >xt , ['] , , then ; immediate
: _msb [ 1 cell 8 * 1- lshift ] literal ;
: 2/ dup 1 rshift swap 0< if _msb or then ;
@ -82,6 +87,11 @@
>r 2dup c! char+ r> 1- repeat
2drop drop ;
: source tib 0 begin 2dup + c@ while 1+ repeat ;
: find dup count _get dup if
nip dup >xt swap cell+ @ 256 and if 1 else -1 then
then ;
: >name 2 cells + dup begin 1+ dup c@ bl <= until over - ;
: 'name latest begin 2dup >xt <> over 0<> and while
@ dup 0= if 2drop 0 0 exit then repeat

@ -286,17 +286,6 @@ constexpr auto initialize()
addr v = fthp->pop();
addr w = fthp->pop();
fthp->push(-(w < v)); }, 0
, S{"FIND" }, [](auto) {
const auto caddr = std::bit_cast<const char *>(fthp->pop());
std::string_view w {caddr + 1, std::bit_cast<unsigned char>(caddr[0])};
if (auto g = fthp->get(w); !g.has_value())
fthp->push(std::bit_cast<cell>(caddr), 0);
else
fthp->push(std::bit_cast<cell>((*g)->body()), (*g)->is_immediate() ? 1 : -1); }, 0
, S{"\'" }, [](auto) {
auto w = fthp->parse();
auto g = fthp->get(w);
fthp->push(g ? std::bit_cast<cell>((*g)->body()) : 0); }, 0
, S{":" }, [](auto) {
auto w = fthp->parse();
auto d = std::bit_cast<func *>(fthp->begin_def(w));
@ -310,6 +299,14 @@ constexpr auto initialize()
auto ptr = ++fthp->ip;
if (fthp->pop() == 0)
fthp->ip = *std::bit_cast<func **>(ptr) - 1; }, 0
, S{"_PARSE"}, [](auto) {
auto w = fthp->parse();
fthp->push(std::bit_cast<cell>(w.data()), w.size()); }, 0
, S{"_GET"}, [](auto) {
const addr u = fthp->pop();
const auto caddr = std::bit_cast<const char *>(fthp->pop());
auto g = fthp->get({caddr, u});
fthp->push(g.has_value() ? std::bit_cast<cell>(*g) : 0); }, 0
, S{"POSTPONE"}, [](auto) {
fthp->template assert<error::compile_only_word>(fthp->compiling);
auto w = fthp->parse();
@ -323,12 +320,6 @@ constexpr auto initialize()
*fthp->here++ = std::bit_cast<cell>((*g)->body());
*fthp->here++ = std::bit_cast<cell>(&comma);
} }, word_base::immediate
, S{"SOURCE"}, [](auto) {
auto len = 0u;
while (fthp->source[len])
len++;
fthp->push(std::bit_cast<cell>(fthp->source));
fthp->push(len); }, 0
, S{"KEY"}, [](auto) {
if (fthp->sourcei != std::string_view::npos)
fthp->push(fthp->source[fthp->sourcei++]);
@ -348,6 +339,7 @@ constexpr auto initialize()
, S{"*/" }, S{">R M* D>S R> /"}, 0
, S{"/MOD" }, S{"2DUP MOD -ROT /"}, 0
, S{"RECURSE"}, S{"R> R> DUP >R SWAP >R >XT ,"}, word_base::immediate
, S{"\'" }, S{"_PARSE _GET >XT"}, 0
, S{">XT" }, S{"CELL+ DUP @ 255 AND + CELL+"}, 0
, S{"ALIGN" }, S{"HERE DUP ALIGNED SWAP - ALLOT"}, 0
, S{"ALIGNED"}, S{"CELL 1- + CELL 1- INVERT AND"}, 0
@ -405,6 +397,7 @@ constexpr auto initialize()
, S{"RP" }, S{"_D 2 CELLS +"}, 0
, S{"IP" }, S{"_D 3 CELLS +"}, 0
, S{"DP" }, S{"_D 4 CELLS +"}, 0
, S{"TIB" }, S{"_D 5 CELLS + @"}, 0
, S{">IN" }, S{"_D 6 CELLS +"}, 0
, S{"STATE" }, S{"_D 7 CELLS +"}, 0
, S{"BASE" }, S{"_D 8 CELLS +"}, 0

Loading…
Cancel
Save