// sprit-forth: A portable subroutine-threaded Forth. // Copyright (C) 2023 Clyne Sullivan // // 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 #include FuncList IP = nullptr; std::array DICT; Cell& BASE = DICT[DIdxBase]; Cell& HERE = DICT[DIdxHere]; Cell& LATEST = DICT[DIdxLatest]; Cell& STATE = DICT[DIdxState]; static std::jmp_buf jmpbuf; static Cell *SP = DICT.data() + DICT.size() - DS; static Cell *RP = DICT.data() + DICT.size() - DS - RS; void push(Cell value) { if (SP >= DICT.data() + DICT.size()) std::longjmp(jmpbuf, static_cast(Error::push)); *++SP = value; } Cell pop() { if (SP - 1 < DICT.data() + DICT.size() - DS) std::longjmp(jmpbuf, static_cast(Error::pop)); return *SP--; } Cell *sp() { return SP; } void rpush(Cell value) { if (RP >= DICT.data() + DICT.size() - DS) std::longjmp(jmpbuf, static_cast(Error::rpush)); *++RP = value; } Cell rpop() { if (RP - 1 < DICT.data() + DICT.size() - DS - RS) std::longjmp(jmpbuf, static_cast(Error::rpop)); return *RP--; } Cell *rp() { return RP; } Error executor(FuncList *list) { auto result = static_cast(setjmp(jmpbuf)); FuncList body; if (static_cast(result) == 0) { result = Error::none; // We are given the pointer to a list of function pointers. // Dereference once to retrieve the function pointer list. // We do not work with IP initially since it needs to be set to zero if // this is a top-level call/execution. body = *list; // Enter the execution loop. goto entry; // Execution continues so long as IP is not zero. // If this is a top-level execution of a pre-defined word, then IP will // remain zero'd and the loop will immediately exit. // If this is a defined word's execution, then its "call" will overwrite // IP (and push the initial zero-IP to the return stack); execution will // continue until we return to the zero-IP. while (IP) { // Retrieve next function pointer list. body = (FuncList)*++IP; entry: // Dereference `body` to get the first function in the list. // This is casted to take a FuncList as an argument since defined // words need to know their addresses so that they can perform // their "calls". // If the word is pre-defined then the argument will simply be // ignored. auto func = (void (*)(FuncList))*body; func(body); } } return result; } Error execute1(Word *word) { // IP must initially be zero if executing a word at the top level. IP = 0; return 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; }