aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorClyne Sullivan <clyne@bitgloo.com>2025-01-02 21:17:54 -0500
committerClyne Sullivan <clyne@bitgloo.com>2025-01-02 21:17:54 -0500
commit8a6503cd7fa89424f0deac1a20e6cd1aa4899cd7 (patch)
tree6101f175995b3514399217307866170c2119981d
parentd27214a4dd00cf6489079037829447fe84adaaa7 (diff)
move more words to forth
-rw-r--r--core.fth10
-rw-r--r--sforth/forth.hpp27
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<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