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>
This commit is contained in:
rajames
co-authored by
Claude Opus 5.5
Claude Opus 5.5
parent
361dcd1148
commit
0da7e32a0b
@@ -17,8 +17,8 @@
|
||||
\ compile-only it may not be executed by the interpreter.
|
||||
\ An immediate word is executed even when compiling.
|
||||
\
|
||||
\ THE STACKS ARE SHORT (D-2): ten cells of data, nine return entries, and no
|
||||
\ way to see how full they are. The interpreter and compiler run on the same
|
||||
\ THE STACKS ARE SHORT (D-2): ten cells of data, nine return entries, and one
|
||||
\ more of either is a fault (D-16). The interpreter and compiler run on the same
|
||||
\ stacks as the user's words, with the user's values beneath them, so:
|
||||
\ - every word here keeps what it works on in (C), and has at most three
|
||||
\ cells of its own on the data stack at any moment;
|
||||
@@ -184,7 +184,7 @@ header :
|
||||
32 WORD (HEADER)
|
||||
LATEST (C)+2 a! @ xor if NONE drop
|
||||
HIDDEN (CG-RESET) CFBASE (CFP) a! ! jump RIGHT-BRACKET
|
||||
NONE: drop ;
|
||||
NONE: drop jump (ABANDON) \ no entry: the rest of the line is not a definition
|
||||
|
||||
\ FORTH-79: compile the return, let the word be found, stop compiling
|
||||
header ; immediate compile-only
|
||||
|
||||
+75
-10
@@ -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 ;
|
||||
|
||||
+45
-16
@@ -16,21 +16,29 @@
|
||||
\ ERROR
|
||||
\ The line itself is not sent back: the terminal shows what is typed.
|
||||
\
|
||||
\ THE RETURN STACK is circular (D-2): it has no bottom to be reset to, and
|
||||
\ what is on it is simply never returned to once QUIT stops returning. So
|
||||
\ QUIT and ABORT "clear" it by jumping into the loop, from however deep. The
|
||||
\ data stack is circular too: ABORT has nothing to clear.
|
||||
\ THE STACKS are guarded (D-16): each counts what it holds, and a push onto
|
||||
\ a full one or a pop from an empty one is a fault. So QUIT and ABORT, which
|
||||
\ never return to whatever ran them, must empty the return stack, and ABORT
|
||||
\ the data stack too. A store to RSTACK-DEPTH or DSTACK-DEPTH does that.
|
||||
\
|
||||
\ Constants the loader supplies:
|
||||
\ (Q) word address of two cells of scratch for this file
|
||||
\ DSTACK-DEPTH RSTACK-DEPTH word addresses of the stack registers
|
||||
|
||||
\ ( -- ) empty the return stack. `a` is only something to store: any
|
||||
\ store to the register empties the stack, and `a` needs nothing to be on
|
||||
\ the data stack. One cell of the data stack is used for a moment.
|
||||
macro R-CLEAR RSTACK-DEPTH b! a !b endmacro
|
||||
|
||||
\ ( -- ) stop compiling; forget the word being built and any open control
|
||||
\ structures. A definition that was under way stays hidden.
|
||||
: (RESET) 0 STATE a! ! (CG-RESET) CFBASE (CFP) a! ! ;
|
||||
|
||||
\ ( k -- ) the loop. It is entered with what to say first -- 0 nothing,
|
||||
\ 1 " ok", anything else " ERROR" -- and never returns. Each line is
|
||||
\ interpreted with one return entry under it, this word's call of INTERPRET.
|
||||
\ 1 " ok", anything else " ERROR" -- and never returns. It is always jumped
|
||||
\ to, never called, by something that has emptied the return stack (or by a
|
||||
\ fault, which empties it). Each line is then interpreted with one return
|
||||
\ entry under it, this word's call of INTERPRET.
|
||||
: (REPL)
|
||||
if GO -1 + if OK
|
||||
drop (RESET) $52524520 (EMIT4) $524F (EMIT4) CR jump READ \ " ERROR"
|
||||
@@ -48,21 +56,42 @@
|
||||
\ FORTH-79: clear the return stack, set execution mode, return control to
|
||||
\ the terminal; no message is given. The data stack is left as it is.
|
||||
header QUIT
|
||||
: QUIT (RESET) CR 0 jump (REPL)
|
||||
: QUIT R-CLEAR (RESET) CR 0 jump (REPL)
|
||||
|
||||
\ FORTH-79: clear the data and return stacks, set execution mode, return
|
||||
\ control to the terminal. As v3, the line it stops ends with " ok".
|
||||
\ Both are emptied before anything is called: ABORT may be run with the
|
||||
\ return stack full.
|
||||
header ABORT
|
||||
: ABORT (RESET) 1 jump (REPL)
|
||||
: ABORT R-CLEAR DSTACK-DEPTH b! a !b (RESET) 1 jump (REPL)
|
||||
|
||||
\ ( -- ) where the node goes when a programme uses an address outside its
|
||||
\ memory (D-14): the loader makes this word the node's fault handler. The
|
||||
\ opcode that faulted did nothing; whatever was running is abandoned, as by
|
||||
\ ABORT, and the line ends with ERROR.
|
||||
: (FAULT)
|
||||
$72646441 (EMIT4) $20737365 (EMIT4) $2074756F (EMIT4) \ "Address out "
|
||||
$7220666F (EMIT4) $65676E61 (EMIT4) CR \ "of range"
|
||||
\ ---- faults (D-14, D-16) -------------------------------------------------------
|
||||
\ Where the node goes when a programme uses an address outside its memory,
|
||||
\ pushes onto a full stack or pops an empty one. The opcode that faulted did
|
||||
\ nothing, and both stacks have been emptied. Each handler says what happened;
|
||||
\ whatever was running is abandoned, as by ABORT, and the line ends with
|
||||
\ ERROR.
|
||||
: (FAULT) \ "Address out of range"
|
||||
$72646441 (EMIT4) $20737365 (EMIT4) $2074756F (EMIT4) $7220666F (EMIT4) $65676E61 (EMIT4) CR
|
||||
2 jump (REPL)
|
||||
: (D-OVER) \ "Stack overflow"
|
||||
$63617453 (EMIT4) $766F206B (EMIT4) $6C667265 (EMIT4) $776F (EMIT4) CR
|
||||
2 jump (REPL)
|
||||
: (D-UNDER) \ "Stack underflow"
|
||||
$63617453 (EMIT4) $6E75206B (EMIT4) $66726564 (EMIT4) $776F6C (EMIT4) CR
|
||||
2 jump (REPL)
|
||||
: (R-OVER) \ "Return stack overflow"
|
||||
$75746552 (EMIT4) $73206E72 (EMIT4) $6B636174 (EMIT4) $65766F20 (EMIT4) $6F6C6672 (EMIT4) $77 (EMIT4) CR
|
||||
2 jump (REPL)
|
||||
: (R-UNDER) \ "Return stack underflow"
|
||||
$75746552 (EMIT4) $73206E72 (EMIT4) $6B636174 (EMIT4) $646E7520 (EMIT4) $6C667265 (EMIT4) $776F (EMIT4) CR
|
||||
2 jump (REPL)
|
||||
|
||||
\ The table the loader gives the node: five words, one for each kind of
|
||||
\ fault in the node's order, each a jump. A jump fills its word, so they
|
||||
\ are one after another.
|
||||
: (FAULTS)
|
||||
jump (FAULT) jump (D-OVER) jump (D-UNDER) jump (R-OVER) jump (R-UNDER)
|
||||
|
||||
\ ---- text in the source ---------------------------------------------------------
|
||||
\ ." and ABORT" take the text up to the next " , which may be none at all
|
||||
@@ -108,7 +137,7 @@ header ." immediate
|
||||
\ the string.
|
||||
: (ABORT")
|
||||
if NO
|
||||
drop pop 4* COUNT TYPE CR jump ABORT
|
||||
drop pop 4* R-CLEAR COUNT TYPE CR jump ABORT
|
||||
NO: drop pop 4* dup C@ + 4/ 1 + push ;
|
||||
|
||||
\ ( flag -- ) ABORT" text" as v3 (it is FORTH-83's, not FORTH-79's): if
|
||||
|
||||
Reference in New Issue
Block a user