1 files changed, 151 insertions, 0 deletions
diff --git a/source/core.cpp b/source/core.cpp
new file mode 100644
index 0000000..7daf1ae
--- /dev/null
+++ b/source/core.cpp
@@ -0,0 +1,151 @@
+// sprit-forth: A portable subroutine-threaded Forth.
+// Copyright (C) 2023  Clyne Sullivan <clyne@bitgloo.com>
+//
+// This library is free software; you can redistribute it and/or modify it
+// under the terms of the GNU Library General Public License as published by
+// the Free Software Foundation; either version 2 of the License, or (at your
+// option) any later version.
+//
+// This library is distributed in the hope that it will be useful, but WITHOUT
+// ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
+// FOR A PARTICULAR PURPOSE.  See the GNU Library General Public License for
+// more details.
+//
+// You should have received a copy of the GNU Library General Public License
+// along with this library; if not, write to the Free Software Foundation, Inc.,
+// 51 Franklin St, Fifth Floor, Boston, MA  02110-1301, USA.
+
+#include "core.hpp"
+#include "state.hpp"
+
+#include <cctype>
+
+void jump(FuncList ip)
+{
+    IP = ip - 1;
+}
+
+static auto literall = WordWrap<[] {
+    *++SP = (Cell)*++IP;
+}>();
+
+void compileliteral()
+{
+    comma((Cell)literall);
+    comma(*SP--);
+}
+
+bool haskey()
+{
+    return DICT[DIdxSrcLen] > 0;
+}
+
+void addkey(int k)
+{
+    --DICT[DIdxSource];
+    ++DICT[DIdxSrcLen];
+
+    auto ptr = reinterpret_cast<char *>(DICT[DIdxSource]);
+    *ptr = static_cast<char>(k);
+}
+
+int key()
+{
+    while (!haskey())
+        getinput();
+
+    auto ptr = reinterpret_cast<char *>(DICT[DIdxSource]);
+    ++DICT[DIdxSource];
+    --DICT[DIdxSrcLen];
+
+    return *ptr;
+}
+
+Cell *comma(Cell n)
+{
+    const auto ptr = reinterpret_cast<Cell *>(HERE);
+    *ptr = n;
+    HERE += sizeof(Cell);
+    return ptr;
+}
+
+Addr aligned(Addr addr)
+{
+    return (addr + (sizeof(Cell) - 1)) & ~(sizeof(Cell) - 1);
+}
+
+void align()
+{
+    HERE = aligned(HERE);
+}
+
+void word()
+{
+    int k;
+    do {
+        k = key();
+    } while (isspace(k));
+
+    char *ptr;
+    do {
+        ptr = reinterpret_cast<char *>(HERE);
+        *ptr = k;
+        ++HERE;
+
+        if (!haskey())
+            break;
+
+        k = key();
+    } while (!isspace(k));
+    addkey(k);
+    ptr = reinterpret_cast<char *>(HERE);
+    *ptr = '\0';
+    ++HERE;
+}
+
+void colon()
+{
+    align();
+    auto name = HERE;
+    word();
+    align();
+
+    comma(HERE + 4 * sizeof(Cell)); // exec ptr
+    comma(name); // name ptr
+    *++SP = (Cell)comma(0); // link (filled by latest)
+    comma(0); // immediate
+
+    comma((Cell)+[](FuncList *ip) {
+        ++ip;
+        *++RP = (Cell)IP;
+        jump((FuncList)*ip);
+    });
+    comma(HERE + sizeof(Cell));
+
+    STATE = -1;
+}
+
+void semic()
+{
+    comma((Cell)fexit);
+
+    auto link = (Cell *)*SP--;
+    *link = LATEST;
+    LATEST = (Cell)(link - 2);
+
+    STATE = 0;
+}
+
+// : ' bl word find drop ;
+void tick()
+{
+    auto name = (char *)HERE;
+    word();
+
+    int len = HERE - (Cell)name - 1;
+    auto word = find(name, len);
+    *++SP = (Cell)word;
+
+    HERE = (Cell)name;
+}
+