From 8a6503cd7fa89424f0deac1a20e6cd1aa4899cd7 Mon Sep 17 00:00:00 2001 From: Clyne Sullivan Date: Thu, 2 Jan 2025 21:17:54 -0500 Subject: [PATCH] move more words to forth --- core.fth | 10 ++++++++++ sforth/forth.hpp | 27 ++++++++++----------------- 2 files changed, 20 insertions(+), 17 deletions(-) diff --git a/core.fth b/core.fth index fcd4375..1091b2d 100644 --- a/core.fth +++ b/core.fth @@ -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 diff --git a/sforth/forth.hpp b/sforth/forth.hpp index ecdce3d..5dc0d00 100644 --- a/sforth/forth.hpp +++ b/sforth/forth.hpp @@ -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(fthp->pop()); - std::string_view w {caddr + 1, std::bit_cast(caddr[0])}; - if (auto g = fthp->get(w); !g.has_value()) - fthp->push(std::bit_cast(caddr), 0); - else - fthp->push(std::bit_cast((*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((*g)->body()) : 0); }, 0 , S{":" }, [](auto) { auto w = fthp->parse(); auto d = std::bit_cast(fthp->begin_def(w)); @@ -310,6 +299,14 @@ constexpr auto initialize() auto ptr = ++fthp->ip; if (fthp->pop() == 0) fthp->ip = *std::bit_cast(ptr) - 1; }, 0 + , S{"_PARSE"}, [](auto) { + auto w = fthp->parse(); + fthp->push(std::bit_cast(w.data()), w.size()); }, 0 + , S{"_GET"}, [](auto) { + const addr u = fthp->pop(); + const auto caddr = std::bit_cast(fthp->pop()); + auto g = fthp->get({caddr, u}); + fthp->push(g.has_value() ? std::bit_cast(*g) : 0); }, 0 , S{"POSTPONE"}, [](auto) { fthp->template assert(fthp->compiling); auto w = fthp->parse(); @@ -323,12 +320,6 @@ constexpr auto initialize() *fthp->here++ = std::bit_cast((*g)->body()); *fthp->here++ = std::bit_cast(&comma); } }, word_base::immediate - , S{"SOURCE"}, [](auto) { - auto len = 0u; - while (fthp->source[len]) - len++; - fthp->push(std::bit_cast(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