feat(v4.0.0): the prompt -- QUIT, ABORT, ABORT" and ."

Layer 5 of the compiler capsule.  The host node is now started at QUIT and
left running: it prompts, reads a line from its console with QUERY,
interprets it, says " ok" or " ERROR", and goes round again.

- capsule/quit.v4: QUIT and ABORT (FORTH-79), ABORT" and (ABORT") as v3 has
  them, ." and (.") (FORTH-79).  Text is compiled as a counted string after
  the call; the run-time word returns to the cell after it.
- INTERPRET prints v3's messages before abandoning a line:
  UNKNOWN WORD: 'xxx' and xxx: compile-only.
- core.v4: CR SPACE COUNT TYPE, as DECOMPOSITION.md gives them.
- input.v4: WORD split so that (PARSE) can take text without skipping
  leading delimiters (." " is an empty string); EXPECT keeps its place in
  memory, so six values may wait on the stack while a line is typed.
- tests/test_host_quit.c: the node is fed characters and its output read;
  16 sessions are transcripts of the v3 binary.

QUIT stops the line from inside any word and says nothing; v3's goes on
with the line and cannot be compiled.  v3's compiled ABORT" crashes.

Co-Authored-By: Claude Opus 5.5 <noreply@anthropic.com>
This commit is contained in:
rajames
2026-10-04 11:49:44 -04:00
co-authored by Claude Opus 5.5
parent 806f876ee0
commit b5d644d498
8 changed files with 555 additions and 29 deletions
+15 -5
View File
@@ -43,8 +43,9 @@ macro ROT push SWAP pop SWAP endmacro
\ ( -- ) give up the line: stop compiling, forget the word being built and
\ whatever control structures were open, skip the rest of the input, and set
\ NODE-ERROR. A definition that was under way stays hidden. (QUIT will add
\ the message and the stack reset.)
\ NODE-ERROR. A definition that was under way stays hidden. It returns to
\ whatever called INTERPRET, which is QUIT (quit.v4): QUIT sees NODE-ERROR
\ and prints ERROR.
: (ABANDON)
0 STATE a! ! (CG-RESET)
CFBASE (CFP) a! !
@@ -92,6 +93,9 @@ macro ROT push SWAP pop SWAP endmacro
dup -3 + a! @ 8 and if CALL drop jump (INLINE,)
CALL: drop jump (CALL,)
\ ( -- ) print the word WORD has just left
: (.WORD) WBUF COUNT jump TYPE
header EXECUTE
: EXECUTE ( xt -- ) push ;
@@ -128,7 +132,8 @@ header EXECUTE
\ A word in the dictionary is executed, or, when compiling and not immediate,
\ compiled. Anything else must be a number in the current BASE: it is left
\ on the stack, or compiled as a literal. What is neither, or a compile-only
\ word met while interpreting, abandons the line.
\ word met while interpreting, abandons the line, with v3's message:
\ UNKNOWN WORD: 'xxx' xxx: compile-only
header INTERPRET
: INTERPRET
L: 32 WORD dup C@ if EOL
@@ -139,13 +144,18 @@ header INTERPRET
drop EXECUTE jump L
COMP: drop (COMPILE,) jump L
INTERP: drop 16 and if RUN
drop drop jump (ABANDON)
drop drop (.WORD) \ ": compile-only"
$6F63203A (EMIT4) $6C69706D (EMIT4) $6E6F2D65 (EMIT4) $796C (EMIT4) CR
jump (ABANDON)
RUN: drop EXECUTE jump L
NUM: drop (NUM?) if BAD
drop
STATE a! @ if KEEP drop (LIT,) jump L
KEEP: drop jump L
BAD: drop drop jump (ABANDON)
BAD: drop drop \ "UNKNOWN WORD: '"
$4E4B4E55 (EMIT4) $204E574F (EMIT4) $44524F57 (EMIT4) $27203A (EMIT4)
(.WORD) 39 EMIT CR
jump (ABANDON)
EOL: drop drop ;
\ ---- state ---------------------------------------------------------------------
+18
View File
@@ -85,6 +85,24 @@ header KEY
L: CONSOLE-STATUS b! @b if WAIT drop CONSOLE-RX b! @b ;
WAIT: drop jump L
header CR
: CR ( -- ) 10 jump EMIT
header SPACE
: SPACE ( -- ) 32 jump EMIT
header COUNT
: COUNT ( baddr -- baddr+1 c ) dup C@ push 1 + pop ;
header TYPE
: TYPE ( baddr u -- )
-if OK drop drop NODE-ERROR b! -1 !b ;
OK: if DONE over C@ EMIT push 1 + pop -1 + jump OK
DONE: drop drop ;
\ ( x -- ) up to four characters packed in one cell, the first in the low
\ byte: how the capsule prints its own short messages, a literal at a time.
: (EMIT4)
L: if DONE dup EMIT 8/ jump L
DONE: drop ;
\ ---- section 5.8: the number base ----------------------------------------
: (BASE) ( -- b ) \ BASE, or 10 when it is outside 2 .. 36
BASE b! @b dup -2 + -if L1 drop drop 10 ;
+33 -14
View File
@@ -27,17 +27,24 @@ header SOURCE
\ must hold n + 1 bytes. No action for n <= 0. SPAN is how many characters
\ were stored (SPAN is not FORTH-79; v3 has it). A line longer than n leaves
\ the rest, its new-line included, to be read next.
\ It is what the prompt reads every line with, with whatever the user has left
\ on the stack beneath it, so it works in (P) -- (P)+0 where the next
\ character goes, (P)+1 how many more may come, (P)+2 where the first went --
\ and has at most three cells of its own on the data stack (D-2).
header EXPECT
: EXPECT
-if NN drop drop ; \ n < 0
NN: if ZERO
over push \ p n R: start
L: if END
push KEY dup -10 + if NL \ p c x R: start n
drop over C! 1 + pop -1 + jump L
NL: drop drop pop
END: drop 0 over C! \ p
pop - SPAN a! ! ;
(P)+1 a! ! dup (P)+2 a! ! (P) a! !
L: (P)+1 a! @ if END drop
KEY dup -10 + if NL drop \ c
(P) a! @ C!
(P) a! @ 1 + ! (P)+1 a! @ -1 + !
jump L
NL: drop drop jump FIN
END: drop
FIN: 0 (P) a! @ C!
(P) a! @ (P)+2 a! @ - SPAN a! ! ;
ZERO: drop drop ;
\ ( -- ) FORTH-79: up to 80 characters, or a line, into TIB; >IN to 0.
@@ -66,15 +73,15 @@ macro (STEP) (P)+6 a! @ 1 + ! endmacro
\ ran out -- is stored after them and is not counted. >IN is left just past
\ that delimiter. With nothing left the count is 0. The count is a byte,
\ so a word longer than 255 characters is cut to 255.
header WORD
: WORD
\ The three parts of WORD. The first is called and returns before anything
\ else is; the last is jumped to; so WORD's calls of C@ and C! are no deeper
\ than if it were written in one piece.
: (WORD-SET) ( c -- )
255 and (P) a! !
SPAN a! @ -if A drop 0 A: (P)+1 a! !
>IN a! @ -if B drop 0 B: (P)+6 a! !
SK: (LEFT) -if SKE drop (CH) if SKS drop jump SKIPPED \ past delimiters
SKS: drop (STEP) jump SK
SKE: drop
SKIPPED:
>IN a! @ -if B drop 0 B: (P)+6 a! ! ;
: (WORD-TAKE) ( -- baddr )
(P)+6 a! @ (P)+7 a! ! \ where it starts
SC: (LEFT) -if SCE drop (CH) if SCE drop (STEP) jump SC \ up to a delimiter
SCE: drop
@@ -94,6 +101,18 @@ header WORD
RANOUT: drop 0 (P)+2 a! @ WBUF+1 + C!
(P)+6 a! @ >IN a! ! WBUF ;
header WORD
: WORD
(WORD-SET)
SK: (LEFT) -if SKE drop (CH) if SKS drop jump (WORD-TAKE) \ past delimiters
SKS: drop (STEP) jump SK
SKE: drop jump (WORD-TAKE)
\ ( c -- baddr ) as WORD, but leading delimiters are not ignored: the text
\ starts at >IN, and may be empty. This is what ." needs: ." " is an
\ empty string, where WORD would step over its closing quote.
: (PARSE) (WORD-SET) jump (WORD-TAKE)
\ ---- ENCLOSE ---------------------------------------------------------------
\ (P)+0 the delimiter, (P)+1 the string's address.
: (E?) ( i -- i k ) \ k: 0 at the end of the string, 1 at a delimiter, else 2
+111
View File
@@ -0,0 +1,111 @@
\ 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
\ 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.
\
\ Constants the loader supplies:
\ (Q) word address of two cells of scratch for this file
\ ( -- ) 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.
: (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 (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".
header ABORT
: ABORT (RESET) 1 jump (REPL)
\ ---- 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* 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 ;