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:
co-authored by
Claude Opus 5.5
parent
806f876ee0
commit
b5d644d498
+15
-5
@@ -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 ---------------------------------------------------------------------
|
||||
|
||||
@@ -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
@@ -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
|
||||
|
||||
@@ -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 ;
|
||||
Reference in New Issue
Block a user