literal, postpone to forth and more

core.fth

@@ -1,8 +1,7 @@
-: [']       ' postpone literal ; immediate
-
-: if        ['] _jmp0 , here 0 , ; immediate
-: then      here swap ! ; immediate
-: else      ['] _jmp , here 0 , swap here swap ! ; immediate
+: literal   [ ' _lit dup , , ] , , ; immediate
+: [']       ' [ ' literal , ] ; 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 ;
@@ -14,8 +13,8 @@
 
 : begin     0 here ; immediate
 : while     swap 1+ swap postpone if -rot ; immediate
-: repeat    ['] _jmp , , if postpone then then ; immediate
-: until     ['] _jmp0 , , drop ; immediate
+: repeat    _jmp , , if postpone then then ; immediate
+: until     _jmp0 , , drop ; immediate
 
 : do        ['] _lit , here 0 , ['] >r , postpone 2>r here ; immediate
 : unloop    postpone 2r> ['] 2drop , ['] r> , ['] drop , ; immediate
@@ -24,10 +23,10 @@
             postpone r@ ['] swap , ['] >r ,
             ['] - , ['] 2dup , ['] + , ['] over , ['] xor ,
             ['] rot , ['] rot , ['] xor , ['] and , ['] _lit , 0 ,
-            ['] < , ['] _jmp0 , ,
+            ['] < , _jmp0 , ,
             postpone unloop here 1 cells - swap ! ; immediate
 : loop      postpone 2r> ['] 1+ , ['] 2dup ,
-            postpone 2>r ['] = , ['] _jmp0 , ,
+            postpone 2>r ['] = , _jmp0 , ,
             postpone unloop here 1 cells - swap ! ; immediate
 : i         postpone r@ ; immediate
 : j         postpone 2r> ['] r> , postpone r@ ['] swap ,
@@ -37,7 +36,7 @@
 : >body     [ 2 cells ] literal + @ ;
 
 : _does>    latest dup cell+ @ [ 5 cells ] literal + +
-            ['] _jmp over ! cell+ ! ;
+            _jmp over ! cell+ ! ;
 
 : does>     here 4 cells + postpone literal ['] _does> , 0 , ; immediate
 
@@ -48,6 +47,7 @@
 : space     bl emit ;
 : spaces    begin dup 0 > while space 1- repeat drop ;
 
+: key       >in @ 0< if 0 else tib @ >in @ + c@ 1 >in +! then ;
 : word      0 here c! begin \ bl
             key 2dup <>     \ bl key <>
             over 0<> and while \ bl key
@@ -59,7 +59,7 @@
 : char      0 here char+ c! bl word char+ c@ ;
 : [char]    char postpone literal ; immediate
 
-: s"        state @ if ['] _jmp , here 0 , then
+: s"        state @ if _jmp , here 0 , then
             [char] " word count
             state @ 0<> if
             dup cell+ allot
@@ -70,7 +70,7 @@
 
 : (         begin [char] ) key = until ; immediate
 
-: execute   [ here 3 cells + ] literal ! [ ' _jmp , 0 , ] ;
+: execute   [ here 3 cells + ] literal ! [ _jmp , 0 , ] ;
 
 : move      dup 0 <= if drop 2drop exit then
             >r 2dup < r> swap if
@@ -82,3 +82,16 @@
             >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
+            nip >name ;
+: words     latest begin dup >name type space @ dup 0= until drop ;
+: see       ' cell+ begin dup @ ?dup while
+            'name ?dup 0= if drop dup @ . else type then
+            space cell+ repeat drop ;

main.cpp

@@ -25,6 +25,35 @@
 
 constinit static sforth::forth<8192> forth {sforth::initialize<&forth>()};
 
+bool sforth_debug_hook()
+{
+    char c;
+
+    std::cout << "DS: ";
+    for (auto it = forth.sp; it != forth.dstack.end(); it++) {
+        std::cout << *it << ' ';
+    }
+    std::cout << std::endl;
+    std::cout << "RS: ";
+    for (auto it = forth.rp; it != forth.rstack.end(); it++) {
+        if (auto w = forth.lookup(*it); w)
+            std::cout << (*w)->name() << '+' << ((sforth::addr)*it - std::bit_cast<sforth::addr>((*w)->body())) << ' ';
+        else
+            std::cout << *it << ' ';
+    }
+    std::cout << std::endl;
+    std::cout << "HERE: " << (sforth::addr)forth.here << std::endl;
+    std::cout << "IP: ";
+    if (auto w = forth.lookup(forth.ip); w)
+        std::cout << (*w)->name() << '+' << ((sforth::addr)forth.ip - std::bit_cast<sforth::addr>((*w)->body())) << ' ';
+    else
+        std::cout << forth.ip << ' ';
+
+    std::cout << std::endl << "> ";
+    std::cin >> c;
+    return true;
+}
+
 static bool parse_stream(auto&, std::istream&, bool say_okay = false);
 
 constinit static sforth::native_word<".", [](auto) {

sforth/forth.hpp

@@ -28,9 +28,18 @@
 #include <string_view>
 #include <utility>
 
+extern bool sforth_debug_hook();
+
 namespace sforth {
 
+template<typename T>
+concept CellSized = (sizeof(cell) == sizeof(T));
+
+template<typename T>
+concept CellConvertible = !std::same_as<cell, T> && CellSized<T>;
+
 constexpr bool enable_exceptions = true;
+constexpr bool enable_debugger = false;
 
 enum class error : int
 {
@@ -84,7 +93,7 @@ template<> struct catcher<false> {
     std::jmp_buf buf = {};
 
     void operator()(error e) {
-        std::longjmp(buf, static_cast<int>(e));
+        std::longjmp(buf, std::to_underlying(e));
     }
 
     std::optional<error> set() {
@@ -114,13 +123,17 @@ struct forth : public word_list
         }
     }
 
-    void push(cell v) {
+    void push1(cell v) {
         assert<error::stack_overflow>(sp != dstack.begin());
         *--sp = v;
     }
 
-    void push(cell v, auto... vs) {
-        push(v); (push(vs), ...);
+    void push1(CellConvertible auto v) {
+        push1(std::bit_cast<cell>(v));
+    }
+
+    void push(auto v, auto... vs) {
+        push1(v); (push(vs), ...);
     }
 
     void rpush(func *v) {
@@ -128,14 +141,16 @@ struct forth : public word_list
         *--rp = v;
     }
 
-    cell& top() {
+    template<typename T = cell>
+    T& top() {
         assert<error::stack_underflow>(sp != dstack.end());
-        return *sp;
+        return *std::bit_cast<T*>(sp);
     }
 
-    cell pop() {
+    template<typename T = cell>
+    T pop() {
         assert<error::stack_underflow>(sp != dstack.end());
-        return *sp++;
+        return std::bit_cast<T>(*sp++);
     }
 
     auto rpop() -> func * {
@@ -143,6 +158,14 @@ struct forth : public word_list
         return *rp++;
     }
 
+    void comma1(CellSized auto v) {
+        *here++ = std::bit_cast<cell>(v);
+    }
+
+    void comma(CellSized auto... vs) {
+        (comma1(vs), ...);
+    }
+
     auto begin_def(std::string_view name) -> word_base * {
         const auto namesz = (name.size() + 1 + sizeof(cell) - 1) & ~(sizeof(cell) - 1);
         const auto size = (sizeof(word_base) + namesz) / sizeof(cell);
@@ -177,15 +200,18 @@ struct forth : public word_list
                 const auto n = from_chars<cell>(word, base);
                 assert<error::word_not_found>(n.has_value());
 
-                push(*n);
 
-                if (compiling)
-                    execute((*get("LITERAL"))->body());
+                if (compiling) {
+                    comma((*get("_LIT"))->body());
+                    comma(*n);
+                } else {
+                    push(*n);
+                }
             } else {
                 auto body = (*ent)->body();
 
                 if (compiling && ((*ent)->flags_len & word_base::immediate) == 0)
-                    *here++ = std::bit_cast<cell>(body);
+                    comma(body);
                 else
                     execute(body);
             }
@@ -198,7 +224,13 @@ struct forth : public word_list
 
     void execute(const func *body) {
         assert<error::execute_error>(body && *body);
-        (*body)(body);
+
+        if constexpr (!enable_debugger) {
+            (*body)(body);
+        } else {
+            if (::sforth_debug_hook())
+                (*body)(body);
+        }
     }
 
     constexpr forth(const word_base *latest):
@@ -236,142 +268,87 @@ constexpr auto initialize()
         fthp->ip = fthp->rpop();
     };
 
-    constexpr static func comma = [](auto) { *fthp->here++ = fthp->pop(); };
-
     constexpr static func lit_impl = [](auto) {
-        auto ptr = std::bit_cast<cell *>(++fthp->ip);
-        fthp->push(*ptr);
+        fthp->push(*++fthp->ip);
+    };
+
+    constexpr static func jmp_impl = [](auto){
+        auto ptr = ++fthp->ip;
+        fthp->ip = *std::bit_cast<func **>(ptr) - 1;
+    };
+
+    constexpr static func jmp0_impl = [](auto){
+        auto ptr = ++fthp->ip;
+        if (fthp->pop() == 0)
+            fthp->ip = *std::bit_cast<func **>(ptr) - 1;
     };
 
     constexpr static auto& dict1 = native_dict<
-          S{"_D"   }, [](auto) { fthp->push(std::bit_cast<cell>(fthp)); }, 0
-        , S{"SP"   }, [](auto) { fthp->push(std::bit_cast<cell>(fthp) + sizeof(cell)); }, 0
-        , S{"RP"   }, [](auto) { fthp->push(std::bit_cast<cell>(fthp) + 2 * sizeof(cell)); }, 0
-        , S{"IP"   }, [](auto) { fthp->push(std::bit_cast<cell>(fthp) + 3 * sizeof(cell)); }, 0
-        , S{"DP"   }, [](auto) { fthp->push(std::bit_cast<cell>(fthp) + 4 * sizeof(cell)); }, 0
-        , S{"STATE"}, [](auto) { fthp->push(std::bit_cast<cell>(fthp) + 7 * sizeof(cell)); }, 0
-        , S{"BASE" }, [](auto) { fthp->push(std::bit_cast<cell>(fthp) + 8 * sizeof(cell)); }, 0
-        , S{"DEPTH"}, [](auto) { fthp->push(std::distance(fthp->sp, fthp->dstack.end())); }, 0
-        , S{"UNUSED"}, [](auto) { fthp->push(sizeof(cell) * std::distance(fthp->here, fthp->dict.end())); }, 0
-        , S{"_LIT" }, lit_impl, 0
-        , S{","    }, comma, 0
-        , S{"SWAP" }, [](auto) { auto a = fthp->pop(); auto b = fthp->pop(); fthp->push(a, b); }, 0
-        , S{"DROP" }, [](auto) { fthp->pop(); }, 0
-        , S{"DUP"  }, [](auto) { fthp->push(fthp->top()); }, 0
-        , S{"ROT"  }, [](auto) { auto a = fthp->pop(); auto b = fthp->pop(); auto c = fthp->pop();
-            fthp->push(b, a, c); }, 0
+          S{"_D"   },  [](auto) { fthp->push(fthp); }, 0
+        , S{"CELL" },  [](auto) { fthp->push(sizeof(cell)); }, 0
+        , S{"_JMP" },  [](auto) { fthp->push(&jmp_impl); }, 0
+        , S{"_JMP0"},  [](auto) { fthp->push(&jmp0_impl); }, 0
+        , S{"DEPTH"},  [](auto) { fthp->push(std::distance(fthp->sp, fthp->dstack.end())); }, 0
+        , S{"_END" }, [](auto) { fthp->push(fthp->dict.end()); }, 0
+        , S{"_LIT" },  lit_impl, 0 // required by parser
+        , S{"SWAP" }, [](auto) { auto a = fthp->pop(); fthp->push(a, fthp->pop()); }, 0
         , S{"+"    }, [](auto) { fthp->top() += fthp->pop(); }, 0
         , S{"-"    }, [](auto) { fthp->top() -= fthp->pop(); }, 0
         , S{"*"    }, [](auto) { fthp->top() *= fthp->pop(); }, 0
-        , S{"M*"   }, [](auto) {
-            dcell a = fthp->pop();
-            a *= fthp->pop();
-            fthp->push(a, a >> (8 * sizeof(cell))); }, 0
-        , S{"UM*"   }, [](auto) {
-            daddr a = std::bit_cast<addr>(fthp->pop());
-            a *= std::bit_cast<addr>(fthp->pop());
-            fthp->push(a, a >> (8 * sizeof(addr))); }, 0
         , S{"/"    }, [](auto) { fthp->top() /= fthp->pop(); }, 0
         , S{"MOD"  }, [](auto) { fthp->top() %= fthp->pop(); }, 0
         , S{"AND"  }, [](auto) { fthp->top() &= fthp->pop(); }, 0
         , S{"OR"   }, [](auto) { fthp->top() |= fthp->pop(); }, 0
         , S{"XOR"  }, [](auto) { fthp->top() ^= fthp->pop(); }, 0
         , S{"LSHIFT"}, [](auto) { fthp->top() <<= fthp->pop(); }, 0
-        , S{"RSHIFT"}, [](auto) {
-            const auto shift = fthp->pop();
-            addr val = fthp->pop();
-            val >>= shift;
-            fthp->push(val); }, 0
-        , S{"["    }, [](auto) { fthp->compiling = false; }, word_base::immediate
-        , S{"]"    }, [](auto) { fthp->compiling = true; }, 0
-        , S{"IMMEDIATE"}, [](auto) { const_cast<word_base *>(fthp->next)->make_immediate(); }, 0
-        , S{"LITERAL"}, [](auto x) {
-            if (fthp->compiling) {
-                *fthp->here++ = std::bit_cast<cell>(&lit_impl);
-                *fthp->here++ = fthp->pop();
-            } else {
-                lit_impl(x);
-            } }, word_base::immediate
-        , S{"@"    }, [](auto) { fthp->top() = *std::bit_cast<cell *>(fthp->top()); }, 0
-        , S{"!"    }, [](auto) { auto p = fthp->pop(); *std::bit_cast<cell *>(p) = fthp->pop(); }, 0
-        , S{"C@"   }, [](auto) { fthp->top() = *std::bit_cast<char *>(fthp->top()); }, 0
-        , S{"C!"   }, [](auto) { auto p = fthp->pop(); *std::bit_cast<char *>(p) = fthp->pop(); }, 0
+        , S{"RSHIFT"}, [](auto) { fthp->template top<addr>() >>= fthp->pop(); }, 0
+        , S{"M*"   }, [](auto) {
+            dcell a = fthp->pop(); a *= fthp->pop();
+            fthp->push(a, a >> (8 * sizeof(cell))); }, 0
+        , S{"UM*"   }, [](auto) {
+            daddr a = fthp->template pop<addr>();
+            a *= fthp->template pop<addr>();
+            fthp->push(a, a >> (8 * sizeof(addr))); }, 0
+        , S{"@"    }, [](auto) { fthp->top() = *fthp->template top<cell *>(); }, 0
+        , S{"!"    }, [](auto) { auto p = fthp->template pop<cell *>(); *p = fthp->pop(); }, 0
+        , S{"C@"   }, [](auto) { fthp->top() = *fthp->template top<char *>(); }, 0
+        , S{"C!"   }, [](auto) { auto p = fthp->template pop<char *>(); *p = fthp->pop(); }, 0
         , S{"="    }, [](auto) { auto v = fthp->pop(); fthp->top() = -(fthp->top() == v); }, 0
         , S{"<"    }, [](auto) { auto v = fthp->pop(); fthp->top() = -(fthp->top() < v); }, 0
         , S{"U<"    }, [](auto) {
-            addr v = fthp->pop();
-            addr w = fthp->pop();
+            auto v = fthp->template pop<addr>();
+            auto w = fthp->template pop<addr>();
             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));
             fthp->rpush(d);
-            *fthp->here++ = std::bit_cast<cell>(prologue); }, 0
-        , S{";"    }, [](auto) {
-            *fthp->here++ = 0;
-            fthp->next = std::bit_cast<word_base *>(fthp->rpop());
-            fthp->compiling = false; }, word_base::immediate
-        , S{"\\"   }, [](auto) { fthp->sourcei = std::string_view::npos; }, word_base::immediate
-        , S{"CELL" }, [](auto) { fthp->push(sizeof(cell)); }, 0
-        , S{"_JMP" }, [](auto) {
-            auto ptr = ++fthp->ip;
-            fthp->ip = *std::bit_cast<func **>(ptr) - 1; }, 0
-        , S{"_JMP0"}, [](auto) {
-            auto ptr = ++fthp->ip;
-            if (fthp->pop() == 0)
-                fthp->ip = *std::bit_cast<func **>(ptr) - 1; }, 0
-        , S{"CHARS"}, [](auto) {}, 0
-        , S{"POSTPONE"}, [](auto) {
-            fthp->template assert<error::compile_only_word>(fthp->compiling);
-            auto w = fthp->parse();
-            auto g = fthp->get(w);
-            fthp->template assert<error::word_not_found>(g.has_value());
-
-            if ((*g)->is_immediate()) {
-                *fthp->here++ = std::bit_cast<cell>((*g)->body());
-            } else {
-                *fthp->here++ = std::bit_cast<cell>(&lit_impl);
-                *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{">IN"}, [](auto) { fthp->push(std::bit_cast<cell>(&fthp->sourcei)); }, 0
-        , S{"KEY"}, [](auto) {
-            if (fthp->sourcei != std::string_view::npos)
-                fthp->push(fthp->source[fthp->sourcei++]);
-            else
-                fthp->push(0); }, 0
-        , S{"EVALUATE"}, [](auto) {
-            const auto u = std::bit_cast<addr>(fthp->pop());
-            const auto caddr = std::bit_cast<const char *>(fthp->pop());
-            const auto olds = fthp->source;
-            const auto oldi = fthp->sourcei;
-            fthp->parse_line({caddr, u});
-            fthp->source = olds;
-            fthp->sourcei = oldi; }, 0
+            fthp->comma(prologue); }, 0
+        , S{"_PARSE"}, [](auto) {
+            auto w = fthp->parse(); fthp->push(w.data(), w.size()); }, 0
+        , S{"_GET"}, [](auto) {
+            auto u = fthp->template pop<addr>();
+            auto caddr = fthp->template pop<char *>();
+            auto g = fthp->get({caddr, u});
+            fthp->push(g.has_value() ? *g : nullptr); }, 0
+        , S{"_eval"}, [](auto) {
+            auto u = fthp->template pop<addr>();
+            auto caddr = fthp->template pop<char *>();
+            fthp->parse_line({caddr, u}); }, 0
     >::word;
+
     constexpr static auto& dict2 = comp_dict<prologue, &dict1
         //, S{"*/MOD"  }, S{">R M* R> SM/REM"}, 0
+        , S{"unused" }, S{"_end here -"}, 0
+        , S{"evaluate"}, S{"tib @ >in @ 2>r _eval 2r> >in ! tib !"}, 0
+        , S{"if"     }, S{"_jmp0 , here 0 ,"}, word_base::immediate
+        , S{"then"   }, S{"here swap !"}, word_base::immediate
+        , S{"else"   }, S{"_jmp , here 0 , swap here swap !"}, word_base::immediate
         , 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{">XT"    }, S{"CELL+ DUP @ 127 AND + CELL+"}, 0
+        , 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
         , S{"DECIMAL"}, S{"10 BASE !"}, 0
@@ -382,26 +359,17 @@ constexpr auto initialize()
         , S{"C,"    }, S{"HERE C! 1 ALLOT"}, 0
         , S{"EXIT" },  S{"0 ,"}, word_base::immediate
         , S{"ALLOT" }, S{"DP +!"}, 0
-        , S{"+!"    }, S{"DUP >R SWAP R> @ + SWAP !"}, 0
         , S{"2SWAP" }, S{"ROT >R ROT R>"}, 0
         , S{"2DUP"  }, S{"OVER OVER"}, 0
         , S{"2OVER" }, S{"3 PICK 3 PICK"}, 0
         , S{"2R>"   }, S{"R> R> R> ROT >R SWAP"}, 0
         , S{"2>R"   }, S{"R> -ROT SWAP >R >R >R"}, 0
         , S{"R@"    }, S{"R> R> DUP >R SWAP >R"}, 0
-        , S{">R"    }, S{"RP@ CELL - RP ! RP@ CELL+ @ RP@ ! RP@ CELL+ !"}, 0
-        , S{"R>"    }, S{"RP@ @ RP@ CELL+ RP ! RP@ @ SWAP RP@ !"}, 0
+        , S{"NIP"   }, S{"SWAP DROP"}, 0
         , S{"OVER"  }, S{"1 PICK"}, 0
         , S{"PICK"  }, S{"1 + CELLS SP@ + @"}, 0
-        , S{"SP@"   }, S{"SP @ CELL+"}, 0
-        , S{"RP@"   }, S{"RP @ CELL+"}, 0
-        , S{"HERE"  }, S{"DP @"}, 0
-        , S{"LATEST"}, S{"_D @"}, 0
         , S{"1-"    }, S{"1 -" }, 0
         , S{"1+"    }, S{"1 +" }, 0
-        , S{"CELL+" }, S{"CELL +"}, 0
-        , S{"CELLS" }, S{"CELL *"}, 0
-        , S{"CHAR+" }, S{"1 +" }, 0
         , S{"-ROT"  }, S{"ROT ROT"}, 0
         , S{"2DROP" }, S{"DROP DROP"}, 0
         , S{"D>S"   }, S{"DROP"}, 0
@@ -415,8 +383,36 @@ constexpr auto initialize()
         , S{"NEGATE"}, S{"-1 *"}, 0
         , S{"2*"    }, S{"2 *"}, 0
         , S{"BL"    }, S{"32"}, 0
+        , S{"IMMEDIATE"}, S{"256 LATEST CELL+ +!"}, 0
+        , S{";"     }, S{"0 , R> R> _D ! >R FALSE STATE !"}, word_base::immediate
+        , S{","     }, S{"HERE ! CELL DP +!"}, 0
+        , S{"+!"    }, S{"DUP @ ROT + SWAP !"}, 0
+        , S{"ROT"   }, S{">R SWAP R> SWAP"}, 0
+        , S{">R"    }, S{"RP@ CELL - RP ! RP@ CELL+ @ RP@ ! RP@ CELL+ !"}, 0
+        , S{"R>"    }, S{"RP@ @ RP@ CELL+ RP ! RP@ @ SWAP RP@ !"}, 0
+        , S{"DUP"   }, S{"SP@ @"}, 0
+        , S{"DROP"  }, S{"SP@ CELL+ SP !"}, 0
+        , S{"\\"    }, S{"-1 >IN !"}, word_base::immediate
+        , S{"["     }, S{"FALSE STATE !"}, word_base::immediate
+        , S{"]"     }, S{"TRUE STATE !"}, 0
         , S{"FALSE" }, S{"0"}, 0
         , S{"TRUE"  }, S{"-1"}, 0
+        , S{"SP@"   }, S{"SP @ CELL+"}, 0
+        , S{"RP@"   }, S{"RP @ CELL+"}, 0
+        , S{"HERE"  }, S{"DP @"}, 0
+        , S{"LATEST"}, S{"_D @"}, 0
+        , S{"SP"    }, S{"_D CELL+"}, 0
+        , 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
+        , S{"CHAR+" }, S{"1 +"}, 0
+        , S{"CHARS" }, S{""}, 0
+        , S{"CELL+" }, S{"CELL +"}, 0
+        , S{"CELLS" }, S{"CELL *"}, 0
     >::word;
 
     return &dict2;

sforth/types.hpp

@@ -119,6 +119,8 @@ struct word_list
         sourcei = sv.find_first_not_of(" \t\r\n", e);
         return word;
     }
+
+    std::optional<const word_base *> lookup(auto xt) const;
 };
 
 struct word_base : public word_list
@@ -159,6 +161,16 @@ std::optional<const word_base *> word_list::get(std::string_view sv) const
     return {};
 }
 
+std::optional<const word_base *> word_list::lookup(auto xt) const
+{
+    for (auto lt = next; lt; lt = lt->next) {
+        if (std::bit_cast<addr>(lt->body()) < std::bit_cast<addr>(xt))
+            return lt;
+    }
+
+    return {};
+}
+
 template<unsigned N>
 struct S {
     char data[N];