rajamesandClaude Opus 5.5
0da7e32a0b
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>
153 lines
6.6 KiB
Plaintext
153 lines
6.6 KiB
Plaintext
\ quit.v4 -- the prompt: lines read from the console and interpreted, one
|
|
\ after another, for as long as the node runs; and the words that print text
|
|
\ written in the source.
|
|
\
|
|
\ DECOMPOSITION.md 5.15 and 5.10: QUIT ABORT ABORT" (ABORT") ." (."). Part of
|
|
\ the compiler capsule. Rests on all the files before it.
|
|
\
|
|
\ WHAT THE CONSOLE SHOWS, as v3:
|
|
\ ok> 65 EMIT the prompt, then the line as it is typed
|
|
\ A ok what the line printed, then " ok"
|
|
\ ok> NOSUCH
|
|
\ UNKNOWN WORD: 'NOSUCH'
|
|
\ ERROR any line that sets NODE-ERROR ends so
|
|
\ ok> -1 @
|
|
\ Address out of range an address fault (D-14), from any depth
|
|
\ ERROR
|
|
\ The line itself is not sent back: the terminal shows what is typed.
|
|
\
|
|
\ 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. 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"
|
|
OK: drop $6B6F20 (EMIT4) CR jump READ \ " ok"
|
|
GO: drop
|
|
READ:
|
|
$203E6B6F (EMIT4) \ "ok> "
|
|
QUERY
|
|
0 NODE-ERROR b! !b
|
|
INTERPRET
|
|
NODE-ERROR b! @b if GOOD
|
|
drop 2 jump (REPL)
|
|
GOOD: drop 1 jump (REPL)
|
|
|
|
\ 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 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 R-CLEAR DSTACK-DEPTH b! a !b (RESET) 1 jump (REPL)
|
|
|
|
\ ---- 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
|
|
\ (input.v4's (PARSE)); with no closing " it is the rest of the line. Inside a definition they lay
|
|
\ down a call to their run-time word and, after it, the text as a counted
|
|
\ string: the count byte and the characters, four to a cell, the last cell
|
|
\ filled with zeros. The run-time word finds the string by the return
|
|
\ address the call left, and returns to the cell after the string.
|
|
|
|
\ ( -- ) lay the counted string in WBUF into the dictionary, as above.
|
|
\ (Q)+0 how many bytes are still to go, (Q)+1 which is next.
|
|
: (STRING,)
|
|
(FLUSH)
|
|
WBUF C@ 1 + (Q) a! ! 0 (Q)+1 a! !
|
|
L: (Q) a! @ if DONE -1 + !
|
|
(Q)+1 a! @ dup 1 + ! WBUF + C@ C,
|
|
jump L
|
|
DONE: drop
|
|
P: DP b! @b 3 and if ALIGNED drop 0 C, jump P
|
|
ALIGNED: drop ;
|
|
|
|
\ The run time of ." : print the string after the call, go on after it.
|
|
\ It takes the return address off before it calls anything and keeps the
|
|
\ count there instead, so a word that prints text goes no deeper than one
|
|
\ that calls any other word.
|
|
: (.")
|
|
pop 4* dup C@ \ baddr n
|
|
L: if DONE
|
|
push 1 + dup C@ EMIT pop -1 + jump L
|
|
DONE: drop 4/ 1 + push ; \ the cell after the last character
|
|
|
|
\ FORTH-79: ." text" prints the text -- now, if interpreting; when the word
|
|
\ it is compiled into runs, if compiling.
|
|
header ." immediate
|
|
: DOT-QUOTE
|
|
34 (PARSE) drop
|
|
STATE a! @ if NOW
|
|
drop &(.") (CALL,) jump (STRING,)
|
|
NOW: drop WBUF COUNT jump TYPE
|
|
|
|
\ ( flag -- ) the run time of ABORT" : if the flag is not zero print the
|
|
\ string after the call, start a new line and ABORT; otherwise go on after
|
|
\ the string.
|
|
: (ABORT")
|
|
if NO
|
|
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
|
|
\ the flag is not zero, print the text and ABORT.
|
|
header ABORT" immediate
|
|
: ABORT-QUOTE
|
|
34 (PARSE) drop
|
|
STATE a! @ if NOW
|
|
drop &(ABORT") (CALL,) jump (STRING,)
|
|
NOW: drop if NO
|
|
drop WBUF COUNT TYPE CR jump ABORT
|
|
NO: drop ;
|