diff options
author | Clyne Sullivan <clyne@bitgloo.com> | 2025-01-02 21:17:54 -0500 |
---|---|---|
committer | Clyne Sullivan <clyne@bitgloo.com> | 2025-01-02 21:17:54 -0500 |
commit | 8a6503cd7fa89424f0deac1a20e6cd1aa4899cd7 (patch) | |
tree | 6101f175995b3514399217307866170c2119981d | |
parent | d27214a4dd00cf6489079037829447fe84adaaa7 (diff) |
move more words to forth
-rw-r--r-- | core.fth | 10 | ||||
-rw-r--r-- | sforth/forth.hpp | 27 |
2 files changed, 20 insertions, 17 deletions
@@ -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<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 |