add lots more words

main
Clyne 3 weeks ago
parent b40fba6baf
commit 221419aed9
Signed by: clyne
GPG Key ID: 1B74EE6C49C96795

@ -32,18 +32,56 @@
: -rot rot rot ; : -rot rot rot ;
: over 1 pick ; : over 1 pick ;
: 2drop drop drop ;
: 2dup over over ;
: 2over 3 pick 3 pick ;
: 2swap rot >r rot r> ;
: +! dup >r swap r> @ + swap ! ; : +! dup >r swap r> @ + swap ! ;
: allot dp +! ; : allot dp +! ;
: , here ! cell allot ; : , here ! cell allot ;
: c, here c! 1 allot ;
: ['] ' [ ' literal , ] ; immediate : ['] ' [ ' literal , ] ; immediate
: 1+ 1 + ;
: 1- 1 - ;
: if ['] _jmp0 , here 0 , ; immediate : if ['] _jmp0 , here 0 , ; immediate
: then here swap ! ; immediate : then here swap ! ; immediate
: else ['] _jmp , here 0 , swap here swap ! ; immediate : else ['] _jmp , here 0 , swap here swap ! ; immediate
: 2r> ['] r> , ['] r> , ['] swap , ; immediate
: 2>r ['] swap , ['] >r , ['] >r , ; immediate
: r@ ['] r> , ['] dup , ['] >r , ; immediate
: 2! swap over ! cell+ ! ;
: 2@ dup cell+ @ swap @ ;
: 0= 0 = ;
: 0< 0 < ;
: <= 2dup < >r = r> or ;
: > swap < ;
: <> = 0= ;
: 1+ 1 + ;
: 1- 1 - ;
: invert -1 xor ;
: negate -1 * ;
: 2* 2 * ;
: _msb [ 1 cell 8 * 1- lshift ] literal ;
: 2/ dup 1 rshift swap 0< if _msb or then ;
: ?dup dup if dup then ;
: abs dup 0< if negate then ;
: min 2dup <= if drop else swap drop then ;
: max 2dup <= if swap drop else drop then ;
: aligned cell 1- + cell 1- invert and ;
: align here dup aligned swap - allot ;
: cr 10 emit ;
: bl 32 ;
: space bl emit ;
\ : spaces begin dup 0 > while space 1- repeat drop ;
: decimal 10 base ! ; : decimal 10 base ! ;
: hex 16 base ! ; : hex 16 base ! ;

@ -147,7 +147,7 @@ struct forth
} }
forth& add(std::string_view name, func entry = nullptr) { forth& add(std::string_view name, func entry = nullptr) {
const auto namesz = (name.size() + 1 + sizeof(cell)) & ~(sizeof(cell) - 1); const auto namesz = (name.size() + 1 + sizeof(cell) - 1) & ~(sizeof(cell) - 1);
const auto size = (sizeof(word_base) + namesz) / sizeof(cell); const auto size = (sizeof(word_base) + namesz) / sizeof(cell);
assert<error::parse_error>(!name.empty()); assert<error::parse_error>(!name.empty());
@ -242,9 +242,12 @@ struct forth
auto f_minus = [](auto) { fth.top() -= fth.pop(); }; auto f_minus = [](auto) { fth.top() -= fth.pop(); };
auto f_times = [](auto) { fth.top() *= fth.pop(); }; auto f_times = [](auto) { fth.top() *= fth.pop(); };
auto f_divide = [](auto) { fth.top() /= fth.pop(); }; auto f_divide = [](auto) { fth.top() /= fth.pop(); };
auto f_mod = [](auto) { fth.top() %= fth.pop(); };
auto f_bitand = [](auto) { fth.top() &= fth.pop(); }; auto f_bitand = [](auto) { fth.top() &= fth.pop(); };
auto f_bitor = [](auto) { fth.top() |= fth.pop(); }; auto f_bitor = [](auto) { fth.top() |= fth.pop(); };
auto f_bitxor = [](auto) { fth.top() ^= fth.pop(); }; auto f_bitxor = [](auto) { fth.top() ^= fth.pop(); };
auto f_lshift = [](auto) { fth.top() <<= fth.pop(); };
auto f_rshift = [](auto) { fth.top() >>= fth.pop(); };
auto f_lbrac = [](auto) { fth.compiling = false; }; auto f_lbrac = [](auto) { fth.compiling = false; };
auto f_rbrac = [](auto) { fth.compiling = true; }; auto f_rbrac = [](auto) { fth.compiling = true; };
auto f_imm = [](auto) { auto f_imm = [](auto) {
@ -262,6 +265,10 @@ struct forth
auto f_poke = [](auto) { auto f_poke = [](auto) {
auto [p, v] = fth.pop<2>(); auto [p, v] = fth.pop<2>();
*reinterpret_cast<cell *>(p) = v; }; *reinterpret_cast<cell *>(p) = v; };
auto f_cpeek = [](auto) { fth.push(*reinterpret_cast<char *>(fth.pop())); };
auto f_cpoke = [](auto) {
auto [p, v] = fth.pop<2>();
*reinterpret_cast<char *>(p) = v; };
auto f_swap = [](auto) { auto [a, b] = fth.pop<2>(); fth.push(a, b); }; auto f_swap = [](auto) { auto [a, b] = fth.pop<2>(); fth.push(a, b); };
auto f_drop = [](auto) { fth.pop(); }; auto f_drop = [](auto) { fth.pop(); };
auto f_dup = [](auto) { fth.push(fth.top()); }; auto f_dup = [](auto) { fth.push(fth.top()); };
@ -299,16 +306,21 @@ struct forth
constexpr static word w_minus {"-", f_minus, &w_add}; constexpr static word w_minus {"-", f_minus, &w_add};
constexpr static word w_times {"*", f_times, &w_minus}; constexpr static word w_times {"*", f_times, &w_minus};
constexpr static word w_divide {"/", f_divide, &w_times}; constexpr static word w_divide {"/", f_divide, &w_times};
constexpr static word w_bitand {"and", f_bitand, &w_divide}; constexpr static word w_mod {"mod", f_mod, &w_divide};
constexpr static word w_bitand {"and", f_bitand, &w_mod};
constexpr static word w_bitor {"or", f_bitor, &w_bitand}; constexpr static word w_bitor {"or", f_bitor, &w_bitand};
constexpr static word w_bitxor {"xor", f_bitxor, &w_bitor}; constexpr static word w_bitxor {"xor", f_bitxor, &w_bitor};
constexpr static word w_lbrac {"[", f_lbrac, &w_bitxor, word_base::immediate}; constexpr static word w_lshift {"lshift", f_lshift, &w_bitxor};
constexpr static word w_rshift {"rshift", f_rshift, &w_lshift};
constexpr static word w_lbrac {"[", f_lbrac, &w_rshift, word_base::immediate};
constexpr static word w_rbrac {"]", f_rbrac, &w_lbrac}; constexpr static word w_rbrac {"]", f_rbrac, &w_lbrac};
constexpr static word w_imm {"immediate", f_imm, &w_rbrac}; constexpr static word w_imm {"immediate", f_imm, &w_rbrac};
constexpr static word w_lit {"literal", f_lit, &w_imm, word_base::immediate}; constexpr static word w_lit {"literal", f_lit, &w_imm, word_base::immediate};
constexpr static word w_peek {"@", f_peek, &w_lit}; constexpr static word w_peek {"@", f_peek, &w_lit};
constexpr static word w_poke {"!", f_poke, &w_peek}; constexpr static word w_poke {"!", f_poke, &w_peek};
constexpr static word w_swap {"swap", f_swap, &w_poke}; constexpr static word w_cpeek {"c@", f_cpeek, &w_poke};
constexpr static word w_cpoke {"c!", f_cpoke, &w_cpeek};
constexpr static word w_swap {"swap", f_swap, &w_cpoke};
constexpr static word w_drop {"drop", f_drop, &w_swap}; constexpr static word w_drop {"drop", f_drop, &w_swap};
constexpr static word w_dup {"dup", f_dup, &w_drop}; constexpr static word w_dup {"dup", f_dup, &w_drop};
constexpr static word w_rot {"rot", f_rot, &w_dup}; constexpr static word w_rot {"rot", f_rot, &w_dup};

@ -60,7 +60,7 @@ bool parse_stream(forth *fth, std::istream& str, bool say_okay)
try { try {
fth->parse_line(line); fth->parse_line(line);
} catch (forth::error e) { } catch (forth::error e) {
std::cerr << fth->error_string(e); std::cerr << fth->error_string(e) << " in " << line << std::endl;
continue; continue;
} }
} }

Loading…
Cancel
Save