feat(v4.0.0): the host node's stacks are 32 deep (D-17)

With the stacks counted and guarded (D-16) their size is a parameter of
the node.  The host node, which runs the interpreter and the compiler
under the user's programme, gets 32 values and 32 return entries; a mesh
node keeps the F18's 10 and 9.  Nothing else about the mechanism or any
word's definition changes.

- stack.h: V4_DATA_RING and V4_RET_RING are build parameters; the
  Makefile sets them for the host-node tests.
- tests/test_host_quit.c no longer assumes a size: it fills the stacks to
  whatever they are, and takes every exit with the return stack full.
- Measured on the host node now: 28 values on a line, 29 waiting between
  lines, words 31 deep from the prompt.

Co-Authored-By: Claude Opus 5.5 <noreply@anthropic.com>
This commit is contained in:
rajames
2026-10-04 18:29:10 -04:00
co-authored by Claude Opus 5.5
parent 0da7e32a0b
commit ebffa6082d
8 changed files with 133 additions and 58 deletions
+91 -33
View File
@@ -22,8 +22,9 @@
* - QUERY takes 80 characters (FORTH-79); v3's line is 255.
* - an address outside memory says so (D-14); v3 gives ERROR alone.
* - M/MOD by zero says so (D-15); v3 gives ERROR alone.
* - the stacks hold ten values and nine return entries, and one more is
* an error (D-16); v3's are far deeper. A stack fault names the stack,
* - the host node's stacks hold 32 values and 32 return entries (D-17),
* and one more is an error (D-16). This file is written for whatever
* size it is built with. A stack fault names the stack,
* not the word: "Stack underflow" where v3 says "DROP: Stack underflow".
* - any fault empties the data stack; v3 keeps what the failing word had
* not taken.
@@ -171,13 +172,12 @@ static const transcript script[] = {
{ "65 EMIT DROP 66 EMIT\n67 EMIT\n", "AStack underflow\n ERROR\nok> C ok\nok> ", 0 },
{ "+\n1 +\nDUP\nOVER\n1 OVER\n", "Stack underflow\n ERROR\nok> Stack underflow\n ERROR\nok> Stack underflow\n ERROR\nok> "
"Stack underflow\n ERROR\nok> Stack underflow\n ERROR\nok> ", 0 },
{ "1 2 3 4 5 6 7 8 9 10 11\nDEPTH 48 + EMIT\n", "Stack overflow\n ERROR\nok> 0 ok\nok> ", 0 },
{ ": OV 1 2 3 4 5 6 7 8 65 EMIT 9 10 11 66 EMIT ; OV\nDEPTH 48 + EMIT\n", "AStack overflow\n ERROR\nok> 0 ok\nok> ", 0 },
{ ": OV 65 EMIT 1000 0 DO I LOOP 66 EMIT ; 7 8 9 OV\nDEPTH 48 + EMIT\n", "AStack overflow\n ERROR\nok> 0 ok\nok> ", 0 },
{ "1 2 3 -1 @\nDEPTH 48 + EMIT\n", "Address out of range\n ERROR\nok> 0 ok\nok> ", 0 },
{ ": RU R> DROP R> DROP ; 65 EMIT RU 66 EMIT\n67 EMIT\n", "AReturn stack underflow\n ERROR\nok> C ok\nok> ", 0 },
{ ": N0 65 EMIT ; : N1 N0 ; : N2 N1 ; : N3 N2 ; : N4 N3 ; : N5 N4 ; : N6 N5 ;\n: N7 N6 ; N6 N7 66 EMIT\n67 EMIT\n",
" ok\nok> AReturn stack overflow\n ERROR\nok> C ok\nok> ", 0 },
{ ": DEEP 1 >R 2 >R 3 >R 4 >R 5 >R 6 >R 65 EMIT 7 >R 8 >R 66 EMIT ; DEEP\n", "AReturn stack overflow\n ERROR\nok> ", 0 },
/* a word that runs itself, through EXECUTE, until the return stack is full */
{ "VARIABLE V : RR V @ EXECUTE ; ' RR V ! 65 EMIT RR 66 EMIT\n67 EMIT\n", "AReturn stack overflow\n ERROR\nok> C ok\nok> ", 0 },
{ ": DEEP 65 EMIT BEGIN 1 >R AGAIN ; DEEP\n", "AReturn stack overflow\n ERROR\nok> ", 0 },
{ "65 66 67 1 PICK EMIT EMIT EMIT EMIT\n", "CCBA ok\nok> ", 0 },
{ "65 66 67 2 PICK EMIT EMIT EMIT EMIT\n", "BCBA ok\nok> ", 0 },
{ "65 66 67 3 PICK EMIT EMIT EMIT EMIT\n", "ACBA ok\nok> ", 0 },
@@ -188,18 +188,11 @@ static const transcript script[] = {
{ "65 66 -3 ROLL\n65 66 0 ROLL\n", "ROLL: Invalid index\n ERROR\nok> ROLL: Invalid index\n ERROR\nok> ", 0 },
{ "65 66 3 PICK\nDEPTH 48 + EMIT\n", "Stack underflow\n ERROR\nok> 0 ok\nok> ", 0 },
{ "65 66 5 ROLL\n1 PICK\n", "Stack underflow\n ERROR\nok> Stack underflow\n ERROR\nok> ", 0 },
/* nine values and n: the stack is full when PICK and ROLL start */
{ ": P9 65 2 3 4 5 6 7 8 9 9 PICK >R 2DROP 2DROP 2DROP 2DROP R> EMIT EMIT ; P9\n", "AA ok\nok> ", 0 },
{ ": R9 65 2 3 4 5 6 7 8 9 9 ROLL EMIT 2DROP 2DROP 2DROP DROP 48 + EMIT ; R9\n", "A2 ok\nok> ", 0 },
{ "65 66 67 68 69 5 ROLL EMIT EMIT EMIT EMIT EMIT\n", "AEDCB ok\nok> ", 0 },
{ "65 66 67 68 69 4 ROLL EMIT EMIT EMIT EMIT EMIT\n", "BEDCA ok\nok> ", 0 },
{ ": P5 65 66 67 68 69 5 PICK EMIT 3 PICK EMIT EMIT EMIT EMIT EMIT EMIT ; P5\n", "ACEDCBA ok\nok> ", 0 },
{ ": T1 QUIT ; : T2 1 2 3 4 T1 ; T2\nDEPTH 48 + EMIT\n", "\nok> 4 ok\nok> ", 0 },
{ ": T3 1 2 3 4 5 6 7 8 9 ABORT ; T3\nDEPTH 48 + EMIT\n", " ok\nok> 0 ok\nok> ", 0 },
/* with the return stack full or nearly: the exit empties it before it prints */
{ ": B0 1 ABORT\" d\" ; : B1 B0 ; : B2 B1 ; : B3 B2 ; : B4 B3 ; : B5 B4 ; : B6 B5 ;\nB6\n", " ok\nok> d\n ok\nok> ", 0 },
{ ": I0 5 0 PICK ; : I1 I0 ; : I2 I1 ; : I3 I2 ; : I4 I3 ; : I5 I4 ; : I6 I5 ; I6\n", "PICK: Invalid index\n ERROR\nok> ", 0 },
{ ": J0 5 0 / ; : J1 J0 ; : J2 J1 ; : J3 J2 ; : J4 J3 ; : J5 J4 ; : J6 J5 ; J6\n", "/: Division by zero\n ERROR\nok> ", 0 },
{ "1 0 0 M/MOD\n", "M/MOD: Division by zero\n ERROR\nok> ", 0 },
{ ": Z0 0 / ; : Z1 65 EMIT 9 Z0 66 EMIT ; Z1\n: Z2 1 IF [ 5 0 MOD ]\nZ2\n",
"A/: Division by zero\n ERROR\nok> MOD: Division by zero\n ERROR\nok> UNKNOWN WORD: 'Z2'\n ERROR\nok> ", 0 },
@@ -378,24 +371,89 @@ int main(void)
CHECK(is(say("DEPTH 48 + EMIT\n"), "0 ok\nok> "), "ABORT has emptied the data stack");
/* ---- how deep words may call each other from the prompt ----
* N7 is eight words deep; with the prompt's call of INTERPRET that is all
* nine return entries. A ninth word is a fault (D-16). */
* The prompt's call of INTERPRET is one return entry, so a chain of words
* one shorter than the return stack runs, and the next is a fault. */
{
unsigned deepest = 0;
for (i = 0; i <= 8; i++) {
char line[64], want[16];
boot();
if (!is(say(": N0 1+ ; : N1 N0 1+ ; : N2 N1 1+ ; : N3 N2 1+ ; : N4 N3 1+ ;\n"), " ok\nok> ")) break;
if (!is(say(": N5 N4 1+ ; : N6 N5 1+ ; : N7 N6 1+ ; : N8 N7 1+ ;\n"), " ok\nok> ")) break;
snprintf(line, sizeof line, "47 N%u EMIT 33 EMIT\n", i);
snprintf(want, sizeof want, "%c! ok\nok> ", (char)('0' + i));
char line[64], want[16];
boot();
CHECK(is(say(": N0 1+ ;\n"), " ok\nok> "), "a word that calls nothing");
for (i = 1; i <= V4_RET_DEPTH; i++) {
snprintf(line, sizeof line, ": N%u N%u 1+ ;\n", i, i - 1u);
CHECK(is(say(line), " ok\nok> "), "and one that calls it, %u deep", i + 1u);
}
for (i = 0; i <= V4_RET_DEPTH; i++) {
snprintf(line, sizeof line, "33 N%u EMIT 33 EMIT\n", i);
snprintf(want, sizeof want, "%c! ok\nok> ", (char)(34 + i));
if (strcmp(say(line), want) != 0) break;
deepest = i + 1;
}
printf(" from the prompt, words may call each other %u deep\n", deepest);
CHECK(deepest == 8, "a word run from the prompt has all the return stack but the prompt's one entry");
CHECK(is(out, "Return stack overflow\n ERROR\nok> "), "and a ninth is reported");
CHECK(deepest == V4_RET_DEPTH - 1u, "a word run from the prompt has all the return stack but the prompt's one entry");
CHECK(is(out, "Return stack overflow\n ERROR\nok> "), "and one more is reported");
}
/* ---- the exits, taken with the return stack full ----
* RR runs itself through EXECUTE; each level holds one return entry, and
* EXECUTE one more while it starts the next. With C at its largest and
* one >R besides, there is room for exactly the action's own call. An
* exit that did not empty the return stack before it printed would
* overflow it. */
{
static const struct { const char *action, *want; } e[] = {
{ "1 ABORT\" x\"", "x\n ok\nok> " },
{ "5 0 PICK", "PICK: Invalid index\n ERROR\nok> " },
{ "5 0 ROLL", "ROLL: Invalid index\n ERROR\nok> " },
{ "5 0 /", "/: Division by zero\n ERROR\nok> " },
{ "5 5 0 */MOD", "*/MOD: Division by zero\n ERROR\nok> " },
{ "ABORT", " ok\nok> " },
{ "QUIT", "\nok> " },
};
char line[96];
for (i = 0; i < sizeof e / sizeof e[0]; i++) {
boot_bare();
CHECK(is(say("VARIABLE V VARIABLE C\n"), " ok\nok> "), "two variables");
snprintf(line, sizeof line, ": RR C @ 1- DUP C ! IF V @ EXECUTE EXIT THEN 1 >R %s ;\n", e[i].action);
CHECK(is(say(line), " ok\nok> "), "a word that runs itself C times and then: %s", e[i].action);
snprintf(line, sizeof line, "' RR V ! %u C ! RR\n", (unsigned)(V4_RET_DEPTH - 3u));
CHECK(is(say(line), e[i].want), "%s with the return stack full", e[i].action);
CHECK(n.faults == 0, "%s: and it was not a fault", e[i].action);
CHECK(is(say("65 EMIT\n"), "A ok\nok> "), "and the next line runs");
/* one level more and the action's own call does not fit */
snprintf(line, sizeof line, "%u C ! RR\n", (unsigned)(V4_RET_DEPTH - 2u));
CHECK(is(say(line), "Return stack overflow\n ERROR\nok> "), "%s one level deeper is a return stack overflow", e[i].action);
}
}
/* ---- the data stack, full ----
* P1 P2 P4 P8 P16 push that many values and call nothing while they do, so
* a word can fill the stack to any depth in a short line. */
{
char line[128], want[32], fill[64];
unsigned c, bit;
#define FILL(count) do { size_t at_ = 0; fill[0] = 0; \
for (c = (count), bit = 16; bit; bit >>= 1) if (c >= bit) { at_ += (size_t)snprintf(fill + at_, sizeof fill - at_, "P%u ", bit); c -= bit; } \
for (; c >= 16; c -= 16) at_ += (size_t)snprintf(fill + at_, sizeof fill - at_, "P16 "); } while (0)
boot_bare();
CHECK(is(say(": P1 7 ; : P2 7 7 ; : P4 7 7 7 7 ; : P8 7 7 7 7 7 7 7 7 ;\n"), " ok\nok> ")
&& is(say(": P16 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 ;\n"), " ok\nok> "), "words that push 1, 2, 4, 8 and 16 values");
/* 65, then DEPTH-2 more, then n = DEPTH-1: the stack is full when PICK and ROLL start */
FILL(V4_DATA_DEPTH - 2u);
snprintf(line, sizeof line, ": PF 65 %s%u PICK >R DROP R> EMIT ABORT ; PF\n", fill, (unsigned)(V4_DATA_DEPTH - 1u));
CHECK(is(say(line), "A ok\nok> ") && n.faults == 0, "PICK of the deepest value of a full stack");
snprintf(line, sizeof line, ": RF 65 %s%u ROLL EMIT DROP DEPTH 33 + EMIT ABORT ; RF\n", fill, (unsigned)(V4_DATA_DEPTH - 1u));
snprintf(want, sizeof want, "A%c ok\nok> ", (char)(33 + V4_DATA_DEPTH - 3u));
CHECK(is(say(line), want) && n.faults == 0, "ROLL of the deepest value of a full stack");
/* exactly full is not a fault; one more is */
FILL(V4_DATA_DEPTH);
snprintf(line, sizeof line, ": F1 %s2DROP ABORT ; F1\n", fill);
CHECK(is(say(line), " ok\nok> ") && n.faults == 0, "a stack exactly full is not a fault");
snprintf(line, sizeof line, ": F2 %s7 ; F2\n", fill);
CHECK(is(say(line), "Stack overflow\n ERROR\nok> ") && n.fault_kind == V4_FAULT_DATA_OVER, "one value more is");
CHECK(is(say("DEPTH 48 + EMIT\n"), "0 ok\nok> "), "and the stack is empty afterwards");
#undef FILL
}
/* and with text printed at the bottom of the chain */
boot();
CHECK(is(say(": P0 .\" deep\" ; : P1 P0 ; : P2 P1 ; : P3 P2 ; : P4 P3 ; P4\n"), "deep ok\nok> "), ".\" five calls down");
@@ -403,22 +461,22 @@ int main(void)
/* ---- how many values may wait on the stack from one line to the next ---- */
{
unsigned k, most = 0;
for (k = 1; k <= 9; k++) {
char line[96], want[16];
for (k = 1; k < V4_DATA_DEPTH; k++) {
char line[4 * V4_DATA_DEPTH + 16], want[16];
size_t at = 0;
unsigned m;
boot();
for (m = 0; m < k; m++) at += (size_t)snprintf(line + at, sizeof line - at, "%u ", m + 1);
boot_bare();
for (m = 0; m < k; m++) at += (size_t)snprintf(line + at, sizeof line - at, "1 ");
snprintf(line + at, sizeof line - at, "\n");
if (strcmp(say(line), " ok\nok> ") != 0) break;
for (at = 0, m = 1; m < k; m++) at += (size_t)snprintf(line + at, sizeof line - at, "+ ");
snprintf(line + at, sizeof line - at, "32 + EMIT\n");
snprintf(want, sizeof want, "%c ok\nok> ", (char)(32 + k * (k + 1) / 2));
if (strcmp(say(line), want) != 0 || !canary_under_expect()) break;
snprintf(want, sizeof want, "%c ok\nok> ", (char)(32 + k));
if (strcmp(say(line), want) != 0) break;
most = k;
}
printf(" %u values may wait on the stack while the next line is typed\n", most);
CHECK(most >= 6, "reading a line leaves most of the stack to the user");
printf(" %u values may wait on the stack while the next line is typed and interpreted\n", most);
CHECK(most + 4u >= V4_DATA_DEPTH, "the prompt and the interpreter take no more than four cells of the stack");
}
/* ---- how much of the data stack a line has ---- */