aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorClyne Sullivan <clyne@bitgloo.com>2024-11-26 08:13:01 -0500
committerClyne Sullivan <clyne@bitgloo.com>2024-11-26 08:13:01 -0500
commit221419aed946b3fa5665207a299fa4b826c67cc2 (patch)
treee3b43fa0251278dbaf8054949c8121dbee443c6f
parentb40fba6baf84dcf8b6d4f108418e55f0da7b0730 (diff)
add lots more words
-rw-r--r--core.fth44
-rw-r--r--forth.hpp20
-rw-r--r--main.cpp2
3 files changed, 58 insertions, 8 deletions
diff --git a/core.fth b/core.fth
index ed28e1f..b325e58 100644
--- a/core.fth
+++ b/core.fth
@@ -32,18 +32,56 @@
: -rot rot rot ;
: over 1 pick ;
+: 2drop drop drop ;
+: 2dup over over ;
+: 2over 3 pick 3 pick ;
+: 2swap rot >r rot r> ;
+
: +! dup >r swap r> @ + swap ! ;
: allot dp +! ;
: , here ! cell allot ;
+: c, here c! 1 allot ;
: ['] ' [ ' literal , ] ; immediate
-: 1+ 1 + ;
-: 1- 1 - ;
-
: if ['] _jmp0 , here 0 , ; immediate
: then 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 ! ;
: hex 16 base ! ;
diff --git a/forth.hpp b/forth.hpp
index 4aad263..cc6c679 100644
--- a/forth.hpp
+++ b/forth.hpp
@@ -147,7 +147,7 @@ struct forth
}
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);
assert<error::parse_error>(!name.empty());
@@ -242,9 +242,12 @@ struct forth
auto f_minus = [](auto) { fth.top() -= fth.pop(); };
auto f_times = [](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_bitor = [](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_rbrac = [](auto) { fth.compiling = true; };
auto f_imm = [](auto) {
@@ -262,6 +265,10 @@ struct forth
auto f_poke = [](auto) {
auto [p, v] = fth.pop<2>();
*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_drop = [](auto) { fth.pop(); };
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_times {"*", f_times, &w_minus};
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_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_imm {"immediate", f_imm, &w_rbrac};
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_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_dup {"dup", f_dup, &w_drop};
constexpr static word w_rot {"rot", f_rot, &w_dup};
diff --git a/main.cpp b/main.cpp
index 2788b49..1b67542 100644
--- a/main.cpp
+++ b/main.cpp
@@ -60,7 +60,7 @@ bool parse_stream(forth *fth, std::istream& str, bool say_okay)
try {
fth->parse_line(line);
} catch (forth::error e) {
- std::cerr << fth->error_string(e);
+ std::cerr << fth->error_string(e) << " in " << line << std::endl;
continue;
}
}