// 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 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(DICT[DIdxSource]); *ptr = static_cast(k); } int key() { while (!haskey()) getinput(); auto ptr = reinterpret_cast(DICT[DIdxSource]); ++DICT[DIdxSource]; --DICT[DIdxSrcLen]; return *ptr; } Cell *comma(Cell n) { const auto ptr = reinterpret_cast(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(HERE); *ptr = k; ++HERE; if (!haskey()) break; k = key(); } while (!isspace(k)); addkey(k); ptr = reinterpret_cast(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; }