diff --git a/core.fth b/core.fth index 768f195..fcd4375 100644 --- a/core.fth +++ b/core.fth @@ -17,13 +17,13 @@ : repeat ['] _jmp , , if postpone then then ; immediate : until ['] _jmp0 , , drop ; immediate -: do ['] _lit , here 0 , ['] >r , postpone 2>r here ; immediate +: do ['] literal , 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 , ['] _lit , 0 , + ['] rot , ['] rot , ['] xor , ['] and , ['] literal , 0 , ['] < , ['] _jmp0 , , postpone unloop here 1 cells - swap ! ; immediate : loop postpone 2r> ['] 1+ , ['] 2dup , @@ -82,3 +82,11 @@ >r 2dup c! char+ r> 1- repeat 2drop drop ; +: >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 ; diff --git a/sforth/forth.hpp b/sforth/forth.hpp index 78ced3d..ecdce3d 100644 --- a/sforth/forth.hpp +++ b/sforth/forth.hpp @@ -244,25 +244,23 @@ constexpr auto initialize() }; constexpr static auto& dict1 = native_dict< - S{"_D" }, [](auto) { fthp->push(std::bit_cast(fthp)); }, 0 - , S{"SP" }, [](auto) { fthp->push(std::bit_cast(fthp) + sizeof(cell)); }, 0 - , S{"RP" }, [](auto) { fthp->push(std::bit_cast(fthp) + 2 * sizeof(cell)); }, 0 - , S{"IP" }, [](auto) { fthp->push(std::bit_cast(fthp) + 3 * sizeof(cell)); }, 0 - , S{"DP" }, [](auto) { fthp->push(std::bit_cast(fthp) + 4 * sizeof(cell)); }, 0 - , S{"STATE"}, [](auto) { fthp->push(std::bit_cast(fthp) + 7 * sizeof(cell)); }, 0 - , S{"BASE" }, [](auto) { fthp->push(std::bit_cast(fthp) + 8 * sizeof(cell)); }, 0 - , S{"DEPTH"}, [](auto) { fthp->push(std::distance(fthp->sp, fthp->dstack.end())); }, 0 + S{"_D" }, [](auto) { fthp->push(std::bit_cast(fthp)); }, 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{"+" }, [](auto) { fthp->top() += fthp->pop(); }, 0 - , S{"-" }, [](auto) { fthp->top() -= fthp->pop(); }, 0 - , S{"*" }, [](auto) { fthp->top() *= fthp->pop(); }, 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{"LSHIFT"}, [](auto) { fthp->top() <<= fthp->pop(); }, 0 + , S{"RSHIFT"}, [](auto) { + const auto shift = fthp->pop(); + fthp->push(static_cast(fthp->pop()) >> shift); }, 0 , S{"M*" }, [](auto) { dcell a = fthp->pop(); a *= fthp->pop(); @@ -271,20 +269,6 @@ constexpr auto initialize() daddr a = std::bit_cast(fthp->pop()); a *= std::bit_cast(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(fthp->next)->make_immediate(); }, 0 , S{"LITERAL"}, [](auto x) { if (fthp->compiling) { *fthp->here++ = std::bit_cast(&lit_impl); @@ -318,11 +302,6 @@ constexpr auto initialize() auto d = std::bit_cast(fthp->begin_def(w)); fthp->rpush(d); *fthp->here++ = std::bit_cast(prologue); }, 0 - , S{";" }, [](auto) { - *fthp->here++ = 0; - fthp->next = std::bit_cast(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; @@ -331,7 +310,6 @@ constexpr auto initialize() auto ptr = ++fthp->ip; if (fthp->pop() == 0) fthp->ip = *std::bit_cast(ptr) - 1; }, 0 - , S{"CHARS"}, [](auto) {}, 0 , S{"POSTPONE"}, [](auto) { fthp->template assert(fthp->compiling); auto w = fthp->parse(); @@ -351,7 +329,6 @@ constexpr auto initialize() len++; fthp->push(std::bit_cast(fthp->source)); fthp->push(len); }, 0 - , S{">IN"}, [](auto) { fthp->push(std::bit_cast(&fthp->sourcei)); }, 0 , S{"KEY"}, [](auto) { if (fthp->sourcei != std::string_view::npos) fthp->push(fthp->source[fthp->sourcei++]); @@ -371,7 +348,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{">XT" }, S{"CELL+ DUP @ 127 AND + CELL+"}, 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,35 @@ 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{">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;