From 31dd2ee7c8ccc4153e12a6cf3a5430736daf815f Mon Sep 17 00:00:00 2001 From: Clyne Sullivan Date: Sat, 4 Jan 2025 08:15:19 -0500 Subject: [PATCH] literal, postpone to forth and more --- core.fth | 14 ++++---- sforth/forth.hpp | 91 ++++++++++++++++++------------------------------ 2 files changed, 41 insertions(+), 64 deletions(-) diff --git a/core.fth b/core.fth index c996d39..512334d 100644 --- 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 b86ce7d..7c79448 100644 --- 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(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(word, base); assert(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() >> shift); }, 0 + , S{"RSHIFT"}, [](auto) { fthp->template top() >>= 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(); a *= fthp->template pop(); 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(); }, 0 , S{"!" }, [](auto) { auto p = fthp->template pop(); *p = fthp->pop(); }, 0 , S{"C@" }, [](auto) { fthp->top() = *fthp->template top(); }, 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(); - const auto w = fthp->template pop(); + auto v = fthp->template pop(); + auto w = fthp->template pop(); fthp->push(-(w < v)); }, 0 , S{":" }, [](auto) { auto w = fthp->parse(); auto d = std::bit_cast(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(); - const auto caddr = fthp->template pop(); + auto u = fthp->template pop(); + auto caddr = fthp->template pop(); auto g = fthp->get({caddr, u}); fthp->push(g.has_value() ? *g : nullptr); }, 0 - , S{"POSTPONE"}, [](auto) { - fthp->template assert(fthp->compiling); - auto w = fthp->parse(); - auto g = fthp->get(w); - fthp->template assert(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(); - const auto caddr = fthp->template pop(); + auto u = fthp->template pop(); + auto caddr = fthp->template pop(); fthp->parse_line({caddr, u}); }, 0 >::word; constexpr static auto& dict2 = comp_dictR 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