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

feat(v4.0.0): the stacks are guarded (D-16); DEPTH, PICK and ROLL

Browse Source 
Ruled 2026-10-04, revising D-2: stack overflow and underflow are errors
that are shown and return to the prompt, not silent wrap-around.

- Each stack counts what it holds.  Before every opcode the executor
  checks that the stacks hold what it takes and have room for what it
  leaves; otherwise the opcode does nothing and the node faults, as for a
  bad address, to that kind's handler.  Every fault empties both stacks.
- The fault handler is now a table of five jumps: address, data overflow,
  data underflow, return overflow, return underflow.  The host node says
  "Stack overflow", "Stack underflow", "Return stack overflow",
  "Return stack underflow", then ERROR and the prompt.
- Two registers, DSTACK-DEPTH and RSTACK-DEPTH: a fetch reads the depth,
  a store empties the stack.  QUIT, ABORT and the error exits empty the
  return stack before they call anything; ABORT empties the data stack.
- capsule/forth.v4: DEPTH, PICK and ROLL, to FORTH-79 (counting from
  one).  PICK and ROLL set the values above the one wanted aside in
  memory, and work with the stack full.
- Division by zero now takes its operands off the stack, as v3 does.
- A colon with no room for its entry abandons the line.
- tests: every opcode at every depth of both stacks; the faults, the
  registers and the three words from the prompt.

The sizes are unchanged: ten values, nine return entries.

Co-Authored-By: Claude Opus 5.5 <noreply@anthropic.com>
This commit is contained in:
rajames
2026-10-04 17:31:18 -04:00
co-authored by Claude Opus 5.5
parent 361dcd1148
commit 0da7e32a0b
16 changed files with 542 additions and 106 deletions
Download Patch File Download Diff File Expand all files Collapse all files
v4/tests/test_host_quit.c
+71 -14
View File
@@ -22,6 +22,13 @@
* - 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,
* 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.
* - PICK and ROLL count from one, as FORTH-79 has them: 1 PICK is DUP and
* 3 ROLL is ROT. v3's count from zero.
*/
#include "v4/text.h"
#include "v4/testcode.h"
@@ -84,6 +91,12 @@ static void boot_with(unsigned depth)
(void)run_until_waiting(100000);
}
static void boot(void) { boot_with(0); }
/* The same with nothing at all on the data stack. */
static void boot_bare(void)
{
boot();
v4_dstack_reset(&n.ds);
}
/* While the node waits for a character, EXPECT's own cells are on top of the
* data stack. Pop them: true if the canary is under no more than four. */
@@ -106,12 +119,6 @@ static const char *say(const char *input)
out[n.console_len] = 0;
return out;
}
/* A whole session from switch-on. */
static const char *session(const char *input)
{
boot();
return say(input);
}
static void show(const char *label, const char *s)
{
printf(" %s\"", label);
@@ -154,7 +161,45 @@ static const transcript script[] = {
{ "1 1 0 */MOD\n", "*/MOD: Division by zero\n ERROR\nok> ", 1 },
{ ": T 1 0 / 65 EMIT ; T 66 EMIT\n67 EMIT\n", "/: Division by zero\n ERROR\nok> C ok\nok> ", 1 },
{ "0 0 /\n7 2 / 48 + EMIT\n", "/: Division by zero\n ERROR\nok> 3 ok\nok> ", 1 },
{ "DEPTH 48 + EMIT 5 6 DEPTH 48 + EMIT\n", "02 ok\nok> ", 1 },
{ "1 2 3 NOSUCH\nDEPTH 48 + EMIT\n", "UNKNOWN WORD: 'NOSUCH'\n ERROR\nok> 3 ok\nok> ", 1 },
{ "5 6 7 1 0 MOD\nDEPTH 48 + EMIT\n", "MOD: Division by zero\n ERROR\nok> 3 ok\nok> ", 1 },
{ "5 6 7 1 1 0 */MOD\nDEPTH 48 + EMIT\n", "*/MOD: Division by zero\n ERROR\nok> 3 ok\nok> ", 1 },
{ "1 2 3 ABORT\nDEPTH 48 + EMIT\n", " ok\nok> 0 ok\nok> ", 1 },
/* v4's own */
{ "1 2 3 QUIT\nDEPTH 48 + EMIT\n", "\nok> 3 ok\nok> ", 0 },
{ "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 },
{ "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 },
{ "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 },
{ "65 66 67 1 ROLL EMIT EMIT EMIT\n", "CBA ok\nok> ", 0 },
{ "65 66 67 2 ROLL EMIT EMIT EMIT\n", "BCA ok\nok> ", 0 },
{ "65 66 67 3 ROLL EMIT EMIT EMIT\nDEPTH 48 + EMIT\n", "ACB ok\nok> 0 ok\nok> ", 0 },
{ "65 66 0 PICK\nDEPTH 48 + EMIT\n", "PICK: Invalid index\n ERROR\nok> 2 ok\nok> ", 0 },
{ "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 },
@@ -194,7 +239,7 @@ int main(void)
w_quit = v4_text_word(&tx, "QUIT");
w_key = v4_text_word(&tx, "KEY");
w_key_end = v4_text_word(&tx, "CR"); /* the word after KEY in core.v4 */
w_fault = v4_text_word(&tx, "(FAULT)");
w_fault = v4_text_word(&tx, "(FAULTS)");
capsule_latest = v4_text_latest(&tx);
CHECK(w_key_end > w_key && w_key_end - w_key <= 12, "KEY is the few words before CR");
@@ -208,7 +253,8 @@ int main(void)
/* ---- the sessions ---- */
for (i = 0; i < NSCRIPT; i++) {
const transcript *t = &script[i];
CHECK(is(session(t->in), t->want), "%ssession %u", t->v3 ? "v3: " : "", i);
boot_bare();
CHECK(is(say(t->in), t->want), "%ssession %u", t->v3 ? "v3: " : "", i);
CHECK(n.mem[STATE] == 0, "session %u ends interpreting", i);
}
@@ -329,26 +375,26 @@ int main(void)
CHECK(is(say("L1 69 EMIT\n"), " ok\nok> "), "ABORT out of two loops, time %u", i);
CHECK(is(say(": SQ DUP * ; 7 SQ EMIT\n"), "1 ok\nok> "), "and the next line compiles and runs, time %u", i);
}
CHECK(canary_under_expect(), "none of it disturbed the data stack");
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 would overwrite the first (D-2), so
* it is not tried here. */
* nine return entries. A ninth word is a fault (D-16). */
{
unsigned deepest = 0;
for (i = 0; i <= 7; i++) {
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+ ;\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));
if (!is(say(line), want)) break;
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");
}
/* and with text printed at the bottom of the chain */
boot();
@@ -390,6 +436,17 @@ int main(void)
CHECK(d >= 3, "the prompt leaves room on the data stack");
}
/* ---- the fault table: five words, each a jump to its handler ---- */
{
static const char *const handler[] = { "(FAULT)", "(D-OVER)", "(D-UNDER)", "(R-OVER)", "(R-UNDER)" };
for (i = 0; i < V4_FAULT_KINDS; i++) {
v4_iword w = (v4_iword)((v4_ucell)n.mem[w_fault + (v4_cell)i] & 0xFFFFFFFFu);
CHECK(v4_iword_op(w, 0) == V4_OP_JUMP && v4_iword_branch(w_fault + (v4_cell)i + 1, w, 0) == v4_text_word(&tx, handler[i]),
"word %u of the fault table jumps to %s", i, handler[i]);
}
CHECK(n.fault_vector == w_fault, "and the node has it");
}
CHECK(v4_node_guards_intact(&n), "guards intact");
printf(" %d checks, %d failures\n", checks, failures);