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

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>

v4/src/exec.c

@@ -39,10 +39,51 @@ static int ends_word(unsigned op)
 static int faulted(v4_node *n, v4_cell addr)
 {
     if (v4_node_addr_ok(addr)) return 0;
-    v4_node_fault(n, addr);
+    v4_node_fault(n, V4_FAULT_ADDRESS, addr);
     return 1;
 }
 
+/* D-16: what each opcode takes from the stacks and leaves on them.  If the
+ * data stack holds fewer than `dneed`, or the return stack fewer than
+ * `rneed`, or a stack the opcode leaves one more on is full, it is a fault
+ * and the opcode does nothing.  An opcode that only looks at T (`if`) or at
+ * T and S (`+*`) needs them to be there. */
+static int stack_faulted(v4_node *n, unsigned op)
+{
+    unsigned dneed = 0, rneed = 0, dgrow = 0, rgrow = 0;
+
+    switch (op) {
+    case V4_OP_SEMI: case V4_OP_EX: case V4_OP_UNEXT: case V4_OP_NEXT:
+        rneed = 1; break;
+    case V4_OP_CALL:
+        rgrow = 1; break;
+    case V4_OP_FETCH_P: case V4_OP_FETCH_INC: case V4_OP_FETCH_B: case V4_OP_FETCH_A: case V4_OP_PUSH_A:
+        dgrow = 1; break;
+    case V4_OP_IF: case V4_OP_MINUS_IF:
+    case V4_OP_STORE_P: case V4_OP_STORE_INC: case V4_OP_STORE_B: case V4_OP_STORE_A:
+    case V4_OP_TWO_STAR: case V4_OP_TWO_SLASH: case V4_OP_INV: case V4_OP_DROP:
+    case V4_OP_BANG_B: case V4_OP_BANG_A:
+        dneed = 1; break;
+    case V4_OP_MUL_STEP: case V4_OP_ADD: case V4_OP_AND: case V4_OP_XOR:
+        dneed = 2; break;
+    case V4_OP_DUP:
+        dneed = 1; dgrow = 1; break;
+    case V4_OP_OVER:
+        dneed = 2; dgrow = 1; break;
+    case V4_OP_RPOP:
+        rneed = 1; dgrow = 1; break;
+    case V4_OP_PUSH:
+        dneed = 1; rgrow = 1; break;
+    default:
+        break;                          /* jump, nop */
+    }
+    if (n->ds.depth < dneed)                         { v4_node_fault(n, V4_FAULT_DATA_UNDER, 0); return 1; }
+    if (n->rs.depth < rneed)                         { v4_node_fault(n, V4_FAULT_RET_UNDER, 0);  return 1; }
+    if (dgrow && n->ds.depth >= V4_DATA_DEPTH)       { v4_node_fault(n, V4_FAULT_DATA_OVER, 0);  return 1; }
+    if (rgrow && n->rs.depth >= V4_RET_DEPTH)        { v4_node_fault(n, V4_FAULT_RET_OVER, 0);   return 1; }
+    return 0;
+}
+
 void v4_exec_reset(v4_exec_state *es)
 {
     es->anticlock = 0;
@@ -55,6 +96,8 @@ void v4_exec_op(v4_node *n, v4_exec_state *es, v4_heat *h,
     v4_rstack *rs = &n->rs;
     v4_cell x;
 
+    if (op <= V4_OP_BANG_A && stack_faulted(n, op)) return;
+
     switch (op) {
     case V4_OP_SEMI:
         n->p = v4_rstack_pop(rs);

v4/src/node.c

@@ -14,6 +14,7 @@ void v4_node_reset(v4_node *n)
     v4_node_console_attach(n, -1);
     v4_node_console_input_attach(n, -1, -1);
     v4_node_fault_attach(n, -1);
+    v4_node_stack_regs_attach(n, -1, -1);
 }
 
 int v4_node_addr_ok(v4_cell addr)
@@ -23,19 +24,29 @@ int v4_node_addr_ok(v4_cell addr)
     return (v4_ucell)addr < (v4_ucell)V4_NODE_WORDS;
 }
 
-void v4_node_fault_attach(v4_node *n, v4_cell handler)
+void v4_node_stack_regs_attach(v4_node *n, v4_cell d, v4_cell r)
 {
-    n->fault_vector = v4_node_addr_ok(handler) ? handler : (v4_cell)-1;
+    n->dstack_reg = d;
+    n->rstack_reg = r;
+}
+
+void v4_node_fault_attach(v4_node *n, v4_cell table)
+{
+    n->fault_vector = (v4_node_addr_ok(table) && v4_node_addr_ok(table + (v4_cell)(V4_FAULT_KINDS - 1u))) ? table : (v4_cell)-1;
     n->fault_addr = 0;
+    n->fault_kind = 0;
     n->faults = 0;
     n->stopped = 0;
 }
 
-void v4_node_fault(v4_node *n, v4_cell addr)
+void v4_node_fault(v4_node *n, unsigned kind, v4_cell addr)
 {
+    n->fault_kind = kind;
     n->fault_addr = addr;
     n->faults++;
-    if (n->fault_vector >= 0) n->p = n->fault_vector;
+    v4_rstack_clear(&n->rs);
+    v4_dstack_clear(&n->ds);
+    if (n->fault_vector >= 0) n->p = n->fault_vector + (v4_cell)kind;
     else n->stopped = 1;
 }
 
@@ -64,6 +75,9 @@ void v4_node_store(v4_node *n, v4_cell addr, v4_cell value)
             n->console_dropped++;
         return;
     }
+    /* The stack registers: a store empties the stack.  -1 when not attached. */
+    if (addr == n->dstack_reg) { v4_dstack_clear(&n->ds); return; }
+    if (addr == n->rstack_reg) { v4_rstack_clear(&n->rs); return; }
     if (!v4_node_addr_ok(addr)) return;
     n->mem[(unsigned)addr] = value;
 }
@@ -81,6 +95,8 @@ v4_cell v4_node_fetch(v4_node *n, v4_cell addr)
         if (n->input_pos == n->input_len) n->input_pos = n->input_len = 0;
         return c;
     }
+    if (addr == n->dstack_reg) return (v4_cell)n->ds.depth;
+    if (addr == n->rstack_reg) return (v4_cell)n->rs.depth;
     return v4_node_load(n, addr);
 }
 

v4/src/stack.c

@@ -33,6 +33,7 @@ void v4_dstack_reset(v4_dstack *st)
     st->t = 0;
     st->s = 0;
     st->head = 0;
+    st->depth = 0;
     for (unsigned i = 0; i < V4_DATA_RING; i++) st->ring[i] = 0;
     v4_guard_fill(st->guard_head, V4_DATA_BOUND, V4_GUARD_PATTERN_HEAD);
     v4_guard_fill(st->guard_tail, V4_DATA_BOUND, V4_GUARD_PATTERN_TAIL);
@@ -50,14 +51,19 @@ void v4_dstack_push(v4_dstack *st, v4_cell x)
     st->s = st->t;
     st->t = x;
     st->head = (st->head + 1u) % V4_DATA_RING;
+    if (st->depth < V4_DATA_DEPTH) st->depth++;
 }
 
+void v4_dstack_clear(v4_dstack *st) { st->depth = 0; }
+void v4_rstack_clear(v4_rstack *st) { st->depth = 0; }
+
 v4_cell v4_dstack_pop(v4_dstack *st)
 {
     v4_cell x = st->t;
     st->t = st->s;
     st->head = (st->head + V4_DATA_RING - 1u) % V4_DATA_RING;
     st->s = st->ring[st->head];
+    if (st->depth > 0) st->depth--;
     return x;
 }
 
@@ -75,6 +81,7 @@ void v4_rstack_reset(v4_rstack *st)
 {
     st->r = 0;
     st->head = 0;
+    st->depth = 0;
     for (unsigned i = 0; i < V4_RET_RING; i++) st->ring[i] = 0;
     v4_guard_fill(st->guard_head, V4_RET_BOUND, V4_GUARD_PATTERN_HEAD);
     v4_guard_fill(st->guard_tail, V4_RET_BOUND, V4_GUARD_PATTERN_TAIL);
@@ -91,6 +98,7 @@ void v4_rstack_push(v4_rstack *st, v4_cell x)
     st->ring[st->head] = st->r;
     st->r = x;
     st->head = (st->head + 1u) % V4_RET_RING;
+    if (st->depth < V4_RET_DEPTH) st->depth++;
 }
 
 v4_cell v4_rstack_pop(v4_rstack *st)
@@ -98,6 +106,7 @@ v4_cell v4_rstack_pop(v4_rstack *st)
     v4_cell x = st->r;
     st->head = (st->head + V4_RET_RING - 1u) % V4_RET_RING;
     st->r = st->ring[st->head];
+    if (st->depth > 0) st->depth--;
     return x;
 }
 

v4/src/testcode.c

@@ -6,6 +6,7 @@ long v4_test_call(v4_node *n, v4_exec_state *es, v4_heat *h,
 {
     long words = 0;
 
+    n->stopped = 0;                             /* a stop left by an earlier call is over */
     v4_rstack_push(&n->rs, V4_TEST_HALT);
     n->p = entry;
     while (n->p != V4_TEST_HALT) {