initial upload
parent
9a46bc4589
commit
092002a49f
GPG Key ID:
3267C8EBF3F9AFC7
@ -0,0 +1,4 @@
|
|||||||
|
.*
|
||||||
|
*.a
|
||||||
|
*.o
|
||||||
|
sprit
|
||||||
@ -0,0 +1,26 @@
|
|||||||
|
SRC := $(wildcard source/*.cpp)
|
||||||
|
OBJ := $(subst .cpp,.o,$(SRC))
|
||||||
|
|
||||||
|
CXXFLAGS += -std=c++20 -ggdb -g3 -Os \
|
||||||
|
-Wall -Wextra -pedantic \
|
||||||
|
-Isource
|
||||||
|
|
||||||
|
all: sprit
|
||||||
|
|
||||||
|
msp430: CXX := msp430-elf-g++
|
||||||
|
msp430: AR := msp430-elf-ar
|
||||||
|
msp430: CXXFLAGS += -mmcu=msp430fr2476 -Os #-flto
|
||||||
|
msp430: LDFLAGS += -L/usr/msp430-elf/usr/include
|
||||||
|
msp430: sprit
|
||||||
|
|
||||||
|
x86: CXXFLAGS += -m32
|
||||||
|
x86: sprit
|
||||||
|
|
||||||
|
clean:
|
||||||
|
rm -f sprit source/libsprit.a $(OBJ)
|
||||||
|
|
||||||
|
sprit: source/libsprit.a
|
||||||
|
|
||||||
|
source/libsprit.a: $(OBJ)
|
||||||
|
$(AR) rcu $@ $^
|
||||||
|
|
||||||
@ -1,3 +1,18 @@
|
|||||||
# sprit-forth
|
# sprit-forth
|
||||||
|
|
||||||
A tiny and portable subroutine-threaded Forth.
|
Sprit Forth is a tiny and portable subroutine-threaded Forth written in modern C++. It is inspired by [Alee Forth](https://code.bitgloo.com/bitgloo/alee-forth) and [milliForth](https://github.com/fuzzballcat/milliForth).
|
||||||
|
|
||||||
|
Subroutine-threading is an improvement over Alee Forth's tokenized threading: words are compiled as lists of function pointers such that their execution is direct and "native". By sticking to subroutines instead of directly compiling assembly instructions, Sprit Forth maintains entirely portable.
|
||||||
|
|
||||||
|
In terms of size, the `libsprit.a` library is only around 4kB on x86\_64 without optimizations, down to around 2kB with size optimizations, and *under 1kB* on a 16-bit MSP430 microcontroller.
|
||||||
|
|
||||||
|
**Sprit Forth is early in development.** The project won't be considered "stable" until at least the [core standard word-set](https://forth-standard.org/standard/core) is implemented.
|
||||||
|
|
||||||
|
## Requirements
|
||||||
|
|
||||||
|
A C++ compiler that supports the C++20 standard.
|
||||||
|
|
||||||
|
## Building
|
||||||
|
|
||||||
|
Run `make`. There are `x86` and `msp430` targets available to target those architectures.
|
||||||
|
|
||||||
|
|||||||
@ -0,0 +1,95 @@
|
|||||||
|
: cell+ [ 1 cells ] literal + ;
|
||||||
|
: char+ 1 + ;
|
||||||
|
: chars ;
|
||||||
|
|
||||||
|
: 1+ 1 + ;
|
||||||
|
: 1- 1 - ;
|
||||||
|
|
||||||
|
: over 1 pick ;
|
||||||
|
: rot >r swap r> swap ;
|
||||||
|
: -rot rot rot ;
|
||||||
|
|
||||||
|
: +! dup >r swap r> @ + swap ! ;
|
||||||
|
|
||||||
|
: imm immediate ;
|
||||||
|
|
||||||
|
: base [ 0 _d ] literal ;
|
||||||
|
: here [ 1 cells _d ] literal @ ;
|
||||||
|
: allot [ 1 cells _d ] literal +! ;
|
||||||
|
: state [ 3 cells _d ] literal ;
|
||||||
|
: _compxt [ 4 cells _d ] literal ;
|
||||||
|
: _source [ 5 cells _d ] literal ;
|
||||||
|
: _sourceu [ 6 cells _d ] literal ;
|
||||||
|
: >in [ 7 cells _d ] literal ;
|
||||||
|
: _begin [ 8 cells 80 chars + _d ] literal ;
|
||||||
|
|
||||||
|
: c, here c! 1 allot ;
|
||||||
|
|
||||||
|
: if ['] _jmp0 compile, here 0 , ; imm
|
||||||
|
: then here swap ! ; imm
|
||||||
|
: else ['] _jmp compile, here 0 , swap here swap ! ; imm
|
||||||
|
|
||||||
|
: postpone ' dup _i swap [ ' literal compile, ]
|
||||||
|
if ['] execute else ['] , then compile, ; imm
|
||||||
|
|
||||||
|
: 2drop drop drop ;
|
||||||
|
: 2dup over over ;
|
||||||
|
: 2over 3 pick 3 pick ;
|
||||||
|
: 2swap rot >r rot r> ;
|
||||||
|
|
||||||
|
: decimal 10 base ! ;
|
||||||
|
|
||||||
|
: 2r> ['] r> compile, ['] r> compile, ['] swap compile, ; imm
|
||||||
|
: 2>r ['] swap compile, ['] >r compile, ['] >r compile, ; imm
|
||||||
|
: r@ ['] r> compile, ['] dup compile, ['] >r compile, ; imm
|
||||||
|
|
||||||
|
: 2! swap over ! cell+ ! ;
|
||||||
|
: 2@ dup cell+ @ swap @ ;
|
||||||
|
|
||||||
|
: 0= 0 = ;
|
||||||
|
: 0< 0 < ;
|
||||||
|
: <= 2dup < >r = r> or ;
|
||||||
|
: > swap < ;
|
||||||
|
: <> = 0= ;
|
||||||
|
|
||||||
|
: begin 0 here ; imm
|
||||||
|
: while swap 1+ swap postpone if -rot ; imm
|
||||||
|
: repeat ['] _jmp compile, , if postpone then then ; imm
|
||||||
|
: until ['] _jmp0 compile, , drop ; imm
|
||||||
|
|
||||||
|
: do 0 postpone literal here 1 cells -
|
||||||
|
['] >r compile, postpone 2>r here ; imm
|
||||||
|
: unloop postpone 2r> ['] 2drop compile,
|
||||||
|
['] r> compile, ['] drop compile, ; imm
|
||||||
|
: leave postpone 2r> ['] 2drop compile, ['] exit compile, ; imm
|
||||||
|
: +loop ['] r> compile, ['] 2dup compile, ['] + compile,
|
||||||
|
postpone r@ ['] swap compile, ['] >r compile,
|
||||||
|
['] - compile, ['] 2dup compile, ['] + compile,
|
||||||
|
['] over compile, ['] xor compile, ['] rot compile,
|
||||||
|
['] rot compile, ['] xor compile, ['] and compile,
|
||||||
|
0 postpone literal ['] < compile, ['] _jmp0 compile, ,
|
||||||
|
postpone unloop here 1 cells - swap ! ; imm
|
||||||
|
: loop postpone 2r> ['] 1+ compile, ['] 2dup compile,
|
||||||
|
postpone 2>r ['] = compile, ['] _jmp0 compile, ,
|
||||||
|
postpone unloop here 1 cells - swap ! ; imm
|
||||||
|
: i postpone r@ ; imm
|
||||||
|
: j postpone 2r> ['] r> compile, postpone r@ ['] swap compile,
|
||||||
|
['] >r compile, ['] -rot compile, postpone 2>r ; imm
|
||||||
|
|
||||||
|
: invert -1 ^ ;
|
||||||
|
: 2* 2 * ;
|
||||||
|
: _msb [ 1 1 cells 8 * 1- lshift ] literal ;
|
||||||
|
: 2/ dup 1 rshift swap 0< if _msb or then ;
|
||||||
|
|
||||||
|
: cr 10 emit ;
|
||||||
|
: bl 32 ;
|
||||||
|
: space bl emit ;
|
||||||
|
: spaces begin dup 0 > while space 1- repeat drop ;
|
||||||
|
|
||||||
|
: ?dup dup if dup then ;
|
||||||
|
|
||||||
|
: negate -1 * ;
|
||||||
|
: abs dup 0< if negate then ;
|
||||||
|
: min 2dup <= if drop else swap drop then ;
|
||||||
|
: max 2dup <= if swap drop else drop then ;
|
||||||
|
|
||||||
@ -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;
|
||||||
|
}
|
||||||
|
|
||||||
@ -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
|
||||||
|
|
||||||
@ -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();
|
||||||
|
}
|
||||||
|
|
||||||
@ -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();
|
||||||
@ -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;
|
||||||
|
}
|
||||||
|
|
||||||
@ -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
|
||||||
|
|
||||||
@ -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
|
||||||
|
|
||||||
@ -0,0 +1,93 @@
|
|||||||
|
#include <algorithm>
|
||||||
|
#include <iostream>
|
||||||
|
#include <string>
|
||||||
|
|
||||||
|
#include "core.hpp"
|
||||||
|
#include "parse.hpp"
|
||||||
|
#include "state.hpp"
|
||||||
|
#include "types.hpp"
|
||||||
|
|
||||||
|
// TODO:
|
||||||
|
// sys m* _/ _% _' depth _rdepth _in _ev find _uma u< um/mod
|
||||||
|
|
||||||
|
static void peek() { *SP = *(Cell *)(*SP); }
|
||||||
|
static void commaSP() { comma(*SP--); }
|
||||||
|
static void push(Cell value) { *++SP = value; }
|
||||||
|
static void pop() { --SP; }
|
||||||
|
static void tobool() { if (*SP) *SP = -1; }
|
||||||
|
|
||||||
|
constinit WordSet words (
|
||||||
|
Word("[", WordWrap<[] { STATE = 0; }>()).markImmediate(),
|
||||||
|
Word("]", WordWrap<[] { STATE = -1; }>()),
|
||||||
|
Word("@", WordWrap<peek>()),
|
||||||
|
Word("c@", WordWrap<peek, [] { *SP &= 0xFF; }>()),
|
||||||
|
Word("!", WordWrap<[] { auto a = (Cell *)*SP--; *a = *SP--; }>()),
|
||||||
|
Word("c!", WordWrap<[] { auto a = (char *)*SP--; *a = *SP--; }>()),
|
||||||
|
Word("_d", WordWrap<[] { *SP += (Cell)DICT.data(); }>()),
|
||||||
|
Word("_jmp", WordWrap<[] { jump((FuncList)*++IP); }>()),
|
||||||
|
Word("_jmp0", WordWrap<[] {
|
||||||
|
++IP;
|
||||||
|
if (*SP-- == 0)
|
||||||
|
jump((FuncList)*IP);
|
||||||
|
}>()),
|
||||||
|
Word(",", WordWrap<commaSP>()),
|
||||||
|
Word("emit", WordWrap<[] { std::putchar(*SP); }, pop>()),
|
||||||
|
Word("key", WordWrap<[] { push(key()); }>()),
|
||||||
|
Word("key?", WordWrap<[] { push(haskey()); }, tobool>()),
|
||||||
|
Word("execute", WordWrap<[] { executor((FuncList *)*SP--); }>()),
|
||||||
|
Word(":", WordWrap<colon>()),
|
||||||
|
Word(";", WordWrap<semic>()).markImmediate(),
|
||||||
|
Word("exit", fexit),
|
||||||
|
Word("drop", WordWrap<pop>()),
|
||||||
|
Word("dup", WordWrap<[] { push(*SP); }>()),
|
||||||
|
Word("swap", WordWrap<[] { std::swap(*SP, *(SP - 1)); }>()),
|
||||||
|
Word("pick", WordWrap<[] { auto t = *(SP - *SP - 1); *SP = t; }>()),
|
||||||
|
Word("cells", WordWrap<[] { *SP *= sizeof(Cell); }>()),
|
||||||
|
Word("+", WordWrap<[] { *(SP - 1) += *SP; }, pop>()),
|
||||||
|
Word("-", WordWrap<[] { *(SP - 1) -= *SP; }, pop>()),
|
||||||
|
Word("*", WordWrap<[] { *(SP - 1) *= *SP; }, pop>()),
|
||||||
|
Word("/", WordWrap<[] { *(SP - 1) /= *SP; }, pop>()),
|
||||||
|
Word("mod", WordWrap<[] { *(SP - 1) %= *SP; }, pop>()),
|
||||||
|
Word("=", WordWrap<[] { *(SP - 1) = *(SP - 1) == *SP; }, pop, tobool>()),
|
||||||
|
Word("<", WordWrap<[] { *(SP - 1) = *(SP - 1) < *SP; }, pop, tobool>()),
|
||||||
|
Word("or", WordWrap<[] { *(SP - 1) |= *SP; }, pop>()),
|
||||||
|
Word("and", WordWrap<[] { *(SP - 1) &= *SP; }, pop>()),
|
||||||
|
Word("xor", WordWrap<[] { *(SP - 1) ^= *SP; }, pop>()),
|
||||||
|
Word("lshift", WordWrap<[] { *(SP - 1) <<= *SP; }, pop>()),
|
||||||
|
Word("rshift", WordWrap<[] { *(SP - 1) >>= *SP; }, pop>()),
|
||||||
|
Word(">r", WordWrap<[] { *++RP = *SP; }, pop>()),
|
||||||
|
Word("r>", WordWrap<[] { push(*RP--); }>()),
|
||||||
|
Word("immediate", WordWrap<[] { ((Word *)LATEST)->markImmediate(); }>()),
|
||||||
|
Word("aligned", WordWrap<[] { *SP = aligned(*SP); }>()),
|
||||||
|
Word("align", WordWrap<align>()),
|
||||||
|
Word("literal", WordWrap<[] { if (STATE) compileliteral(); }>()).markImmediate(),
|
||||||
|
Word("\'", WordWrap<tick>()),
|
||||||
|
Word("_i", WordWrap<[] { *SP = ((Word *)*SP)->immediate(); }, tobool>()),
|
||||||
|
Word("[']", WordWrap<tick, compileliteral>()).markImmediate(),
|
||||||
|
Word("compile,", WordWrap<peek, commaSP>()),
|
||||||
|
Word("_b", WordWrap<[] {
|
||||||
|
std::putchar('#'); // Gives a good breakpoint spot for gdb
|
||||||
|
}>()),
|
||||||
|
Word(".", WordWrap<[] { std::cout << *SP << ' '; }, pop>())
|
||||||
|
);
|
||||||
|
|
||||||
|
void getinput()
|
||||||
|
{
|
||||||
|
std::string line;
|
||||||
|
|
||||||
|
if (std::cin.good()) {
|
||||||
|
std::getline(std::cin, line);
|
||||||
|
std::for_each(line.rbegin(), line.rend(), addkey);
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
int main()
|
||||||
|
{
|
||||||
|
initialize(words);
|
||||||
|
|
||||||
|
while (std::cin.good()) {
|
||||||
|
parse();
|
||||||
|
std::cout << (STATE ? "compiled" : "ok") << std::endl;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
Loading…
Reference in New Issue