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_exec.c
+117 -11
View File
@@ -265,7 +265,12 @@ static void test_unext(void)
static void test_retirement(void)
{
fresh();
for (unsigned op = 0; op < V4_OPCODE_COUNT; op++) v4_exec_op(&n, &es, &h, op, 0, 0);
for (unsigned op = 0; op < V4_OPCODE_COUNT; op++) {
/* each opcode finds what it takes on the stacks, and room (D-16) */
v4_dstack_reset(&n.ds); v4_rstack_reset(&n.rs);
dpush(1); dpush(2); rpush(5);
v4_exec_op(&n, &es, &h, op, 0, 0);
}
for (unsigned op = 0; op < V4_OPCODE_COUNT; op++)
CHECK(h.op[op] == 1, "opcode %u retires once", op);
CHECK(es.anticlock == V4_OPCODE_COUNT, "one anticlock tick per opcode");
@@ -312,14 +317,113 @@ static void test_soak(void)
if ((seed >> 60) == 0) dpush((v4_cell)(seed >> 7));
v4_exec_op(&n, &es, &h, safe[(seed >> 33) % (sizeof safe / sizeof safe[0])], 0, 0);
}
CHECK(es.anticlock == count, "soak retired every opcode");
CHECK(es.anticlock + n.faults == count && n.faults > 0 && es.anticlock > 0,
"soak: every opcode retired or faulted (%u faults)", n.faults);
CHECK(v4_node_guards_intact(&n), "soak left the guards intact");
}
#define HANDLER ((v4_cell)40)
/* D-16: the stacks are guarded. An opcode that would pop an empty stack,
* read a T or S that is not there, or push onto a full stack is a fault: it
* does nothing, both stacks are emptied, and P is that kind's word of the
* handler table. */
static void test_stack_faults(void)
{
/* what each opcode needs on the data and return stacks, and which it adds one to */
static const struct { unsigned op, dneed, rneed, dgrow, rgrow; const char *name; } m[] = {
{ V4_OP_SEMI, 0, 1, 0, 0, ";" }, { V4_OP_EX, 0, 1, 0, 0, "ex" }, { V4_OP_JUMP, 0, 0, 0, 0, "jump" },
{ V4_OP_CALL, 0, 0, 0, 1, "call" }, { V4_OP_UNEXT, 0, 1, 0, 0, "unext" }, { V4_OP_NEXT, 0, 1, 0, 0, "next" },
{ V4_OP_IF, 1, 0, 0, 0, "if" }, { V4_OP_MINUS_IF, 1, 0, 0, 0, "-if" },
{ V4_OP_FETCH_P, 0, 0, 1, 0, "@p" }, { V4_OP_FETCH_INC, 0, 0, 1, 0, "@+" }, { V4_OP_FETCH_B, 0, 0, 1, 0, "@b" },
{ V4_OP_FETCH_A, 0, 0, 1, 0, "@" }, { V4_OP_STORE_P, 1, 0, 0, 0, "!p" }, { V4_OP_STORE_INC, 1, 0, 0, 0, "!+" },
{ V4_OP_STORE_B, 1, 0, 0, 0, "!b" }, { V4_OP_STORE_A, 1, 0, 0, 0, "!" }, { V4_OP_MUL_STEP, 2, 0, 0, 0, "+*" },
{ V4_OP_TWO_STAR, 1, 0, 0, 0, "2*" }, { V4_OP_TWO_SLASH, 1, 0, 0, 0, "2/" }, { V4_OP_INV, 1, 0, 0, 0, "inv" },
{ V4_OP_ADD, 2, 0, 0, 0, "+" }, { V4_OP_AND, 2, 0, 0, 0, "and" }, { V4_OP_XOR, 2, 0, 0, 0, "xor" },
{ V4_OP_DROP, 1, 0, 0, 0, "drop" }, { V4_OP_DUP, 1, 0, 1, 0, "dup" }, { V4_OP_RPOP, 0, 1, 1, 0, "pop" },
{ V4_OP_OVER, 2, 0, 1, 0, "over" }, { V4_OP_PUSH_A, 0, 0, 1, 0, "a" }, { V4_OP_NOP, 0, 0, 0, 0, "nop" },
{ V4_OP_PUSH, 1, 0, 0, 1, "push" }, { V4_OP_BANG_B, 1, 0, 0, 0, "b!" }, { V4_OP_BANG_A, 1, 0, 0, 0, "a!" },
};
unsigned k, i;
CHECK(sizeof m / sizeof m[0] == V4_OPCODE_COUNT, "every opcode is in the table");
for (k = 0; k < sizeof m / sizeof m[0]; k++) {
unsigned dd, rd;
/* every depth of both stacks: the opcode faults exactly when the table says */
for (dd = 0; dd <= V4_DATA_DEPTH; dd++)
for (rd = 0; rd <= V4_RET_DEPTH; rd += (rd == 2 ? V4_RET_DEPTH - 3u : 1u)) {
unsigned want = 99, before;
fresh();
v4_node_fault_attach(&n, HANDLER);
for (i = 0; i < dd; i++) dpush((v4_cell)(100 + i));
for (i = 0; i < rd; i++) rpush((v4_cell)(200 + i));
n.a = 7; n.b = 8; n.p = 3;
if (dd < m[k].dneed) want = V4_FAULT_DATA_UNDER;
else if (rd < m[k].rneed) want = V4_FAULT_RET_UNDER;
else if (m[k].dgrow && dd == V4_DATA_DEPTH) want = V4_FAULT_DATA_OVER;
else if (m[k].rgrow && rd == V4_RET_DEPTH) want = V4_FAULT_RET_OVER;
before = h.op[m[k].op];
v4_exec_op(&n, &es, &h, m[k].op, 0, 0);
if (want == 99) {
CHECK(n.faults == 0 && h.op[m[k].op] == before + 1, "%s with %u and %u on the stacks runs", m[k].name, dd, rd);
continue;
}
CHECK(n.faults == 1 && n.fault_kind == want, "%s with %u and %u on the stacks: fault %u (got %u)", m[k].name, dd, rd, want, n.fault_kind);
CHECK(n.p == HANDLER + (v4_cell)want && !n.stopped, "%s: P is that kind's handler", m[k].name);
CHECK(h.op[m[k].op] == before, "%s: it did not retire", m[k].name);
CHECK(n.rs.depth == 0 && n.ds.depth == 0, "%s: both stacks are emptied", m[k].name);
CHECK(n.a == 7 && n.b == 8, "%s: A and B untouched", m[k].name);
}
}
/* the rest of the word does not run, and the handler does */
fresh(); v4_node_fault_attach(&n, HANDLER);
n.mem[HANDLER + V4_FAULT_DATA_UNDER] = word6(V4_OP_PUSH_A, V4_OP_PUSH_A, V4_OP_ADD, NOP, NOP, NOP);
n.a = 21; dpush(5);
n.mem[0] = word6(V4_OP_DROP, V4_OP_DROP, V4_OP_PUSH_A, V4_OP_PUSH_A, NOP, NOP); n.p = 0;
CHECK(v4_exec_step_word(&n, &es, &h) == 1 && n.ds.depth == 0 && n.p == HANDLER + (v4_cell)V4_FAULT_DATA_UNDER, "a second drop faults; nothing after it runs");
CHECK(v4_exec_step_word(&n, &es, &h) == 6 && n.ds.t == 42 && n.ds.depth == 1, "the handler runs on the emptied stack");
/* ten pushes fit, the eleventh faults; nine calls fit, the tenth faults */
fresh(); v4_node_fault_attach(&n, HANDLER);
for (i = 0; i < V4_DATA_DEPTH; i++) { n.a = (v4_cell)i; v4_exec_op(&n, &es, &h, V4_OP_PUSH_A, 0, 0); }
CHECK(n.faults == 0 && n.ds.depth == V4_DATA_DEPTH && n.ds.t == (v4_cell)(V4_DATA_DEPTH - 1u), "the data stack holds %u", (unsigned)V4_DATA_DEPTH);
v4_exec_op(&n, &es, &h, V4_OP_PUSH_A, 0, 0);
CHECK(n.faults == 1 && n.fault_kind == V4_FAULT_DATA_OVER, "one more is a fault");
fresh(); v4_node_fault_attach(&n, HANDLER);
for (i = 0; i < V4_RET_DEPTH; i++) v4_exec_op(&n, &es, &h, V4_OP_CALL, 0, 0);
CHECK(n.faults == 0 && n.rs.depth == V4_RET_DEPTH, "the return stack holds %u", (unsigned)V4_RET_DEPTH);
v4_exec_op(&n, &es, &h, V4_OP_CALL, 0, 0);
CHECK(n.faults == 1 && n.fault_kind == V4_FAULT_RET_OVER && n.rs.depth == 0, "one more call is a fault");
/* with no handler the node stops */
fresh();
CHECK(run1(V4_OP_DROP) == 0 && n.stopped && n.fault_kind == V4_FAULT_DATA_UNDER, "with no handler a stack fault stops the node");
/* the stack registers */
fresh(); v4_node_fault_attach(&n, HANDLER);
v4_node_stack_regs_attach(&n, 900, 901);
n.mem[900] = 55; n.mem[901] = 66;
dpush(1); dpush(2); dpush(3); rpush(7); rpush(8);
n.a = 900; v4_exec_op(&n, &es, &h, V4_OP_FETCH_A, 0, 0);
CHECK(n.ds.t == 3 && n.ds.depth == 4, "DSTACK-DEPTH reads the depth, its own push not counted");
n.b = 901; v4_exec_op(&n, &es, &h, V4_OP_FETCH_B, 0, 0);
CHECK(n.ds.t == 2 && n.ds.depth == 5, "RSTACK-DEPTH reads the return stack's");
v4_exec_op(&n, &es, &h, V4_OP_STORE_B, 0, 0);
CHECK(n.rs.depth == 0 && n.ds.depth == 4 && n.mem[901] == 66, "a store to RSTACK-DEPTH empties the return stack and writes no memory");
v4_exec_op(&n, &es, &h, V4_OP_STORE_A, 0, 0);
CHECK(n.ds.depth == 0 && n.mem[900] == 55, "a store to DSTACK-DEPTH empties the data stack");
n.a = 900; v4_exec_op(&n, &es, &h, V4_OP_FETCH_A, 0, 0);
CHECK(n.ds.t == 0 && n.ds.depth == 1 && n.faults == 0, "and it then reads 0");
v4_node_reset(&n);
CHECK(n.dstack_reg == -1 && n.rstack_reg == -1, "reset detaches the stack registers");
n.mem[900] = 55; n.a = 900; v4_exec_op(&n, &es, &h, V4_OP_FETCH_A, 0, 0);
CHECK(n.ds.t == 55, "detached, the address is memory");
}
/* D-14: an address outside node memory is a fault. The opcode does nothing,
* the rest of its word is not executed, and P becomes the handler; with no
* handler the node stops. */
#define HANDLER ((v4_cell)40)
static void test_address_faults(void)
{
static const v4_cell bad[] = { -1, (v4_cell)V4_NODE_WORDS, (v4_cell)V4_NODE_WORDS + 1, MINC, MAXC, (v4_cell)(V4_NODE_WORDS * 4u) };
@@ -343,7 +447,7 @@ static void test_address_faults(void)
CHECK(n.faults == 1 && n.fault_addr == bad[i] && !n.stopped, "%s at %lld is a fault", m[k].name, (long long)bad[i]);
CHECK(n.p == HANDLER, "%s: P is the handler", m[k].name);
CHECK(retired == 1, "%s: only the dup before it retired (%u)", m[k].name, retired);
CHECK(n.ds.t == 22 && n.ds.s == 22, "%s: it neither pushed nor popped, and the drops after it did not run", m[k].name);
CHECK(n.ds.depth == 0 && n.rs.depth == 0, "%s: both stacks are emptied", m[k].name);
CHECK(n.a == (m[k].reg == 'a' ? bad[i] : 7) && n.b == (m[k].reg == 'b' ? bad[i] : 7), "%s: A and B untouched", m[k].name);
CHECK(v4_node_guards_intact(&n), "%s: guards intact", m[k].name);
}
@@ -387,11 +491,11 @@ static void test_address_faults(void)
/* the handler runs, and faults are counted */
fresh(); v4_node_fault_attach(&n, HANDLER);
n.mem[HANDLER] = word6(V4_OP_DUP, V4_OP_ADD, NOP, NOP, NOP, NOP);
n.mem[HANDLER] = word6(V4_OP_PUSH_A, V4_OP_PUSH_A, V4_OP_ADD, NOP, NOP, NOP);
dpush(21); n.a = -1; run1(V4_OP_FETCH_A);
CHECK(v4_exec_step_word(&n, &es, &h) == 6 && n.ds.t == 42, "the handler's code runs next");
n.a = -1; run1(V4_OP_FETCH_A); n.a = -1; run1(V4_OP_STORE_A);
CHECK(n.faults == 3, "each fault is counted");
CHECK(v4_exec_step_word(&n, &es, &h) == 6 && n.ds.t == -2 && n.ds.depth == 1, "the handler's code runs next, on empty stacks");
n.a = -1; run1(V4_OP_FETCH_A); dpush(1); n.a = -1; run1(V4_OP_STORE_A);
CHECK(n.faults == 3 && n.fault_kind == V4_FAULT_ADDRESS, "each fault is counted");
v4_node_fault_attach(&n, HANDLER);
CHECK(n.faults == 0 && n.fault_vector == HANDLER, "attaching clears the count");
@@ -399,9 +503,10 @@ static void test_address_faults(void)
fresh();
CHECK(n.fault_vector == -1 && n.faults == 0 && !n.stopped, "a fresh node has no handler and has not stopped");
dpush(9); n.a = -1;
CHECK(run1(V4_OP_FETCH_A) == 0 && n.stopped && n.faults == 1 && n.ds.t == 9, "with no handler a fault stops the node");
n.mem[0] = word6(V4_OP_DUP, V4_OP_ADD, NOP, NOP, NOP, NOP); n.p = 0;
CHECK(v4_exec_step_word(&n, &es, &h) == 0 && n.p == 0 && n.ds.t == 9, "a stopped node executes nothing");
CHECK(run1(V4_OP_FETCH_A) == 0 && n.stopped && n.faults == 1 && n.ds.depth == 0, "with no handler a fault stops the node");
n.a = 9;
n.mem[0] = word6(V4_OP_PUSH_A, V4_OP_PUSH_A, V4_OP_ADD, NOP, NOP, NOP); n.p = 0;
CHECK(v4_exec_step_word(&n, &es, &h) == 0 && n.p == 0 && n.ds.depth == 0, "a stopped node executes nothing");
v4_node_fault_attach(&n, HANDLER);
CHECK(!n.stopped && v4_exec_step_word(&n, &es, &h) == 6 && n.ds.t == 18, "attaching a handler lets it run again");
v4_node_fault_attach(&n, (v4_cell)V4_NODE_WORDS);
@@ -436,6 +541,7 @@ int main(void)
#if V4_CELL_BITS == 64
test_iword_in_wide_cell();
#endif
test_stack_faults();
test_address_faults();
test_soak();