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/capsule/forth.v4

@@ -5,7 +5,7 @@
 \ A word flagged inline is copied into a definition in place of a call; the
 \ ones that touch the return stack are compile-only as well.  Rests on core.v4,
 \ compile.v4's loader constants, and quit.v4, which the division words leave
-\ through when the divisor is zero.  (F) is three cells of scratch for
+\ through when the divisor is zero.  (F) is seven cells of scratch for
 \ this file.
 
 \ ---- stack ----
@@ -19,6 +19,68 @@ header ?DUP             : ?DUP    if Z  dup ;   Z: ;
 header 2DUP inline      : 2DUP    over over ;
 header 2DROP inline     : 2DROP   drop drop ;
 
+\ ---- the stack as a whole (D-16) ----
+\ DEPTH reads the stack register.  PICK and ROLL reach under the top of a
+\ stack that has no addresses: the values above the one wanted are set aside
+\ in (S), and put back.  (F)+3 how many are still to set aside, (F)+4 where
+\ the next goes, (F)+5 the value wanted, (F)+6 how many are set aside.  With nine values and n on the
+\ stack it is full, so until a value has been set aside nothing here pushes
+\ anything while n is still there, and never more than one cell after.
+
+\ FORTH-79: how many values were on the stack before DEPTH
+header DEPTH
+: DEPTH   DSTACK-DEPTH b! @b ;
+
+\ ( name -- )   "xxxx: Invalid index", and the line ends with ERROR
+: (INDEX)
+  R-CLEAR  (EMIT4)  $6E49203A (EMIT4) $696C6176 (EMIT4) $6E692064 (EMIT4) $786564 (EMIT4) CR
+  2 jump (REPL)
+
+\ ( x1 .. xn-1 -- )   A: n, which is 2 or more.  Set the n-1 values above
+\ the n-th aside.  If there are not that many, the pop that finds the stack
+\ empty is a fault: "Stack underflow".  The count is taken down only after a
+\ value has been set aside, when there is room to do the arithmetic.
+: (DIG)
+  (F)+3 b!  a !b
+  (F)+4 b!  (S) !b
+  (F)+6 b!  0 !b
+  L: (F)+4 b! @b a!  !+
+     a (F)+4 b! !b
+     (F)+6 b! @b 1 + !b
+     (F)+3 b! @b -1 + dup !b
+     -1 + if DONE  drop jump L
+  DONE: drop ;
+\ ( -- x1 .. xk )   put them back.  The test that ends it pushes one cell:
+\ after the last value is back the stack may be one short of full.
+: (BURY)
+  L: (F)+6 b! @b if DONE  -1 + !b
+     (F)+4 a! @ -1 + dup !  a! @
+     jump L
+  DONE: drop ;
+
+\ ( n -- x )   FORTH-79: a copy of the n-th value, not counting n itself.
+\ 1 PICK is DUP, 2 PICK is OVER.  n less than one is an error.
+header PICK
+: PICK
+  -if POS  jump BAD
+  POS: if BAD
+  a!  a 2/ if ONE  drop                      \ n is 1 when half of it is 0
+  (DIG)  dup (F)+5 a! !  (BURY)  (F)+5 a! @ ;
+  ONE: drop dup ;
+  BAD: drop  $4B434950 jump (INDEX)
+
+\ ( n -- )   FORTH-79: the n-th value, not counting n itself, is taken out
+\ and put on top.  3 ROLL is ROT, 2 ROLL is SWAP, 1 ROLL does nothing.  n
+\ less than one is an error.
+header ROLL
+: ROLL
+  -if POS  jump BAD
+  POS: if BAD
+  a!  a 2/ if ONE  drop
+  (DIG)  (F)+5 a! !  (BURY)  (F)+5 a! @ ;
+  ONE: drop ;
+  BAD: drop  $4C4C4F52 jump (INDEX)
+
 \ ---- return stack: in line, and only inside a definition ----
 header >R inline compile-only   : >R    push ;
 header R> inline compile-only   : R>    pop ;
@@ -56,11 +118,14 @@ header 2/ inline        : TWO/    2/ ;
 \ does anything else, and a zero divisor prints v3's message --
 \     /: Division by zero
 \ -- and ends the line with ERROR, from however deep, as an address fault
-\ does.  Nothing is left for the word's caller: it is not returned to.
+\ does.  The word's operands are taken off the stack, as v3 takes them, and
+\ its caller is not returned to.
 
-\ ( name -- )   name is up to four characters of the word's name (EMIT4)
+\ ( name2 name1 -- )   the word's name: its first four characters, and the
+\ rest or 0 (EMIT4).  The return stack is emptied before anything is called:
+\ the word may have been run with it full.
 : (DIV0)
-  (EMIT4)  $6944203A (EMIT4) $69736976 (EMIT4) $62206E6F (EMIT4)      \ ": Division b"
+  R-CLEAR  (EMIT4) (EMIT4)  $6944203A (EMIT4) $69736976 (EMIT4) $62206E6F (EMIT4)      \ ": Division b"
   $657A2079 (EMIT4) $6F72 (EMIT4) CR                                  \ "y zero"
   2 jump (REPL)
 
@@ -119,27 +184,27 @@ header M*
 header /MOD
 : /MOD  ( n1 n2 -- rem quot )
   if Z  push S>D pop jump SM/REM
-  Z: $444F4D2F jump (DIV0)
+  Z: drop drop  0 $444F4D2F jump (DIV0)
 header /
 : /     ( n1 n2 -- quot )
   if Z  push S>D pop SM/REM  NIP ;
-  Z: $2F jump (DIV0)
+  Z: drop drop  0 $2F jump (DIV0)
 header MOD
 : MOD   ( n1 n2 -- rem )
   if Z  push S>D pop SM/REM  drop ;
-  Z: $444F4D jump (DIV0)
+  Z: drop drop  0 $444F4D jump (DIV0)
 header */MOD
 : */MOD ( n1 n2 n3 -- rem quot )
   if Z  jump (*/MOD)
-  Z: $4F4D2F2A (EMIT4)  $44 jump (DIV0)
+  Z: drop drop drop  $44 $4F4D2F2A jump (DIV0)
 header */
 : */    ( n1 n2 n3 -- quot )
   if Z  (*/MOD)  NIP ;
-  Z: $2F2A jump (DIV0)
+  Z: drop drop drop  0 $2F2A jump (DIV0)
 header M/MOD
 : M/MOD ( d n -- rem quot )
   if Z  jump SM/REM
-  Z: $4F4D2F4D (EMIT4)  $44 jump (DIV0)
+  Z: drop drop drop  $44 $4F4D2F4D jump (DIV0)
 
 \ ---- logic and comparison ----
 header AND inline       : AND     and ;