add source
parent
c59b6bc9fe
commit
0969c1f245
GPG Key ID:
3267C8EBF3F9AFC7
@ -0,0 +1,2 @@
|
|||||||
|
.sw*
|
||||||
|
main
|
||||||
@ -0,0 +1,8 @@
|
|||||||
|
#CXX := clang++-19
|
||||||
|
CXXFLAGS += -O0 -std=c++23 -Wall -Wextra -Wpedantic -ggdb -g3
|
||||||
|
|
||||||
|
all: main
|
||||||
|
|
||||||
|
clean:
|
||||||
|
rm -f main
|
||||||
|
|
||||||
@ -0,0 +1,41 @@
|
|||||||
|
: cell 8 ;
|
||||||
|
: cell+ cell + ;
|
||||||
|
: cells cell * ;
|
||||||
|
: char+ 1 + ;
|
||||||
|
: chars ;
|
||||||
|
|
||||||
|
: state _d 7 cells + ;
|
||||||
|
: [ 0 state ! ; immediate
|
||||||
|
: ] -1 state ! ;
|
||||||
|
|
||||||
|
: sp _d ;
|
||||||
|
: rp [ _d cell+ ] literal ;
|
||||||
|
: dp [ _d 3 cells + ] literal ;
|
||||||
|
|
||||||
|
: sp@ sp @ ;
|
||||||
|
: rp@ rp @ cell+ ;
|
||||||
|
: ip [ _d cell+ cell+ ] literal ;
|
||||||
|
: here dp @ ;
|
||||||
|
: unused [ _d 8 cells + ] literal @ here - ;
|
||||||
|
: latest [ _d 4 cells + ] literal @ ;
|
||||||
|
|
||||||
|
: dup sp@ @ ;
|
||||||
|
: drop sp@ cell+ sp ! ;
|
||||||
|
: pick cells cell+ sp@ + @ ;
|
||||||
|
: >r rp@ cell - rp !
|
||||||
|
rp@ cell+ @ rp@ !
|
||||||
|
rp@ cell+ ! ;
|
||||||
|
: r> rp@ @
|
||||||
|
rp@ cell+ rp !
|
||||||
|
rp@ @ swap rp@ ! ;
|
||||||
|
: rot >r swap r> swap ;
|
||||||
|
: -rot rot rot ;
|
||||||
|
: over 1 pick ;
|
||||||
|
|
||||||
|
: +! dup >r swap r> @ + swap ! ;
|
||||||
|
: allot dp +! ;
|
||||||
|
: , here ! cell allot ;
|
||||||
|
|
||||||
|
: 1+ 1 + ;
|
||||||
|
: 1- 1 - ;
|
||||||
|
|
||||||
@ -0,0 +1,320 @@
|
|||||||
|
/// sforth, an implementation of forth
|
||||||
|
/// Copyright (C) 2024 Clyne Sullivan <clyne@bitgloo.com>
|
||||||
|
///
|
||||||
|
/// This program is free software: you can redistribute it and/or modify it
|
||||||
|
/// under the terms of the GNU General Public License as published by the Free
|
||||||
|
/// Software Foundation, either version 3 of the License, or (at your option)
|
||||||
|
/// any later version.
|
||||||
|
///
|
||||||
|
/// This program 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 General Public License for
|
||||||
|
/// more details.
|
||||||
|
///
|
||||||
|
/// You should have received a copy of the GNU General Public License along
|
||||||
|
/// with this program. If not, see <http://www.gnu.org/licenses/>.
|
||||||
|
|
||||||
|
#ifndef SFORTH_HPP
|
||||||
|
#define SFORTH_HPP
|
||||||
|
|
||||||
|
#include <algorithm>
|
||||||
|
#include <array>
|
||||||
|
#include <charconv>
|
||||||
|
#include <cstdint>
|
||||||
|
#include <cstddef>
|
||||||
|
#include <iterator>
|
||||||
|
#include <span>
|
||||||
|
#include <string_view>
|
||||||
|
#include <tuple>
|
||||||
|
#include <utility>
|
||||||
|
|
||||||
|
struct forth
|
||||||
|
{
|
||||||
|
using cell = std::intptr_t;
|
||||||
|
using addr = std::uintptr_t;
|
||||||
|
using func = void (*)(void *);
|
||||||
|
|
||||||
|
static constexpr bool enable_exceptions = true;
|
||||||
|
static constexpr int data_size = 16;
|
||||||
|
static constexpr int return_size = 16;
|
||||||
|
|
||||||
|
static constexpr auto npos = std::string_view::npos;
|
||||||
|
|
||||||
|
enum class error {
|
||||||
|
init_error,
|
||||||
|
parse_error,
|
||||||
|
execute_error,
|
||||||
|
dictionary_overflow,
|
||||||
|
word_not_found,
|
||||||
|
stack_underflow,
|
||||||
|
stack_overflow,
|
||||||
|
return_stack_underflow,
|
||||||
|
return_stack_overflow,
|
||||||
|
compile_only_word
|
||||||
|
};
|
||||||
|
|
||||||
|
template<error Err>
|
||||||
|
static inline void assert(bool condition) {
|
||||||
|
if constexpr (enable_exceptions) {
|
||||||
|
if (!condition)
|
||||||
|
throw Err;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
struct word_base {
|
||||||
|
static constexpr addr immediate = 1 << 8;
|
||||||
|
|
||||||
|
word_base *next;
|
||||||
|
addr flags_len;
|
||||||
|
|
||||||
|
auto name() const -> std::string_view {
|
||||||
|
return {reinterpret_cast<const char *>(this + 1)};
|
||||||
|
}
|
||||||
|
|
||||||
|
auto body() -> func * {
|
||||||
|
auto ptr = reinterpret_cast<std::uint8_t *>(this + 1) + (flags_len & 0xFF);
|
||||||
|
return reinterpret_cast<func *>(ptr);
|
||||||
|
}
|
||||||
|
};
|
||||||
|
|
||||||
|
void push(cell v) {
|
||||||
|
assert<error::stack_overflow>(sp != dstack.begin());
|
||||||
|
*--sp = v;
|
||||||
|
}
|
||||||
|
|
||||||
|
void push(cell v, auto... vs) {
|
||||||
|
push(v); (push(vs), ...);
|
||||||
|
}
|
||||||
|
|
||||||
|
void rpush(func *v) {
|
||||||
|
assert<error::return_stack_overflow>(rp != rstack.begin());
|
||||||
|
*--rp = reinterpret_cast<cell>(v);
|
||||||
|
}
|
||||||
|
|
||||||
|
cell& top() {
|
||||||
|
assert<error::stack_underflow>(sp != dstack.end());
|
||||||
|
return *sp;
|
||||||
|
}
|
||||||
|
|
||||||
|
cell pop() {
|
||||||
|
assert<error::stack_underflow>(sp != dstack.end());
|
||||||
|
auto ret = *sp;
|
||||||
|
*sp++ = -1;
|
||||||
|
return ret;//*sp++;
|
||||||
|
}
|
||||||
|
|
||||||
|
auto rpop() -> func * {
|
||||||
|
assert<error::return_stack_underflow>(rp != rstack.end());
|
||||||
|
auto ret = reinterpret_cast<func *>(*rp);
|
||||||
|
*rp++ = -1;
|
||||||
|
return ret;
|
||||||
|
}
|
||||||
|
|
||||||
|
template<int N>
|
||||||
|
auto pop() {
|
||||||
|
static_assert(N > 0, "pop<N>() with N <= 0");
|
||||||
|
|
||||||
|
auto t = std::tuple {pop()};
|
||||||
|
if constexpr (N > 1)
|
||||||
|
return std::tuple_cat(t, pop<N - 1>());
|
||||||
|
else
|
||||||
|
return t;
|
||||||
|
}
|
||||||
|
|
||||||
|
forth& add(std::string_view name, func entry = nullptr) {
|
||||||
|
const auto namesz = (name.size() + 1 + sizeof(cell)) & ~(sizeof(cell) - 1);
|
||||||
|
const auto size = (sizeof(word_base) + namesz) / sizeof(cell);
|
||||||
|
|
||||||
|
assert<error::parse_error>(!name.empty());
|
||||||
|
//assert<error::dictionary_overflow>(state->here + size < &dictionary.back());
|
||||||
|
|
||||||
|
const auto h = std::exchange(here, here + size);
|
||||||
|
auto w = new (h) word_base (nullptr, namesz);
|
||||||
|
w->next = std::exchange(latest, w);
|
||||||
|
std::copy(name.begin(), name.end(),
|
||||||
|
reinterpret_cast<char *>(h) + sizeof(word_base));
|
||||||
|
if (entry)
|
||||||
|
*here++ = reinterpret_cast<cell>(entry);
|
||||||
|
return *this;
|
||||||
|
}
|
||||||
|
|
||||||
|
forth& make_immediate() {
|
||||||
|
latest->flags_len |= word_base::immediate;
|
||||||
|
return *this;
|
||||||
|
}
|
||||||
|
|
||||||
|
void parse_line(std::string_view sv) {
|
||||||
|
source = sv.data();
|
||||||
|
sourcei = sv.find_first_not_of(" \t\r\n");
|
||||||
|
|
||||||
|
while (sourcei != npos) {
|
||||||
|
const auto word = parse();
|
||||||
|
|
||||||
|
if (auto ent = get(word); !ent) {
|
||||||
|
cell n;
|
||||||
|
const auto [p, e] = std::from_chars(word.cbegin(), word.cend(), n);
|
||||||
|
|
||||||
|
assert<error::word_not_found>(e == std::errc() && p == word.cend());
|
||||||
|
|
||||||
|
push(n);
|
||||||
|
|
||||||
|
if (compiling)
|
||||||
|
execute((*get("literal"))->body());
|
||||||
|
} else {
|
||||||
|
auto body = (*ent)->body();
|
||||||
|
|
||||||
|
if (compiling && ((*ent)->flags_len & word_base::immediate) == 0) {
|
||||||
|
*here++ = reinterpret_cast<cell>(body);
|
||||||
|
} else {
|
||||||
|
execute(body);
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
auto parse() -> std::string_view {
|
||||||
|
const std::string_view sv {source};
|
||||||
|
|
||||||
|
const auto e = sv.find_first_of(" \t\r\n", sourcei);
|
||||||
|
const auto word = e != npos ? sv.substr(sourcei, e - sourcei)
|
||||||
|
: sv.substr(sourcei);
|
||||||
|
|
||||||
|
sourcei = sv.find_first_not_of(" \t\r\n", e);
|
||||||
|
return word;
|
||||||
|
}
|
||||||
|
|
||||||
|
void execute(func *body) {
|
||||||
|
assert<error::execute_error>(body && *body);
|
||||||
|
(*body)(body);
|
||||||
|
}
|
||||||
|
|
||||||
|
auto get(std::string_view sv) -> std::optional<word_base *> {
|
||||||
|
for (auto lt = latest; lt; lt = lt->next) {
|
||||||
|
if (sv == lt->name())
|
||||||
|
return lt;
|
||||||
|
}
|
||||||
|
|
||||||
|
return {};
|
||||||
|
}
|
||||||
|
|
||||||
|
template<forth **fthp>
|
||||||
|
static void prologue(func *body) {
|
||||||
|
static auto& fth = **fthp;
|
||||||
|
|
||||||
|
fth.rpush(fth.ip);
|
||||||
|
|
||||||
|
for (fth.ip = body + 1; *fth.ip; fth.ip++)
|
||||||
|
fth.execute(reinterpret_cast<func *>(*fth.ip));
|
||||||
|
|
||||||
|
fth.ip = fth.rpop();
|
||||||
|
}
|
||||||
|
|
||||||
|
template<forth** fthp>
|
||||||
|
static void initialize(cell *end_value)
|
||||||
|
{
|
||||||
|
assert<error::init_error>(*fthp);
|
||||||
|
|
||||||
|
static auto& fth = **fthp;
|
||||||
|
|
||||||
|
fth.end = end_value;
|
||||||
|
fth
|
||||||
|
.add("_d", [](auto) { fth.push(reinterpret_cast<cell>(&fth)); })
|
||||||
|
//.add("[", [](auto) { fth.compiling = false; }).make_immediate()
|
||||||
|
//.add("]", [](auto) { fth.compiling = true; })
|
||||||
|
.add("immediate", [](auto) { fth.make_immediate(); }).make_immediate()
|
||||||
|
.add("literal", [](auto) {
|
||||||
|
static auto lit_impl = +[] {
|
||||||
|
auto ptr = reinterpret_cast<cell *>(++fth.ip);
|
||||||
|
fth.push(*ptr);
|
||||||
|
};
|
||||||
|
assert<error::compile_only_word>(fth.compiling);
|
||||||
|
*fth.here++ = reinterpret_cast<cell>(&lit_impl);
|
||||||
|
*fth.here++ = fth.pop();
|
||||||
|
}).make_immediate()
|
||||||
|
.add("@", [](auto) { fth.push(*reinterpret_cast<cell *>(fth.pop())); })
|
||||||
|
.add("!", [](auto) {
|
||||||
|
auto [p, v] = fth.pop<2>();
|
||||||
|
*reinterpret_cast<cell *>(p) = v; })
|
||||||
|
.add("swap", [](auto) { auto [a, b] = fth.pop<2>(); fth.push(a, b); })
|
||||||
|
//.add("drop", [](auto) { fth.pop(); })
|
||||||
|
//.add("dup", [](auto) { fth.push(fth.top()); })
|
||||||
|
//.add("rot", [](auto) { auto [a, b, c] = fth.pop<3>(); fth.push(b, a, c); })
|
||||||
|
.add("+", [](auto) { fth.top() += fth.pop(); })
|
||||||
|
.add("-", [](auto) { fth.top() -= fth.pop(); })
|
||||||
|
.add("*", [](auto) { fth.top() *= fth.pop(); })
|
||||||
|
.add("/", [](auto) { fth.top() /= fth.pop(); })
|
||||||
|
.add("and", [](auto) { fth.top() &= fth.pop(); })
|
||||||
|
.add("or", [](auto) { fth.top() |= fth.pop(); })
|
||||||
|
.add("xor", [](auto) { fth.top() ^= fth.pop(); })
|
||||||
|
.add("=", [](auto) { auto v = fth.pop(); fth.top() = -(fth.top() == v); })
|
||||||
|
.add("<", [](auto) { auto v = fth.pop(); fth.top() = -(fth.top() < v); })
|
||||||
|
.add("\'", [](auto) {
|
||||||
|
auto w = fth.parse();
|
||||||
|
|
||||||
|
if (auto g = fth.get(w); g)
|
||||||
|
fth.push(reinterpret_cast<cell>((*g)->body()));
|
||||||
|
else
|
||||||
|
fth.push(0);
|
||||||
|
})
|
||||||
|
.add(":", [](auto) {
|
||||||
|
auto w = fth.parse();
|
||||||
|
fth.add(w);
|
||||||
|
*fth.here++ = reinterpret_cast<cell>(forth::prologue<fthp>);
|
||||||
|
fth.compiling = true;
|
||||||
|
})
|
||||||
|
.add(";", [](auto) {
|
||||||
|
*fth.here++ = 0;
|
||||||
|
fth.compiling = false;
|
||||||
|
}).make_immediate()
|
||||||
|
.add("\\", [](auto) {
|
||||||
|
fth.sourcei = npos;
|
||||||
|
}).make_immediate();
|
||||||
|
}
|
||||||
|
|
||||||
|
static auto error_string(error err) noexcept -> std::string_view {
|
||||||
|
using enum error;
|
||||||
|
switch (err) {
|
||||||
|
case init_error: return "init error";
|
||||||
|
case parse_error: return "parse error";
|
||||||
|
case execute_error: return "execute error";
|
||||||
|
case dictionary_overflow: return "dictionary overflow";
|
||||||
|
case word_not_found: return "word not found";
|
||||||
|
case stack_underflow: return "stack underflow";
|
||||||
|
case stack_overflow: return "stack overflow";
|
||||||
|
case return_stack_underflow: return "return stack underflow";
|
||||||
|
case return_stack_overflow: return "return stack overflow";
|
||||||
|
case compile_only_word: return "compile only word";
|
||||||
|
default: return "unknown error";
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
constexpr forth() {
|
||||||
|
sp = dstack.end();
|
||||||
|
rp = rstack.end();
|
||||||
|
}
|
||||||
|
|
||||||
|
cell *sp;
|
||||||
|
cell *rp;
|
||||||
|
func *ip = nullptr;
|
||||||
|
cell *here = reinterpret_cast<cell *>(this + 1);
|
||||||
|
word_base *latest = nullptr;
|
||||||
|
const char *source = nullptr;
|
||||||
|
std::size_t sourcei = npos;
|
||||||
|
cell compiling = false;
|
||||||
|
cell *end = nullptr;
|
||||||
|
std::array<cell, data_size> dstack;
|
||||||
|
std::array<cell, return_size> rstack;
|
||||||
|
};
|
||||||
|
|
||||||
|
static_assert(offsetof(forth::word_base, flags_len) == 1 * sizeof(forth::cell));
|
||||||
|
static_assert(offsetof(forth, rp) == 1 * sizeof(forth::cell));
|
||||||
|
static_assert(offsetof(forth, ip) == 2 * sizeof(forth::cell));
|
||||||
|
static_assert(offsetof(forth, here) == 3 * sizeof(forth::cell));
|
||||||
|
static_assert(offsetof(forth, latest) == 4 * sizeof(forth::cell));
|
||||||
|
static_assert(offsetof(forth, source) == 5 * sizeof(forth::cell));
|
||||||
|
static_assert(offsetof(forth, sourcei) == 6 * sizeof(forth::cell));
|
||||||
|
static_assert(offsetof(forth, compiling) == 7 * sizeof(forth::cell));
|
||||||
|
static_assert(offsetof(forth, end) == 8 * sizeof(forth::cell));
|
||||||
|
|
||||||
|
#endif // SFORTH_HPP
|
||||||
|
|
||||||
@ -0,0 +1,70 @@
|
|||||||
|
/// sforth, an implementation of forth
|
||||||
|
/// Copyright (C) 2024 Clyne Sullivan <clyne@bitgloo.com>
|
||||||
|
///
|
||||||
|
/// This program is free software: you can redistribute it and/or modify it
|
||||||
|
/// under the terms of the GNU General Public License as published by the Free
|
||||||
|
/// Software Foundation, either version 3 of the License, or (at your option)
|
||||||
|
/// any later version.
|
||||||
|
///
|
||||||
|
/// This program 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 General Public License for
|
||||||
|
/// more details.
|
||||||
|
///
|
||||||
|
/// You should have received a copy of the GNU General Public License along
|
||||||
|
/// with this program. If not, see <http://www.gnu.org/licenses/>.
|
||||||
|
|
||||||
|
#include "forth.hpp"
|
||||||
|
|
||||||
|
#include <array>
|
||||||
|
#include <fstream>
|
||||||
|
#include <iostream>
|
||||||
|
#include <span>
|
||||||
|
#include <string>
|
||||||
|
|
||||||
|
static std::array<forth::cell, 1024> dict;
|
||||||
|
static auto fth = new (dict.data()) forth;
|
||||||
|
|
||||||
|
static bool parse_stream(forth *, std::istream&, bool say_okay = false);
|
||||||
|
|
||||||
|
int main(int argc, const char *argv[])
|
||||||
|
{
|
||||||
|
std::span args (argv + 1, argc - 1);
|
||||||
|
|
||||||
|
forth::initialize<&fth>(dict.end());
|
||||||
|
fth->add(".", [](auto) { std::cout << fth->pop() << ' '; });
|
||||||
|
fth->add("emit", [](auto) { std::cout << static_cast<char>(fth->pop()); });
|
||||||
|
|
||||||
|
for (auto arg : args) {
|
||||||
|
if (std::ifstream file {arg}; parse_stream(fth, file))
|
||||||
|
return 0;
|
||||||
|
}
|
||||||
|
|
||||||
|
parse_stream(fth, std::cin, true);
|
||||||
|
}
|
||||||
|
|
||||||
|
bool parse_stream(forth *fth, std::istream& str, bool say_okay)
|
||||||
|
{
|
||||||
|
std::string line;
|
||||||
|
|
||||||
|
while (str.good()) {
|
||||||
|
std::getline(str, line);
|
||||||
|
if (!line.empty()) {
|
||||||
|
if (line == "bye")
|
||||||
|
return true;
|
||||||
|
|
||||||
|
try {
|
||||||
|
fth->parse_line(line);
|
||||||
|
} catch (forth::error e) {
|
||||||
|
std::cerr << fth->error_string(e);
|
||||||
|
continue;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
if (say_okay)
|
||||||
|
std::cout << (fth->compiling ? "compiled" : "ok") << std::endl;
|
||||||
|
}
|
||||||
|
|
||||||
|
return false;
|
||||||
|
}
|
||||||
|
|
||||||
Loading…
Reference in New Issue