sprit-forth/source/core.cpp

// 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;
}