initial upload

7 files changed, 500 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;
+}
+
diff --git a/source/core.hpp b/source/core.hpp
new file mode 100644
index 0000000..a134804
--- /dev/null
+++ b/source/core.hpp
@@ -0,0 +1,48 @@
+// 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.
+
+#ifndef CORE_HPP
+#define CORE_HPP
+
+#include "types.hpp"
+
+extern void getinput();
+
+constexpr auto fexit = WordWrap<[] {
+    extern FuncList IP;
+    extern Cell *RP;
+    IP = reinterpret_cast<FuncList>(*RP--);
+}>();
+
+void jump(FuncList ip);
+void jumper();
+void compileliteral();
+
+bool haskey();
+void addkey(int k);
+
+int key();
+Cell *comma(Cell n);
+Addr aligned(Addr addr);
+void align();
+void word();
+void colon();
+void semic();
+void tick();
+
+#endif // CORE_HPP
+
diff --git a/source/parse.cpp b/source/parse.cpp
new file mode 100644
index 0000000..012d708
--- /dev/null
+++ b/source/parse.cpp
@@ -0,0 +1,70 @@
+// 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 "types.hpp"
+
+#include <cctype>
+#include <cstdlib>
+
+static void parseword(const char *start, const char *end)
+{
+    if (start != end) {
+        if (auto word = find(start, end - start); word) {
+            if (!word->immediate() && STATE) {
+                comma((Cell)word->list);
+            } else {
+                execute1(word);
+            }
+        } else if (isdigit(*start)) {
+            *++SP = std::atoi(start);
+
+            if (STATE)
+                compileliteral();
+        }
+    }
+}
+
+void parseSource()
+{
+    auto start = (char *)DICT[DIdxSource];
+    auto end = start;
+
+    while (haskey()) {
+        end = (char *)++DICT[DIdxSource];
+        --DICT[DIdxSrcLen];
+
+        if (isspace(*end)) {
+            parseword(start, end);
+            start = (char *)(DICT[DIdxSource] + 1);
+        }
+    }
+
+    if (start != end)
+        parseword(start, end);
+}
+
+void parse()
+{
+    DICT[DIdxSource] = (Cell)&DICT[DIdxBegin];
+    DICT[DIdxSrcLen] = 0;
+    getinput();
+
+    parseSource();
+}
+
diff --git a/source/parse.hpp b/source/parse.hpp
new file mode 100644
index 0000000..7bf0c27
--- /dev/null
+++ b/source/parse.hpp
@@ -0,0 +1,18 @@
+// 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.
+
+void parse();
diff --git a/source/state.cpp b/source/state.cpp
new file mode 100644
index 0000000..27d624c
--- /dev/null
+++ b/source/state.cpp
@@ -0,0 +1,71 @@
+// 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 <csetjmp>
+#include <cstring>
+
+//static std::jmp_buf jmpbuf;
+Cell *SP = DICT.data() + DICT.size() - DS;
+Cell *RP = DICT.data() + DICT.size() - DS - RS;
+FuncList IP = nullptr;
+
+std::array<Cell, 2048> DICT;
+
+Cell& HERE   = DICT[DIdxHere];
+Cell& LATEST = DICT[DIdxLatest];
+Cell& STATE  = DICT[DIdxState];
+
+void executor(FuncList *list)
+{
+    /*if (setjmp(jmpbuf) == 0)*/ {
+        // Execute the first bit of "word".
+        // If it is a "WordWrap", it will exit without changing IP.
+        // If it is a defined word, IP will be set to the word's body.
+        auto ip = (FuncList)list;
+        auto po = (void (**)(FuncList))*ip;
+        // Pass in po's location so the call can fetch beyond itself.
+        (*po)((FuncList)*ip);
+
+        while (IP) {
+            ++IP;
+            auto po = (void (**)(FuncList))*IP;
+            (*po)((FuncList)*IP);
+        }
+
+        //std::longjmp(jmpbuf, 1);
+    }
+}
+
+void execute1(Word *word)
+{
+    IP = 0;
+    executor(&word->list);
+}
+
+Word *find(const char *s, int len)
+{
+    for (auto w = (Word *)LATEST; w; w = w->link) {
+        if (len == (int)strlen(w->name) && strncmp(s, w->name, len) == 0)
+            return w;
+    }
+
+    return nullptr;
+}
+
diff --git a/source/state.hpp b/source/state.hpp
new file mode 100644
index 0000000..91ce12f
--- /dev/null
+++ b/source/state.hpp
@@ -0,0 +1,57 @@
+// 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.
+
+#ifndef STATE_HPP
+#define STATE_HPP
+
+#include "types.hpp"
+
+constexpr Addr DS = 16;
+constexpr Addr RS = 16;
+
+constexpr Addr DIdxBase   = 0;
+constexpr Addr DIdxHere   = 1;
+constexpr Addr DIdxLatest = 2;
+constexpr Addr DIdxState  = 3;
+constexpr Addr DIdxSource = 4;
+constexpr Addr DIdxSrcLen = 5;
+constexpr Addr DIdxInBuf  = 6;
+constexpr Addr DIdxBegin  = DIdxInBuf + 80 * sizeof(char);
+
+extern std::array<Cell, 2048> DICT;
+
+extern Cell& HERE;
+extern Cell& LATEST;
+extern Cell& STATE;
+
+extern Cell *SP;
+extern Cell *RP;
+extern FuncList IP;
+
+inline void initialize(const auto& wordset)
+{
+    LATEST = (Cell)wordset.latest;
+    HERE = (Cell)&DICT[DIdxBegin];
+    STATE = 0;
+}
+
+void executor(FuncList *list);
+void execute1(Word *word);
+Word *find(const char *s, int len);
+
+#endif // STATE_HPP
+
diff --git a/source/types.hpp b/source/types.hpp
new file mode 100644
index 0000000..03e9f2a
--- /dev/null
+++ b/source/types.hpp
@@ -0,0 +1,85 @@
+// 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.
+
+#ifndef TYPES_HPP
+#define TYPES_HPP
+
+#include <array>
+#include <cstddef>
+#include <cstdint>
+
+using Cell = intptr_t;
+using Addr = uintptr_t;
+using Func = void (*)();
+using FuncList = Func const *;
+
+static_assert(sizeof(Cell) == sizeof(Addr));
+static_assert(sizeof(Cell) == sizeof(Func));
+
+struct Word {
+    FuncList list;
+    const char *name;
+    Word *link = nullptr;
+    Cell imm = 0;
+
+    constexpr Word(const char *n, FuncList l):
+        list(l), name(n) {}
+
+    constexpr Word& markImmediate() noexcept {
+        imm = -1;
+        return *this;
+    }
+
+    constexpr bool immediate() const noexcept {
+        return imm;
+    }
+};
+
+static_assert(offsetof(Word, list) == 0);
+static_assert(offsetof(Word, name) == 1 * sizeof(Cell));
+static_assert(offsetof(Word, link) == 2 * sizeof(Cell));
+static_assert(offsetof(Word, imm)  == 3 * sizeof(Cell));
+static_assert(sizeof(Word)         == 4 * sizeof(Cell));
+
+template<typename... Words>
+struct WordSet
+{
+    std::array<Word, sizeof...(Words)> words;
+    Word *latest;
+
+    constexpr WordSet(Words... ws):
+        words {ws...}
+    {
+        auto it = words.begin();
+        while (++it != words.end())
+            it->link = it - 1;
+
+        latest = &*words.rbegin();
+    }
+};
+
+template<auto... funcs>
+auto WordWrap = [] {
+    constexpr static Func list[1] = {
+        +[] { (funcs(), ...); }
+    };
+
+    return list;
+};
+
+#endif // TYPES_HPP
+