You cannot select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.

182 lines
4.0 KiB
C++

// 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>
#include <cstring>
void jump(FuncList ip)
{
// IP is incremented before its next execution.
IP = ip - 1;
}
// LITERAL's run-time semantics: push the given value onto the stack.
static auto literall = WordWrap<[] {
push((Cell)*++IP);
}>;
void compileliteral()
{
comma((Cell)literall);
comma(pop());
}
bool haskey()
{
return *((char *)&DICT[DIdxInBuf]) < DICT[DIdxSrcLen];
}
void addkey(int k)
{
auto addr = DICT[DIdxSource] + (DICT[DIdxSrcLen]++);
auto ptr = reinterpret_cast<char *>(addr);
*ptr = static_cast<char>(k);
}
int key()
{
// Block until input is available.
while (!haskey())
getinput();
auto ptr = reinterpret_cast<char *>(DICT[DIdxSource]);
int idx = (*((char *)&DICT[DIdxInBuf]))++;
return ptr[idx];
}
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);
}
static void readword(int ch)
{
int k;
do {
k = key();
} while (k == ch);
// Collect the word's text.
char *ptr;
do {
ptr = reinterpret_cast<char *>(HERE);
*ptr = k;
++HERE;
if (!haskey())
break;
k = key();
} while (k != ch);
// Add a null terminator.
ptr = reinterpret_cast<char *>(HERE);
*ptr = '\0';
++HERE;
}
void word()
{
auto here = (char *)HERE;
++HERE;
readword(*sp());
here[0] = strlen(here + 1);
HERE = (Cell)here;
*sp() = HERE;
}
void colon()
{
// Collect (and store) the word's name.
align();
auto name = HERE;
readword(' ');
align();
// Build the Word structure.
comma(HERE + 4 * sizeof(Cell)); // exec ptr
comma(name); // name ptr
push((Cell)comma(0)); // link (to be set by semic())
comma(0); // immediate
// The word's execution begins with a prologue that technically performs
// the "call" to this word.
// By including this in the word's definition, execution can avoid caring
// about if it is running words or routines (i.e. pre-defined words).
comma((Cell)+[](FuncList *ip) {
++ip;
rpush((Cell)IP);
jump((FuncList)*ip);
});
// The actual function list will begin one Cell beyond here.
comma(HERE + sizeof(Cell));
DICT[DIdxCompXt] = *sp() - 2 * sizeof(Cell);
// Enter compiling state.
STATE = -1;
}
void semic()
{
// Add exit routine.
comma((Cell)fexit);
// Complete the new word's linkage to make it usable.
auto link = (Cell *)pop();
*link = LATEST;
LATEST = (Cell)(link - 2);
// Exit compilation state.
STATE = 0;
}
// TODO define in Forth? ": ' bl word find drop ;"
void tick()
{
// Get the name to look up.
auto name = (char *)HERE;
readword(' ');
// Look up the name and push the result.
int len = HERE - (Cell)name - 1;
auto word = find(name, len);
push((Cell)word);
// Deallocate `name`.
HERE = (Cell)name;
}