rajamesandClaude Opus 5.5
25fc5fd5e3
ENGINE.md 3b, the node's side of ruling A (a word's code is the node's, its
accounts the kernel's).
- dict.v4, system.v4: (WORD-DEFINED) ( xt -- ) is run when an entry is
made, (WORD-FORGOTTEN) ( w -- ) when FORGET or COLD removes entries; with
0 there no one is told, as on the hosted product
- test_host_quit.c: a kernel that keeps the list of words and is checked to
hold exactly the node's dictionary after definitions, a vocabulary, an
abandoned definition, FORGET, a refused FORGET and COLD; KERNEL-WORD
called from the prompt and from a definition
Fixed, found while writing that test: since the capsules moved from build
time to boot time (294e6946), what COLD returns to and FORGET protects was
still the nucleus alone, so COLD lost U*, U/MOD and BYE and FORGET U* was
allowed. The boot now seals the system when it has loaded it
(v4_image_seal), and hosted-check checks COLD, the capsule word after it,
the refused FORGET and BYE.
Verified: make -C v4 test passes at both widths (1283 checks in
test_host_quit.c); hosted-check passes on three ISAs; clean qemu with
STARFORTH_V4=1 on amd64, aarch64 and riscv64 passes POST, and COLD, U*
after it, FORGET U* (refused), an unserved kernel word and BYE typed at
each prompt are answered correctly (logs/20261005-193045, -193307, -193636).
Co-Authored-By: Claude Opus 5.5 <noreply@anthropic.com>
242 lines
12 KiB
Plaintext
242 lines
12 KiB
Plaintext
\ quit.v4 -- a line of text, interpreted; how it ends; 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.
|
|
\
|
|
\ A NODE IS HANDED A LINE (docs/v4.0.0/ENGINE.md 3.1). It does not read its
|
|
\ own command line and prints no prompt: that is its host's, as it is the
|
|
\ kernel's REPL's for a v3 VM. The host puts the text in TIB and starts
|
|
\ (LINE); the node interprets it and stops at (IDLE), having left in the
|
|
\ variable (LINE-STATUS) how the line ended:
|
|
\ 1 it completed the host says " ok"
|
|
\ 2 it ended in an error the message is already printed; " ERROR"
|
|
\ 0 QUIT nothing is said
|
|
\ What the console then shows is v3's:
|
|
\ ok> 65 EMIT the host's prompt, and the line
|
|
\ A ok what the line printed, then the host's " ok"
|
|
\ ok> NOSUCH
|
|
\ UNKNOWN WORD: 'NOSUCH'
|
|
\ ERROR
|
|
\ ok> -1 @
|
|
\ Address out of range an address fault (D-14), from any depth
|
|
\ ERROR
|
|
\ KEY, EXPECT and QUERY are FORTH-79 words that read characters, as before;
|
|
\ they are not how a line reaches the node.
|
|
\
|
|
\ 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:
|
|
\ (LINE-STATUS) word address of the variable: how the last line ended
|
|
\ (Q) word address of four cells of scratch, which system.v4 and
|
|
\ blocks.v4 use too
|
|
\ 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! ! ;
|
|
|
|
\ CATCHING A LINE'S ERROR. While the variable (CATCH) is not zero, a line
|
|
\ that ends in an error -- a fault, or a code in NODE-ERROR -- does not say
|
|
\ ERROR: (CATCH) is set to -1 and the line is reported as completed. Whatever message the
|
|
\ error printed has gone wherever EMIT was sending it. POST uses this to
|
|
\ go on to its next case, and to check the cases that must fail
|
|
\ (docs/v4.0.0/NUCLEUS.md 6.3). (EMIT-HOOK), core.v4, is set to 0 here at
|
|
\ the end of every line, caught or not.
|
|
\
|
|
\ ( k -- ) the line is over. It is entered with how -- 0 QUIT, 1 completed,
|
|
\ anything else an error -- and never returns: it leaves that in
|
|
\ (LINE-STATUS) and stops at (IDLE), where the host finds the node. It is
|
|
\ always jumped to, never called, by something that has emptied the return
|
|
\ stack (or by a fault, which empties it).
|
|
: (IDLE) L: jump L
|
|
|
|
: (DONE)
|
|
(EMIT-HOOK) b! 0 !b \ the console is the console again
|
|
if GO -1 + if OK
|
|
drop (RESET)
|
|
(CATCH) b! @b if LOUD drop -1 !b 1 jump (DONE) \ caught: the line completed
|
|
LOUD: drop 2 (LINE-STATUS) b! !b jump (IDLE)
|
|
OK: drop 1 (LINE-STATUS) b! !b jump (IDLE)
|
|
GO: drop 0 (LINE-STATUS) b! !b jump (IDLE)
|
|
|
|
\ ( -- ) THE LINE ENTRY. The host has put a line of text in TIB, a zero
|
|
\ after it, and its length in SPAN, has emptied the return stack and set P
|
|
\ here. The line is interpreted with one return entry under it, this
|
|
\ word's call of INTERPRET; whatever is on the data stack stays there.
|
|
: (LINE)
|
|
0 BLK a! ! \ the terminal, whatever was being loaded
|
|
TIB (SRC) a! ! 0 >IN a! !
|
|
0 NODE-ERROR b! !b
|
|
INTERPRET
|
|
NODE-ERROR b! @b if GOOD
|
|
drop 2 jump (DONE)
|
|
GOOD: drop 1 jump (DONE)
|
|
|
|
\ 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.
|
|
\ NODE-ERROR, by name: how a definition written in FORTH raises an error.
|
|
\ A store of a code that is not zero is the trap of D-18 -- the word goes no
|
|
\ further, the message for the code is printed (-1: the word has printed
|
|
\ its own) and the line ends with ERROR. The codes are listed in core.v4.
|
|
header NODE-ERROR inline : NODE-ERROR' NODE-ERROR ;
|
|
header (CATCH) inline : (CATCH)' (CATCH) ;
|
|
header (WORD-DEFINED) inline : (WORD-DEFINED)' (WORD-DEFINED) ;
|
|
header (WORD-FORGOTTEN) inline : (WORD-FORGOTTEN)' (WORD-FORGOTTEN) ;
|
|
header (EMIT-HOOK) inline : (EMIT-HOOK)' (EMIT-HOOK) ;
|
|
|
|
header QUIT
|
|
: QUIT R-CLEAR (RESET) CR 0 jump (DONE)
|
|
|
|
\ 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 (DONE)
|
|
|
|
\ ---- 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 (DONE)
|
|
: (D-OVER) \ "Stack overflow"
|
|
$63617453 (EMIT4) $766F206B (EMIT4) $6C667265 (EMIT4) $776F (EMIT4) CR
|
|
2 jump (DONE)
|
|
: (D-UNDER) \ "Stack underflow"
|
|
$63617453 (EMIT4) $6E75206B (EMIT4) $66726564 (EMIT4) $776F6C (EMIT4) CR
|
|
2 jump (DONE)
|
|
: (R-OVER) \ "Return stack overflow"
|
|
$75746552 (EMIT4) $73206E72 (EMIT4) $6B636174 (EMIT4) $65766F20 (EMIT4) $6F6C6672 (EMIT4) $77 (EMIT4) CR
|
|
2 jump (DONE)
|
|
: (R-UNDER) \ "Return stack underflow"
|
|
$75746552 (EMIT4) $73206E72 (EMIT4) $6B636174 (EMIT4) $646E7520 (EMIT4) $6C667265 (EMIT4) $776F (EMIT4) CR
|
|
2 jump (DONE)
|
|
|
|
\ A word has stored an error code in NODE-ERROR (D-18; the codes are listed
|
|
\ in core.v4). Print its message -- a negative code means the word printed
|
|
\ its own -- and end the line with ERROR. The return stack has been
|
|
\ emptied; the data stack is as the word left it.
|
|
: (RAISED)
|
|
NODE-ERROR b! @b
|
|
-if POS drop 2 jump (DONE)
|
|
POS: -1 + if M1 -1 + if M2 -1 + if M3 -1 + if M4
|
|
-1 + if M5 -1 + if M6 -1 + if M7 -1 + if M8 -1 + if M9
|
|
-1 + if M10 -1 + if M11 -1 + if M12 -1 + if M13 -1 + if M14
|
|
-1 + if M15 -1 + if M16
|
|
drop 2 jump (DONE)
|
|
M1: drop $6167654E (EMIT4) $65766974 (EMIT4) $756F6320 (EMIT4) $746E (EMIT4) CR 2 jump (DONE)
|
|
M2: drop $20746F4E (EMIT4) $756E2061 (EMIT4) $7265626D (EMIT4) CR 2 jump (DONE)
|
|
M3: drop $626D754E (EMIT4) $74207265 (EMIT4) $6C206F6F (EMIT4) $676E6F (EMIT4) CR 2 jump (DONE)
|
|
M4: drop $20746F4E (EMIT4) $68632061 (EMIT4) $63617261 (EMIT4) $726574 (EMIT4) CR 2 jump (DONE)
|
|
M5: drop $74636944 (EMIT4) $616E6F69 (EMIT4) $66207972 (EMIT4) $6C6C75 (EMIT4) CR 2 jump (DONE)
|
|
M6: drop $656D614E (EMIT4) $73696D20 (EMIT4) $676E6973 (EMIT4) CR 2 jump (DONE)
|
|
M7: drop $746E6F43 (EMIT4) $206C6F72 (EMIT4) $75727473 (EMIT4) $72757463 (EMIT4) $696D2065 (EMIT4) $74616D73 (EMIT4) $6863 (EMIT4) CR 2 jump (DONE)
|
|
M8: drop $746E6F43 (EMIT4) $206C6F72 (EMIT4) $75727473 (EMIT4) $72757463 (EMIT4) $74207365 (EMIT4) $64206F6F (EMIT4) $706565 (EMIT4) CR 2 jump (DONE)
|
|
M9: drop $66696853 (EMIT4) $6F632074 (EMIT4) $20746E75 (EMIT4) $2074756F (EMIT4) $7220666F (EMIT4) $65676E61 (EMIT4) CR 2 jump (DONE)
|
|
M10: drop $746F7250 (EMIT4) $65746365 (EMIT4) $6F772064 (EMIT4) $6472 (EMIT4) CR 2 jump (DONE)
|
|
M11: drop $69766944 (EMIT4) $6E6F6973 (EMIT4) $20796220 (EMIT4) $6F72657A (EMIT4) CR 2 jump (DONE)
|
|
M12: drop $75677241 (EMIT4) $746E656D (EMIT4) $74756F20 (EMIT4) $20666F20 (EMIT4) $676E6172 (EMIT4) $65 (EMIT4) CR 2 jump (DONE)
|
|
M13: drop $636F6C42 (EMIT4) $756F206B (EMIT4) $666F2074 (EMIT4) $6E617220 (EMIT4) $6567 (EMIT4) CR 2 jump (DONE)
|
|
M14: drop $62206F4E (EMIT4) $6B636F6C (EMIT4) $20736920 (EMIT4) $6E696562 (EMIT4) $6F6C2067 (EMIT4) $64656461 (EMIT4) CR 2 jump (DONE)
|
|
M15: drop $65666544 (EMIT4) $64657272 (EMIT4) $726F7720 (EMIT4) $6F6E2064 (EMIT4) $65732074 (EMIT4) $74 (EMIT4) CR 2 jump (DONE)
|
|
M16: drop $20746F4E (EMIT4) $6F772061 (EMIT4) $6472 (EMIT4) CR 2 jump (DONE)
|
|
|
|
\ The table the loader gives the node: six 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) jump (RAISED)
|
|
|
|
\ ---- text in the source ---------------------------------------------------------
|
|
\ The three run-time words have names, as v3's have, so that SEE can tell a
|
|
\ string in a definition from code; they cannot be used from the prompt.
|
|
\ ." 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.
|
|
header (.") compile-only
|
|
: (.")
|
|
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.
|
|
header (ABORT") compile-only
|
|
: (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 ;
|
|
|
|
\ The run time of S" : leave the address and length of the string after the
|
|
\ call, and go on after it.
|
|
header (S") compile-only
|
|
: (S")
|
|
pop 4* dup C@ \ baddr n
|
|
over over + 4/ 1 + push \ the cell after the last character
|
|
push 1 + pop ; \ baddr+1 n
|
|
|
|
\ ( -- baddr u ) S" text" as v3. In a definition the text is compiled
|
|
\ into it. At the prompt it is copied to PAD, where it stays until PAD is
|
|
\ used again: WORD's buffer is overwritten by the very next word of the line.
|
|
header S" immediate
|
|
: S-QUOTE
|
|
34 (PARSE) drop
|
|
STATE a! @ if NOW
|
|
drop &(S") (CALL,) jump (STRING,)
|
|
NOW: drop WBUF+1 PAD WBUF C@ CMOVE PAD WBUF jump C@
|