move more impl to forth; some util words

diff --git a/core.fth b/core.fth
index 768f195b46878926245a5ba221490e0fed508c8f..fcd437581092d391ab98cb39e97457a408a01c3e 100644 (file)
--- 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 78ced3da43fc3868dd5f33021e745ff29a34fb43..ecdce3dc0af0f6b63eb4baa8fa43bdc831665566 100644 (file)
--- 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<cell>(fthp)); }, 0
-        , S{"SP"   }, [](auto) { fthp->push(std::bit_cast<cell>(fthp) + sizeof(cell)); }, 0
-        , S{"RP"   }, [](auto) { fthp->push(std::bit_cast<cell>(fthp) + 2 * sizeof(cell)); }, 0
-        , S{"IP"   }, [](auto) { fthp->push(std::bit_cast<cell>(fthp) + 3 * sizeof(cell)); }, 0
-        , S{"DP"   }, [](auto) { fthp->push(std::bit_cast<cell>(fthp) + 4 * sizeof(cell)); }, 0
-        , S{"STATE"}, [](auto) { fthp->push(std::bit_cast<cell>(fthp) + 7 * sizeof(cell)); }, 0
-        , S{"BASE" }, [](auto) { fthp->push(std::bit_cast<cell>(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<cell>(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<addr>(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<addr>(fthp->pop());
             a *= std::bit_cast<addr>(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<word_base *>(fthp->next)->make_immediate(); }, 0
         , S{"LITERAL"}, [](auto x) {
             if (fthp->compiling) {
                 *fthp->here++ = std::bit_cast<cell>(&lit_impl);
@@ -318,11 +302,6 @@ constexpr auto initialize()
             auto d = std::bit_cast<func *>(fthp->begin_def(w));
             fthp->rpush(d);
             *fthp->here++ = std::bit_cast<cell>(prologue); }, 0
-        , S{";"    }, [](auto) {
-            *fthp->here++ = 0;
-            fthp->next = std::bit_cast<word_base *>(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<func **>(ptr) - 1; }, 0
-        , S{"CHARS"}, [](auto) {}, 0
         , S{"POSTPONE"}, [](auto) {
             fthp->template assert<error::compile_only_word>(fthp->compiling);
             auto w = fthp->parse();
@@ -351,7 +329,6 @@ constexpr auto initialize()
                 len++;
             fthp->push(std::bit_cast<cell>(fthp->source));
             fthp->push(len); }, 0
-        , S{">IN"}, [](auto) { fthp->push(std::bit_cast<cell>(&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;