From 221419aed946b3fa5665207a299fa4b826c67cc2 Mon Sep 17 00:00:00 2001
From: Clyne Sullivan <clyne@bitgloo.com>
Date: Tue, 26 Nov 2024 08:13:01 -0500
Subject: [PATCH] add lots more words

---
 core.fth  | 44 +++++++++++++++++++++++++++++++++++++++++---
 forth.hpp | 20 ++++++++++++++++----
 main.cpp  |  2 +-
 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;
             }
         }