admin/LithosAnanake
1
1
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

refactor(v4.0.0): the capsule's inner words keep their state in memory

Browse Source 
WORD, the dictionary words and the code generator run underneath
whatever the user has on the stacks, which are ten and nine deep (D-2).
Measured, they used five to seven data cells of their own, leaving a
line about three.  Each now keeps what it works on in its file's
scratch cells and has at most three cells on the data stack; , calls
nothing; and the longest chains of calls are shorter.

The public words of core.v4, input.v4 and dict.v4 get dictionary
headers.  NUMBER is split so the interpreter can have a flag instead of
NODE-ERROR.  The host-node tests share one memory map, host_map.h.

Co-Authored-By: Claude Opus 5.5 <noreply@anthropic.com>
This commit is contained in:
rajames
2026-10-04 10:41:50 -04:00
co-authored by Claude Opus 5.5
parent 44ffd261bb
commit bbd1b4047f
10 changed files with 360 additions and 248 deletions
Download Patch File Download Diff File Expand all files Collapse all files
v4/tests/test_host_dict.c
+14 -49
View File
@@ -34,30 +34,10 @@ static int failures = 0, checks = 0;
#define CANARY ((v4_cell)0x0C0FFEE5)
/* The memory map is open (D-4); the test chooses it. */
#define TOP ((v4_cell)V4_NODE_WORDS)
#define NODE_ERROR (TOP - 2)
#define CONSOLE_TX (TOP - 4)
#define CONSOLE_RX (TOP - 6)
#define CONSOLE_ST (TOP - 7)
#define BASE (TOP - 8)
#define TO_IN (TOP - 9)
#define SPAN (TOP - 10)
#define PVARS (TOP - 16)
#define DP (TOP - 17)
#define LATEST (TOP - 18)
#define DVARS (TOP - 20) /* two cells */
#define WBUF_W (TOP - 90)
#define TIB_W (TOP - 360)
#define SBUF_W (TOP - 440)
#define PAD_W (TOP - 470)
#define WBUF (WBUF_W * 4)
#define TIB (TIB_W * 4)
#define SBUF (SBUF_W * 4)
#define PAD (PAD_W * 4)
#define DICT_W ((v4_cell)4096) /* dictionary space: words 4096 .. 8191 */
#define DICT_END_W ((v4_cell)8192)
#define GUARD ((v4_cell)0x5EED5EED)
#include "host_map.h"
static v4_node n;
static v4_exec_state es;
@@ -207,32 +187,15 @@ static void setup_new(void) { empty_dictionary(); set_line("NEWWORD rest"); }
int main(void)
{
unsigned i, t;
v4_cell a, b, c;
v4_cell a, b, c, capsule_latest;
printf("v4 host dictionary tests: V4_CELL_BITS=%d, V4_NODE_WORDS=%u\n", V4_CELL_BITS, (unsigned)V4_NODE_WORDS);
v4_node_reset(&n);
v4_text_begin(&tx, &n, 16);
v4_text_constant(&tx, "N-1", V4_CELL_BITS - 1);
v4_text_constant(&tx, "NODE-ERROR", NODE_ERROR);
v4_text_constant(&tx, "CONSOLE-TX", CONSOLE_TX);
v4_text_constant(&tx, "CONSOLE-RX", CONSOLE_RX);
v4_text_constant(&tx, "CONSOLE-STATUS", CONSOLE_ST);
v4_text_constant(&tx, "BASE", BASE);
v4_text_constant(&tx, "TIB", TIB);
v4_text_constant(&tx, ">IN", TO_IN);
v4_text_constant(&tx, "SPAN", SPAN);
v4_text_constant(&tx, "WBUF", WBUF);
v4_text_constant(&tx, "(P)", PVARS);
v4_text_constant(&tx, "DP", DP);
v4_text_constant(&tx, "(LATEST)", LATEST);
v4_text_constant(&tx, "DBASE", DICT_W * 4);
v4_text_constant(&tx, "DLIMIT", DICT_END_W * 4);
v4_text_constant(&tx, "PAD", PAD);
v4_text_constant(&tx, "(D)", DVARS);
CHECK(v4_text_assemble_file(&tx, V4_CAPSULE_DIR "/core.v4"), "core.v4 assembles: %s", v4_text_error(&tx));
CHECK(v4_text_assemble_file(&tx, V4_CAPSULE_DIR "/input.v4"), "input.v4 assembles: %s", v4_text_error(&tx));
CHECK(v4_text_assemble_file(&tx, V4_CAPSULE_DIR "/dict.v4"), "dict.v4 assembles: %s", v4_text_error(&tx));
{
static const char *const files[] = { "core.v4", "input.v4", "dict.v4" };
CHECK(host_load(&tx, &n, files, 3), "the capsule assembles");
}
capsule_latest = v4_text_latest(&tx);
CHECK(v4_text_assemble(&tx,
": MAKE ( -- ) 32 WORD jump (HEADER)\n"
": 'PAD PAD ;\n"
@@ -389,11 +352,11 @@ int main(void)
a = define("CODEWORD"); (void)run(",", 1, 1, 0);
b = define("DATAWORD"); (void)run("DATA!", 0, 0, 0); (void)run(",", 1, 2, 0); (void)run(",", 1, 55, 0);
set_line("CODEWORD x");
CHECK(get("'", 0, 0) == a && !err() && n.mem[TO_IN] == 9, "' of a code word is its code address, which is what FIND gives");
CHECK(get("(')", 0, 0) == a && !err() && n.mem[TO_IN] == 9, "' of a code word is its code address, which is what FIND gives");
set_line("DATAWORD");
CHECK(get("'", 0, 0) == b + 1 && !err() && n.mem[b + 1] == 55, "' of a data word is its parameter field");
CHECK(get("(')", 0, 0) == b + 1 && !err() && n.mem[b + 1] == 55, "' of a data word is its parameter field");
set_line("NOSUCHWORD");
CHECK(get("'", 0, 0) == 0 && err(), "' of a word that is not there is an error");
CHECK(get("(')", 0, 0) == 0 && err(), "' of a word that is not there is an error");
/* ---- entries the text assembler made ---- */
{
@@ -403,7 +366,9 @@ int main(void)
CHECK(v4_text_latest(&tx) == xp, "the assembler's latest header is the last one in the text");
CHECK(find("FIRST-HEADER") == xa && find("B") == xb && find("(") == xp && find("ASM-A") == 0 && !err(), "FIND finds the words the assembler gave headers");
CHECK(n.mem[xa - 3] == 0 && n.mem[xb - 3] == 1 + 8 && n.mem[xp - 3] == 1, "with the flags it gave them");
CHECK(get("LINK>", 1, get(">LINK", 1, xp)) == xb && get("LINK>", 1, get(">LINK", 1, xb)) == xa && get("LINK>", 1, get(">LINK", 1, xa)) == 0, "linked in order");
CHECK(get("LINK>", 1, get(">LINK", 1, xp)) == xb && get("LINK>", 1, get(">LINK", 1, xb)) == xa && get("LINK>", 1, get(">LINK", 1, xa)) == capsule_latest, "linked in order, after the capsule's own");
CHECK(capsule_latest != 0 && find("WORD") == W("WORD") && find("C@") == W("C@") && find(",") == W(",") && find("\\") == W("BACKSLASH"),
"the capsule's own words are found under their FORTH names");
CHECK(get("NAME>", 1, get(">NAME", 1, xa)) == xa && get("NAME>", 1, get(">NAME", 1, xp)) == xp, "and the field words work on them");
/* the same name through (HEADER): the same cells */
made = define("FIRST-HEADER");
@@ -454,7 +419,7 @@ int main(void)
/* What they leave their caller (D-2). */
headroom("FIND", setup_three, 0, 0, 1, 3, 2);
headroom("'", setup_three, 0, 0, 1, 3, 2);
headroom("(')", setup_three, 0, 0, 1, 3, 2);
headroom("MAKE", setup_new, 0, 0, 0, 3, 2);
headroom(",", setup_new, 1, 42, 0, 5, 5);
headroom("ALLOT", setup_new, 1, 3, 0, 5, 5);