literal, postpone to forth and more

diff --git a/core.fth b/core.fth
index c996d39d97f9e39a3a1e64e6fe3b9511fd7a92c0..512334df7c3c1cff6d41081ca53cdf7e7f50ef61 100644 (file)
--- a/core.fth
+++ b/core.fth
@@ -1,8 +1,7 @@
-: [']       ' postpone literal ; immediate
-
-\ : postpone  _parse _get
-\             dup cell+ @ 256 and if
-\             >xt , else ['] _lit , >xt , ['] , , then ; 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 ;
@@ -17,13 +16,13 @@
 : repeat    _jmp , , if postpone then then ; immediate
 : until     _jmp0 , , drop ; immediate
 
-: do        ['] literal , here 0 , ['] >r , postpone 2>r here ; immediate
+: do        ['] _lit , here 0 , ['] >r , postpone 2>r here ; immediate
 : unloop    postpone 2r> ['] 2drop , ['] r> , ['] drop , ; immediate
 : leave     postpone 2r> ['] 2drop , postpone exit ; immediate
 : +loop     ['] r> , ['] 2dup , ['] + ,
             postpone r@ ['] swap , ['] >r ,
             ['] - , ['] 2dup , ['] + , ['] over , ['] xor ,
-            ['] rot , ['] rot , ['] xor , ['] and , ['] literal , 0 ,
+            ['] rot , ['] rot , ['] xor , ['] and , ['] _lit , 0 ,
             ['] < , _jmp0 , ,
             postpone unloop here 1 cells - swap ! ; immediate
 : loop      postpone 2r> ['] 1+ , ['] 2dup ,
@@ -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

diff --git a/sforth/forth.hpp b/sforth/forth.hpp
index b86ce7d67a598b98c3f55b209f9239dce9972b5f..7c79448d9d7a9d055f909543ce1aa6db7228a16a 100644 (file)
--- a/sforth/forth.hpp
+++ b/sforth/forth.hpp
@@ -158,10 +158,14 @@ struct forth : public word_list
         return *rp++;
     }
 
-    void comma(CellSized auto v) {
+    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);
@@ -196,10 +200,13 @@ 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();
 
@@ -261,8 +268,6 @@ constexpr auto initialize()
         fthp->ip = fthp->rpop();
     };
 
-    constexpr static func comma = [](auto) { *fthp->here++ = fthp->pop(); };
-
     constexpr static func lit_impl = [](auto) {
         fthp->push(*++fthp->ip);
     };
@@ -280,37 +285,30 @@ constexpr auto initialize()
 
     constexpr static auto& dict1 = native_dict<
           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{"UNUSED"}, [](auto) { fthp->push(sizeof(cell) * std::distance(fthp->here, fthp->dict.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(); auto b = fthp->pop(); fthp->push(a, b); }, 0
-        , S{"+"    },  [](auto) { fthp->top() += 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{"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{"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{"/"    }, [](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();
-            fthp->push(fthp->template pop<addr>() >> shift); }, 0
+        , S{"RSHIFT"}, [](auto) { fthp->template top<addr>() >>= fthp->pop(); }, 0
         , S{"M*"   }, [](auto) {
-            dcell a = fthp->pop();
-            a *= fthp->pop();
+            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{"LITERAL"}, [](auto x) {
-            if (fthp->compiling) {
-                fthp->comma(&lit_impl);
-                fthp->comma(fthp->pop());
-            } else {
-                lit_impl(x);
-            } }, word_base::immediate
         , 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
@@ -318,51 +316,30 @@ constexpr auto initialize()
         , 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) {
-            const auto v = fthp->template pop<addr>();
-            const auto w = fthp->template pop<addr>();
+            auto v = fthp->template pop<addr>();
+            auto w = fthp->template pop<addr>();
             fthp->push(-(w < v)); }, 0
         , S{":"    }, [](auto) {
             auto w = fthp->parse();
             auto d = std::bit_cast<func *>(fthp->begin_def(w));
             fthp->rpush(d);
             fthp->comma(prologue); }, 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{"_PARSE"}, [](auto) {
-            auto w = fthp->parse();
-            fthp->push(w.data(), w.size()); }, 0
+            auto w = fthp->parse(); fthp->push(w.data(), w.size()); }, 0
         , S{"_GET"}, [](auto) {
-            const auto u = fthp->template pop<addr>();
-            const auto caddr = fthp->template pop<const char *>();
+            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{"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->comma((*g)->body());
-            } else {
-                fthp->comma(&lit_impl);
-                fthp->comma((*g)->body());
-                fthp->comma(&comma);
-            } }, word_base::immediate
-        , S{"KEY"}, [](auto) {
-            if (fthp->sourcei != std::string_view::npos)
-                fthp->push(fthp->source[fthp->sourcei++]);
-            else
-                fthp->push(0); }, 0
         , S{"_eval"}, [](auto) {
-            const auto u = fthp->template pop<addr>();
-            const auto caddr = fthp->template pop<const char *>();
+            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