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/host_map.h
+114
View File
@@ -0,0 +1,114 @@
/* host_map.h -- the memory map the host-node tests give the compiler capsule,
* and the loader that assembles it.
*
* The node's memory map is open (DECOMPOSITION.md D-4), so the tests choose
* one. Every test_host_*.c uses this one, so that the capsule's variables
* and buffers are in the same place in all of them:
*
* 16 .. the capsule's code, assembled from capsule/ *.v4
* DICT_W .. DICT_END_W dictionary space for what is defined at run time
* top of memory buffers, then variables, as below
*/
#ifndef V4_TESTS_HOST_MAP_H
#define V4_TESTS_HOST_MAP_H
#include "v4/text.h"
#include <stdio.h>
#define TOP ((v4_cell)V4_NODE_WORDS)
/* registers and single variables */
#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 DP (TOP - 11)
#define LATEST (TOP - 12)
#define STATE (TOP - 13)
#define CFP (TOP - 14) /* the control-flow stack's pointer */
/* each capsule file's scratch cells */
#define PVARS (TOP - 24) /* (P): input.v4, 8 cells */
#define DVARS (TOP - 32) /* (D): dict.v4, 5 cells */
#define CGVARS (TOP - 48) /* (CG): codegen.v4, 13 cells */
#define CVARS (TOP - 58) /* (C): compile.v4, 8 cells */
/* buffers (word addresses; a byte address is four times this) */
#define CFS_W (TOP - 96) /* the control-flow stack, 32 cells */
#define CFS_CELLS 32
#define WBUF_W (TOP - 170) /* WORD's buffer: 65 cells = 260 bytes */
#define WBUF_CELLS 65
#define TIB_W (TOP - 440) /* the text input buffer: 260 cells = 1040 bytes */
#define PAD_W (TOP - 470) /* PAD: 21 cells = 84 bytes */
#define SBUF_W (TOP - 540) /* 64 cells for the tests' own strings */
#define WBUF (WBUF_W * 4)
#define TIB (TIB_W * 4)
#define PAD (PAD_W * 4)
#define SBUF (SBUF_W * 4)
/* dictionary space */
#ifndef DICT_W
#define DICT_W ((v4_cell)8192)
#endif
#ifndef DICT_END_W
#define DICT_END_W ((v4_cell)14336)
#endif
/* How many slots, from slot 0, a branch may sit in on a node this size: those
* whose address field reaches every word of it. */
static unsigned host_branch_slots(void)
{
unsigned k, slots = 0;
for (k = 0; k < 4; k++) if ((v4_ucell)v4_iword_slot_mask(k) >= (v4_ucell)(V4_NODE_WORDS - 1u)) slots = k + 1;
return slots;
}
/* Reset `n`, give the assembler every constant the capsule files ask for, and
* assemble the `count` files named. Returns 1 if all assembled; otherwise
* prints which did not and why. The caller may assemble more text and must
* call v4_text_finish. */
static int host_load(v4_text *tx, v4_node *n, const char *const *files, unsigned count)
{
char path[512];
unsigned i;
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);
v4_text_constant(tx, "(CG)", CGVARS);
v4_text_constant(tx, "CG-BSLOTS", (v4_cell)host_branch_slots());
v4_text_constant(tx, "STATE", STATE);
v4_text_constant(tx, "(C)", CVARS);
v4_text_constant(tx, "(CFP)", CFP);
v4_text_constant(tx, "CFBASE", CFS_W);
v4_text_constant(tx, "CFEND", CFS_W + CFS_CELLS);
for (i = 0; i < count; i++) {
snprintf(path, sizeof path, "%s/%s", V4_CAPSULE_DIR, files[i]);
if (!v4_text_assemble_file(tx, path)) {
printf(" %s does not assemble: %s\n", files[i], v4_text_error(tx));
return 0;
}
}
return 1;
}
#endif /* V4_TESTS_HOST_MAP_H */
v4/tests/test_host_codegen.c
+5 -42
View File
@@ -21,25 +21,9 @@ static int failures = 0, checks = 0;
#define CANARY ((v4_cell)0x0C0FFEE5)
#define MAXU ((v4_ucell)~(v4_ucell)0)
/* 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)
#define CGVARS (TOP - 30) /* nine cells */
#define WBUF_W (TOP - 90)
#define TIB_W (TOP - 360)
#define PAD_W (TOP - 470)
#define DICT_W ((v4_cell)8192) /* dictionary space: words 8192 .. 12287 */
#define DICT_END_W ((v4_cell)12288)
#include "host_map.h"
static v4_node n, ref; /* the generator's node; the text assembler's */
static v4_exec_state es;
@@ -194,31 +178,10 @@ int main(void)
for (i = 0; i < 4; i++) if ((v4_ucell)v4_iword_slot_mask(i) >= (v4_ucell)(V4_NODE_WORDS - 1u)) bslots = i + 1;
CHECK(bslots == 3, "at this node size a branch may sit in slots 0 .. 2: %u", bslots);
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_W * 4);
v4_text_constant(&tx, ">IN", TO_IN);
v4_text_constant(&tx, "SPAN", SPAN);
v4_text_constant(&tx, "WBUF", WBUF_W * 4);
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_W * 4);
v4_text_constant(&tx, "(D)", DVARS);
v4_text_constant(&tx, "(CG)", CGVARS);
v4_text_constant(&tx, "CG-BSLOTS", (v4_cell)bslots);
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));
CHECK(v4_text_assemble_file(&tx, V4_CAPSULE_DIR "/codegen.v4"), "codegen.v4 assembles: %s", v4_text_error(&tx));
{
static const char *const files[] = { "core.v4", "input.v4", "dict.v4", "codegen.v4" };
CHECK(host_load(&tx, &n, files, 4), "the capsule assembles");
}
CHECK(v4_text_finish(&tx), "everything is defined: %s", v4_text_error(&tx));
CHECK(v4_text_here(&tx) < DICT_W, "code stays below the dictionary space");
printf(" code: %ld words\n", (long)v4_text_here(&tx) - 16);
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);
v4/tests/test_host_input.c
+6 -33
View File
@@ -37,24 +37,8 @@ static int failures = 0, checks = 0;
#define CANARY ((v4_cell)0x0C0FFEE5)
#define MAXU ((v4_ucell)~(v4_ucell)0)
/* The memory map is open (D-4); the test puts everything at the top. */
#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) /* six cells */
#define WBUF_W (TOP - 90) /* 65 cells = 260 bytes, with cells free on each side */
#define WBUF_CELLS 65
#define TIB_W (TOP - 360) /* 260 cells = 1040 bytes */
#define SBUF_W (TOP - 440) /* 64 cells = 256 bytes for the tests' own strings */
#define WBUF (WBUF_W * 4)
#define TIB (TIB_W * 4)
#define SBUF (SBUF_W * 4)
#define GUARD ((v4_cell)0x5EED5EED)
#include "host_map.h"
static v4_node n;
static v4_exec_state es;
@@ -226,21 +210,10 @@ int main(void)
printf("v4 host input 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);
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));
{
static const char *const files[] = { "core.v4", "input.v4" };
CHECK(host_load(&tx, &n, files, 2), "the capsule assembles");
}
/* the in-line names, as words the test can call */
CHECK(v4_text_assemble(&tx, ": 'TIB TIB ; : '>IN >IN ; : 'SPAN SPAN ; : 'BL BL ;"), "wrappers: %s", v4_text_error(&tx));
CHECK(v4_text_finish(&tx), "everything is defined: %s", v4_text_error(&tx));
@@ -540,7 +513,7 @@ int main(void)
/* What they leave their caller (D-2). */
headroom("WORD", setup_line, 1, 32, 0, 0, 1, 3, 3);
headroom("NUMBER", setup_number, 1, SBUF, 0, 0, 2, 2, 3);
headroom("NUMBER", setup_number, 1, SBUF, 0, 0, 2, 2, 2);
headroom("EXPECT", setup_expect, 2, SBUF + 40, 20, 0, 0, 3, 4);
headroom("ENCLOSE", setup_number, 2, SBUF, 32, 0, 4, 2, 4);