]> code.bitgloo.com Git - clyne/sforth.git/commitdiff
move more words to forth
authorClyne Sullivan <clyne@bitgloo.com>
Fri, 3 Jan 2025 02:17:54 +0000 (21:17 -0500)
committerClyne Sullivan <clyne@bitgloo.com>
Fri, 3 Jan 2025 02:17:54 +0000 (21:17 -0500)
core.fth
sforth/forth.hpp

index fcd437581092d391ab98cb39e97457a408a01c3e..1091b2df32e55b0db41778c9810272305a7a7373 100644 (file)
--- 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 ;
 
             >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
index ecdce3dc0af0f6b63eb4baa8fa43bdc831665566..5dc0d00792df934eb15284f67c1c30bbc12c2d49 100644 (file)
@@ -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