// sprit-forth: A portable subroutine-threaded Forth. // Copyright (C) 2024 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 #include static State state; void jump(FuncList ip) { // IP is incremented before its next execution. Exec.ip = ip - 1; } void compileliteral() { // LITERAL's run-time semantics: push the given value onto the stack. comma((Cell)WordWrap<[] { Forth.push((Cell)*++Exec.ip); }>); comma(Forth.pop()); } bool haskey() { return Forth.sourcei < Forth.sourceu; } void addkey(int k) { auto addr = Forth.source + Forth.sourceu++; auto ptr = reinterpret_cast(addr); *ptr = static_cast(k); } int key() { // Block until input is available. while (!haskey()) getinput(); auto ptr = reinterpret_cast(Forth.source); int idx = Forth.sourcei++; return ptr[idx]; } Cell *comma(Cell n) { const auto ptr = reinterpret_cast(Forth.here); *ptr = n; Forth.here += sizeof(Cell); return ptr; } Addr aligned(Addr addr) { return (addr + (sizeof(Cell) - 1)) & ~(sizeof(Cell) - 1); } void align() { Forth.here = aligned(Forth.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(Forth.here); *ptr = k; ++Forth.here; if (!haskey()) break; k = key(); } while (k != ch); // Add a null terminator. ptr = reinterpret_cast(Forth.here); *ptr = '\0'; ++Forth.here; } void word() { auto here = (char *)Forth.here; ++Forth.here; readword(*Forth.sp); here[0] = strlen(here + 1); Forth.here = (Cell)here; *Forth.sp = Forth.here; } void colon() { // Collect (and store) the word's name. align(); auto name = Forth.here; readword(' '); align(); // Build the Word structure. Forth.push(Forth.here); comma(Forth.here + 4 * sizeof(Cell)); // exec ptr comma(name); // name ptr comma(0); // link 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; Forth.rpush((Cell)Exec.ip); jump((FuncList)*ip); }); // The actual function list will begin one Cell beyond here. comma(Forth.here + sizeof(Cell)); // Enter compiling state. Forth.compxt = *Forth.sp; Forth.state = -1; } void semic() { // Add exit routine. comma((Cell)fexit); // Complete the new word's linkage to make it usable. auto word = reinterpret_cast(Forth.pop()); Forth.add(*word); // Exit compilation state. Forth.state = 0; } // TODO define in Forth? ": ' bl word find drop ;" void tick() { // Get the name to look up. auto name = Forth.here; readword(' '); // Look up the name and push the result. int len = Forth.here - name - 1; auto word = Forth.find((char *)name, len); Forth.push((Cell)word); // Deallocate `name`. Forth.here = name; }