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
co-authored by
Claude Opus 5.5
Claude Opus 5.5
parent
806f876ee0
commit
b5d644d498
@@ -570,9 +570,9 @@ width and print a flood of spaces.
|
||||
| `SCAN` `SKIP` | CAP | `( baddr u c -- baddr' u' )`: `SCAN` stops at the first byte equal to the low byte of `c` (or at the end, with `u' = 0`); `SKIP` stops at the first byte not equal to it. See below. A negative count reads as 0, as v3. v3's counted-string auto-detection is not kept. Executed on the golden model (2026-10-03), including a transcript of the v3 binary. Each leaves its caller 5 data cells and 5 return entries. Clobber `A`. |
|
||||
| `(S)` | CAP | Variable, 4 cells: `COMPARE`'s two lengths; `SEARCH`'s string 2 and the whole of string 1. |
|
||||
| `BL` | IN | `32` — executed on the golden model (2026-10-04). |
|
||||
| `EXPECT` `QUERY` | CC | Built on `KEY` (DEV); source in `v4/capsule/input.v4`. FORTH-79 (ruled 2026-10-04). `EXPECT ( baddr n -- )` stores characters from `baddr` upward until a new-line (taken, not stored) or until `n` have been received, then a zero; no action for `n <= 0`; a line longer than `n` leaves the rest to be read next. It also sets `SPAN`, which is not FORTH-79 but is v3's. `QUERY` is `TIB 80 EXPECT 0 >IN !`. v3's `EXPECT` was C's `fgets` and took `n-1` characters, and its `QUERY` took 1024. Executed on the golden model's host node (2026-10-04) against C for every size and line length. `EXPECT` leaves its caller 6 data cells and 4 return entries. |
|
||||
| `EXPECT` `QUERY` | CC | Built on `KEY` (DEV); source in `v4/capsule/input.v4`. FORTH-79 (ruled 2026-10-04). `EXPECT ( baddr n -- )` stores characters from `baddr` upward until a new-line (taken, not stored) or until `n` have been received, then a zero; no action for `n <= 0`; a line longer than `n` leaves the rest to be read next. It also sets `SPAN`, which is not FORTH-79 but is v3's. `QUERY` is `TIB 80 EXPECT 0 >IN !`. v3's `EXPECT` was C's `fgets` and took `n-1` characters, and its `QUERY` took 1024. Executed on the golden model's host node (2026-10-04) against C for every size and line length. `EXPECT` is what the prompt reads every line with, on top of whatever the user has left on the stack, so it keeps where it is in memory: it leaves its caller 7 data cells and 7 return entries. A line of exactly 80 characters fills `QUERY`'s count before its new-line arrives, so the new-line is read as an empty line after it; a longer line is read as 80 characters and then the rest. |
|
||||
| `SPAN` `TIB` `>IN` `SOURCE` | CC | Interpreter state on the host node. `TIB` is the buffer's byte address and `>IN` and `SPAN` their variables' word addresses, all in line; `SOURCE ( -- baddr u )` is `TIB` and `SPAN @`, a negative `SPAN` read as 0. Executed on the golden model's host node (2026-10-04). |
|
||||
| `WORD` `ENCLOSE` | CC | Parser; source in `v4/capsule/input.v4`. `WORD ( c -- baddr )` is FORTH-79 (ruled 2026-10-04): characters are taken from `TIB` until the delimiter `c` or the end of the text, leading delimiters ignored, and stored as a counted string; the delimiter met (`c`, or a zero if the text ran out) is stored after them, uncounted; `>IN` is left just past it; with nothing left the count is 0. The count is a byte, so a word over 255 characters is cut to 255; the buffer is 257 bytes. v3's `WORD` skipped every delimiter after the word, always stored a zero, and cut at 62. `ENCLOSE ( baddr c -- baddr n1 n2 n3 )`, not a FORTH-79 word, works on a zero-terminated string as v3's. Executed on the golden model's host node (2026-10-04) against C, and `ENCLOSE` against values recorded from the v3 binary. `WORD` keeps what it works on in memory and has at most three cells of its own on the data stack: it leaves its caller 7 data cells and 6 return entries. |
|
||||
| `WORD` `ENCLOSE` | CC | Parser; source in `v4/capsule/input.v4`. `WORD ( c -- baddr )` is FORTH-79 (ruled 2026-10-04): characters are taken from `TIB` until the delimiter `c` or the end of the text, leading delimiters ignored, and stored as a counted string; the delimiter met (`c`, or a zero if the text ran out) is stored after them, uncounted; `>IN` is left just past it; with nothing left the count is 0. The count is a byte, so a word over 255 characters is cut to 255; the buffer is 257 bytes. v3's `WORD` skipped every delimiter after the word, always stored a zero, and cut at 62. `ENCLOSE ( baddr c -- baddr n1 n2 n3 )`, not a FORTH-79 word, works on a zero-terminated string as v3's. Executed on the golden model's host node (2026-10-04) against C, and `ENCLOSE` against values recorded from the v3 binary. `WORD` keeps what it works on in memory and has at most three cells of its own on the data stack: it leaves its caller 7 data cells and 6 return entries. `(PARSE) ( c -- baddr )` is `WORD` without the skipping of leading delimiters: the text starts at `>IN` and may be empty. It is what `."` and `ABORT"` use, so that `." "` is an empty string. |
|
||||
| `NUMBER` `CONVERT` | CC | FORTH-79, not v3 (ruled 2026-10-04); source in `v4/capsule/input.v4`. `CONVERT ( d1 baddr1 -- d2 baddr2 )` takes the characters from `baddr1 + 1` on as digits in the current `BASE`, in either case, accumulating each into the double after multiplying it by `BASE`, and stops at the first that is not one; the double is `( lo hi )`. v3's was base 10 only, started at `baddr1`, and took the double low cell on top. `NUMBER ( baddr -- d )` is the counted string as a signed double in the current `BASE`, with an optional leading minus; anything else gives 0 and sets `NODE-ERROR`. v3's returned `( n flag )` in base 10. Executed on the golden model's host node (2026-10-04) against C in eight bases, including a digit that carries out of the low cell. `NUMBER` leaves its caller 3 data cells and 2 return entries; the interpreter does not use it (it has a single-cell conversion of its own that needs far less of the stack). |
|
||||
| `S"` `(s")` `[']` | CC | Compiler words. |
|
||||
| `LITERAL` `[LITERAL]` (placeholders) | RET | The working `LITERAL` is in §5.17. |
|
||||
@@ -653,7 +653,7 @@ width and print a flood of spaces.
|
||||
| `CR` | CAP | `10 EMIT`, as `10 jump EMIT` — executed on the golden model (2026-10-03). Character 10, as v3; the console turns it into a new line. |
|
||||
| `SPACE` | CAP | `BL EMIT`, as `32 jump EMIT` — executed on the golden model (2026-10-03). |
|
||||
| `SPACES` | CAP | `( n -- )`: `-if L drop ; L: if DONE SPACE -1 + jump L DONE: drop ;` — `n` spaces, none for `n <= 0`, as v3. Executed on the golden model (2026-10-03), including a transcript of the v3 binary. Leaves its caller 7 data cells and 7 return entries. Clobbers `B`. |
|
||||
| `."` `(do-string)` | CC | Compiler words. |
|
||||
| `."` `(.")` | CC | FORTH-79; source in `v4/capsule/quit.v4`. `." text"` takes the text up to the next `"` (none at all is allowed; with no closing `"` it is the rest of the line). Interpreting, it prints it. Compiling, it lays a call to `(.")` and after it the text as a counted string — count byte, characters, four to a cell, the last cell filled with zeros. `(.")` finds the string by the return address its call left and returns to the cell after it: `pop 4* dup C@ L: if DONE push 1 + dup C@ EMIT pop -1 + jump L DONE: drop 4/ 1 + push ;`. It takes the return address off before it calls anything, so a word that prints text goes no deeper than one that calls any other word. v3's `(do-string)` has no counterpart. Executed on the golden model's host node (2026-10-04), every length from 0 to 12 and 76, including transcripts of the v3 binary. |
|
||||
|
||||
### 5.11 Blocks and mass storage
|
||||
|
||||
@@ -685,7 +685,7 @@ The storage service belongs to the Artemis role, now a device node.
|
||||
| `'` | CC | `( -- addr )`, FORTH-79: the parameter field address of the next word in the input stream; not found is an error (0, and `NODE-ERROR` set). v3's `'` returned what `FIND` returns. For a word that is code the two are the same address; for a data word the parameter field is the cell after its code, which is what FORTH-79's `n ' NAME !` needs. It is immediate: inside a definition the address is compiled as a literal (FORTH-79), where v3's `'` parsed when the definition ran. Executed on the golden model's host node (2026-10-04). |
|
||||
| `>LINK` `LFA` `LINK>` `>NAME` `NFA` `NAME>` `CFA` `PFA` `>BODY` `TRAVERSE` | CC | The fields of an entry, all reached from its xt, as in v3 where the xt was the entry: `>LINK`/`LFA` the link's address, `LINK>` the older entry's xt, `>NAME`/`NFA` the byte address of the counted name, `NAME>` back to the xt, `CFA` the xt itself, `PFA`/`>BODY` the parameter field, `TRAVERSE` from a name's count byte to past its last character (for `n > 0`; otherwise unchanged, as v3). Executed on the golden model's host node (2026-10-04). |
|
||||
| `SMUDGE` `HIDDEN` | CC | `SMUDGE` toggles the hidden flag of the newest entry; `HIDDEN` sets it. v3 refuses both outside compilation; that check comes with the compiler words. Executed on the golden model's host node (2026-10-04). |
|
||||
| `INTERPRET` | CC | FORTH-79; source in `v4/capsule/compile.v4`. Takes words from the input stream until it is exhausted: a word in the dictionary is executed, or, when compiling and not immediate, compiled; anything else must be a number in the current `BASE` (a single cell, with an optional leading minus), left on the stack or compiled as a literal. What is neither, or a compile-only word met while interpreting, abandons the line: compiling stops, the definition under way stays hidden, the rest of the input is skipped and `NODE-ERROR` is set (the message and the stack reset come with `QUIT`). Executed on the golden model's host node (2026-10-04). |
|
||||
| `INTERPRET` | CC | FORTH-79; source in `v4/capsule/compile.v4`. Takes words from the input stream until it is exhausted: a word in the dictionary is executed, or, when compiling and not immediate, compiled; anything else must be a number in the current `BASE` (a single cell, with an optional leading minus), left on the stack or compiled as a literal. What is neither, or a compile-only word met while interpreting, abandons the line: compiling stops, the definition under way stays hidden, the rest of the input is skipped and `NODE-ERROR` is set, after v3's message: `UNKNOWN WORD: 'xxx'` or `xxx: compile-only`. `INTERPRET` then returns to `QUIT`, which prints ` ERROR`. Executed on the golden model's host node (2026-10-04). |
|
||||
|
||||
An entry, as `v4/capsule/dict.v4` builds it. A word's execution address (xt) is the address of its
|
||||
code, and everything else is found from it:
|
||||
@@ -715,7 +715,10 @@ it, `xt + 1`; for any other word the parameter field is the code itself.
|
||||
| `(` `\` | CC | `(` is `41 WORD drop`; `\` is `SPAN @ >IN !`. In `v4/capsule/input.v4` under the names `PAREN` and `BACKSLASH`. Executed on the golden model's host node (2026-10-04). |
|
||||
| `EXECUTE` | CAP | `push ;` (tail-jumps to the xt; the xt returns to `EXECUTE`'s caller). Executed on the golden model's host node (2026-10-04). |
|
||||
| `NOP` | OP | `nop` |
|
||||
| `QUIT` `ABORT` `ABORT"` `(ABORT")` `COLD` `WARM` | CC | |
|
||||
| `QUIT` | CC | FORTH-79; source in `v4/capsule/quit.v4`. Clears the return stack, sets execution mode, returns control to the terminal; no message. It is the prompt: after a new line it prints `ok> `, reads a line with `QUERY`, clears `NODE-ERROR`, runs `INTERPRET`, prints ` ok` — or, if `NODE-ERROR` is set, ends any definition that was open and prints ` ERROR` — and goes round again, for as long as the node runs. The text is v3's. The line is not sent back; the terminal shows what is typed. The return stack is circular (D-2) and has no bottom to reset to: `QUIT` clears it by jumping into the loop and never returning, from however deep. The data stack is left alone. A definition open when `QUIT` runs is ended and stays hidden. Executed on the golden model's host node (2026-10-04): the node is started at `QUIT`, fed characters and its output read, including 16 sessions recorded from the v3 binary. v3's `QUIT` goes on with the rest of the line and cannot be compiled into a definition. |
|
||||
| `ABORT` | CC | FORTH-79; source in `v4/capsule/quit.v4`. As `QUIT`, and the line it stops ends with ` ok`, as v3. The data stack is circular (D-2): there is nothing to clear, and what was on it is still there. Executed on the golden model's host node (2026-10-04), from six calls down and from inside two loops, forty times over. |
|
||||
| `ABORT"` `(ABORT")` | CC | Not FORTH-79 (it is FORTH-83's); kept because v3 has it. `ABORT" text"` `( flag -- )`: if the flag is not zero, print the text, start a new line and `ABORT`. Compiled as `."` is, with `(ABORT")` as the run-time word; it also works at the prompt. Executed on the golden model's host node (2026-10-04). v3's crashes (SIGSEGV) when a word compiled with it runs, and at the prompt prints the text and carries on with the line. |
|
||||
| `COLD` `WARM` | CC | |
|
||||
| `BYE` `REBOOT` | HERA | |
|
||||
| `SAVE-SYSTEM` | HERA | Snapshot becomes a capsule-image request. |
|
||||
| `WORDS` `VLIST` `SEE` | CC | |
|
||||
@@ -752,13 +755,16 @@ built into the capsule:
|
||||
|
||||
- Every word of the capsule keeps what it works on in memory and has at most three cells of its own on
|
||||
the data stack. Measured on the golden model: a line may have **6 values on the stack** while the
|
||||
interpreter reads its next word, and defining and running a word leaves 4 cells under it untouched.
|
||||
interpreter reads its next word, 6 may wait there while the next line is typed, and defining and
|
||||
running a word leaves 4 cells under it untouched.
|
||||
- The capsule's words call each other as little as they can: byte access shifts without a loop,
|
||||
opcodes are shifted into the word being built instead of placed by a counted shift, and the long
|
||||
jobs (laying a loop's end, making a data word) are single words reached by a jump. Measured on the
|
||||
golden model: a word run from the interpreter has **6 return entries** to itself, every kind of
|
||||
line leaves at least 3 spare while it is compiled, and a defining word (`CREATE … DOES>`) works
|
||||
from the prompt, from a word, and from a word that calls that. A `DO` loop takes two return
|
||||
golden model: the prompt has one return entry under each line, its call of `INTERPRET`, so words
|
||||
run from the prompt may call each other **8 deep**; a line that runs a word which calls nothing
|
||||
leaves 5 of the nine entries untouched; every kind of line leaves at least 3 spare while it is
|
||||
compiled, and a defining word (`CREATE … DOES>`) works from the prompt, from a word, and from a
|
||||
word that calls that. A `DO` loop takes two return
|
||||
entries. `*` is therefore not `UM* drop` on the host node but N steps of `+*` with
|
||||
only the count on the return stack; it gives the same low cell (what `+*` loses at the top of `T`
|
||||
takes N shifts to reach the bit that moves into `A`, and the loop ends first).
|
||||
|
||||
+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 ;
|
||||
@@ -35,6 +35,7 @@
|
||||
#define DVARS (TOP - 32) /* (D): dict.v4, 5 cells */
|
||||
#define CGVARS (TOP - 48) /* (CG): codegen.v4, 14 cells */
|
||||
#define CVARS (TOP - 62) /* (C): compile.v4, 10 cells */
|
||||
#define QVARS (TOP - 52) /* (Q): quit.v4, 2 cells */
|
||||
|
||||
/* buffers (word addresses; a byte address is four times this) */
|
||||
#define CFS_W (TOP - 96) /* the control-flow stack, 32 cells */
|
||||
@@ -99,6 +100,7 @@ static int host_load(v4_text *tx, v4_node *n, const char *const *files, unsigned
|
||||
v4_text_constant(tx, "STATE", STATE);
|
||||
v4_text_constant(tx, "(C)", CVARS);
|
||||
v4_text_constant(tx, "(CFP)", CFP);
|
||||
v4_text_constant(tx, "(Q)", QVARS);
|
||||
v4_text_constant(tx, "CFBASE", CFS_W);
|
||||
v4_text_constant(tx, "CFEND", CFS_W + CFS_CELLS);
|
||||
for (i = 0; i < count; i++) {
|
||||
|
||||
@@ -16,7 +16,8 @@
|
||||
* - ' is FORTH-79's: the parameter field address, and compiled as a
|
||||
* literal inside a definition. v3's ' parses when the definition runs.
|
||||
* - what is not a word and not a number abandons the line and sets
|
||||
* NODE-ERROR; v3 prints UNKNOWN WORD. The message comes with QUIT.
|
||||
* NODE-ERROR, after v3's UNKNOWN WORD message. What is printed is
|
||||
* checked in test_host_quit.c, where the node has a console.
|
||||
*/
|
||||
#include "v4/text.h"
|
||||
#include "v4/testcode.h"
|
||||
|
||||
@@ -0,0 +1,359 @@
|
||||
/* test_host_quit.c -- the prompt, executed on the host node.
|
||||
*
|
||||
* capsule/quit.v4 on top of the earlier layers: QUIT, ABORT, ABORT" and ." .
|
||||
* For the first time the node is not handed a line: it is started at QUIT and
|
||||
* left running, characters are fed to its console, and what it prints is
|
||||
* read back. Nothing here calls INTERPRET or pokes TIB.
|
||||
*
|
||||
* A session is some lines of input and everything the node printed until it
|
||||
* was waiting for more. The sessions marked v3 were piped through the v3
|
||||
* binary on 2026-10-04 and the text is what v3 printed, less its colours and
|
||||
* the time stamp and "ERROR: " its log puts before a message.
|
||||
*
|
||||
* Where v4 parts from v3 here:
|
||||
* - QUIT is FORTH-79's: it stops the line, from inside any word, and says
|
||||
* nothing. v3's goes on with the rest of the line, and cannot be
|
||||
* compiled into a definition at all.
|
||||
* - a line that fails while a definition is open ends the definition.
|
||||
* v3 goes on compiling the lines that follow into it.
|
||||
* - ABORT" at the prompt stops the line when its flag is true. v3 prints
|
||||
* the text and carries on. Compiled into a word, v3's crashes (SIGSEGV).
|
||||
* - control words that do not match give ERROR alone; v3 names the word.
|
||||
* - QUERY takes 80 characters (FORTH-79); v3's line is 255.
|
||||
*/
|
||||
#include "v4/text.h"
|
||||
#include "v4/testcode.h"
|
||||
#include <stdint.h>
|
||||
#include <stdio.h>
|
||||
#include <string.h>
|
||||
|
||||
static int failures = 0, checks = 0;
|
||||
#define CHECK(c,...) do{checks++; if(!(c)){failures++; printf("FAIL %s:%d: ",__FILE__,__LINE__); printf(__VA_ARGS__); printf("\n");}}while(0)
|
||||
|
||||
#define CANARY ((v4_cell)0x0C0FFEE5)
|
||||
|
||||
#include "host_map.h"
|
||||
|
||||
static v4_node n;
|
||||
static v4_exec_state es;
|
||||
static v4_heat h;
|
||||
static v4_text tx;
|
||||
static v4_cell w_quit, w_key, w_key_end, capsule_latest;
|
||||
static char out[V4_CONSOLE_CAP + 1];
|
||||
static long last_steps;
|
||||
|
||||
/* Run until the node has taken all its input and has been inside KEY, waiting,
|
||||
* for 64 instruction words; or until `max` words. True if it is waiting. */
|
||||
static int run_until_waiting(long max)
|
||||
{
|
||||
long steps = 0;
|
||||
unsigned idle = 0;
|
||||
while (steps < max && idle < 64) {
|
||||
(void)v4_exec_step_word(&n, &es, &h);
|
||||
steps++;
|
||||
if (n.input_pos == n.input_len && n.p >= w_key && n.p < w_key_end) idle++; else idle = 0;
|
||||
}
|
||||
last_steps = steps;
|
||||
return idle >= 64;
|
||||
}
|
||||
|
||||
/* A node just switched on: an empty dictionary above the capsule's words,
|
||||
* `depth` marked cells and the canary on the data stack, started at QUIT. */
|
||||
static void boot_with(unsigned depth)
|
||||
{
|
||||
unsigned i;
|
||||
for (v4_cell k = DICT_W; k < DICT_END_W; k++) n.mem[k] = 0;
|
||||
n.mem[DP] = DICT_W * 4;
|
||||
n.mem[LATEST] = capsule_latest;
|
||||
n.mem[STATE] = 0;
|
||||
n.mem[CFP] = CFS_W;
|
||||
n.mem[BASE] = 10;
|
||||
n.mem[NODE_ERROR] = 0;
|
||||
v4_node_console_attach(&n, CONSOLE_TX);
|
||||
v4_node_console_input_attach(&n, CONSOLE_RX, CONSOLE_ST);
|
||||
v4_dstack_reset(&n.ds);
|
||||
v4_rstack_reset(&n.rs);
|
||||
v4_exec_reset(&es);
|
||||
v4_heat_reset(&h);
|
||||
for (i = 0; i < depth; i++) v4_dstack_push(&n.ds, (v4_cell)(0x5A000000 + i));
|
||||
v4_dstack_push(&n.ds, CANARY);
|
||||
n.p = w_quit;
|
||||
(void)run_until_waiting(100000);
|
||||
}
|
||||
static void boot(void) { boot_with(0); }
|
||||
|
||||
/* While the node waits for a character, EXPECT's own cells are on top of the
|
||||
* data stack. Pop them: true if the canary is under no more than four. */
|
||||
static int canary_under_expect(void)
|
||||
{
|
||||
unsigned k;
|
||||
for (k = 0; k < 5; k++) if (v4_dstack_pop(&n.ds) == CANARY) return 1;
|
||||
return 0;
|
||||
}
|
||||
|
||||
/* Feed `input` and return what the node prints until it waits again. */
|
||||
static const char *say(const char *input)
|
||||
{
|
||||
unsigned len = (unsigned)strlen(input);
|
||||
v4_node_console_attach(&n, CONSOLE_TX); /* empties the capture */
|
||||
if (v4_node_console_feed(&n, input, len) != len) return "(input queue full)";
|
||||
if (!run_until_waiting(40000000)) return "(still running)";
|
||||
if (n.console_dropped) return "(too much output)";
|
||||
memcpy(out, n.console, n.console_len);
|
||||
out[n.console_len] = 0;
|
||||
return out;
|
||||
}
|
||||
/* A whole session from switch-on. */
|
||||
static const char *session(const char *input)
|
||||
{
|
||||
boot();
|
||||
return say(input);
|
||||
}
|
||||
static void show(const char *label, const char *s)
|
||||
{
|
||||
printf(" %s\"", label);
|
||||
for (; *s; s++) if (*s == '\n') printf("\\n"); else putchar(*s);
|
||||
printf("\"\n");
|
||||
}
|
||||
static int is(const char *got, const char *want)
|
||||
{
|
||||
if (strcmp(got, want) == 0) return 1;
|
||||
show("got: ", got);
|
||||
show("wanted: ", want);
|
||||
return 0;
|
||||
}
|
||||
|
||||
/* What v3 prints starts with its first prompt; the node's first prompt is
|
||||
* printed at switch-on, before the input, so a v4 session lacks the leading
|
||||
* "ok> " and is otherwise the same. */
|
||||
typedef struct { const char *in, *want; int v3; } transcript;
|
||||
static const transcript script[] = {
|
||||
{ "65 EMIT\n", "A ok\nok> ", 1 },
|
||||
{ "\n \n", " ok\nok> ok\nok> ", 1 },
|
||||
{ ": HI .\" Hello\" ; HI\n", "Hello ok\nok> ", 1 },
|
||||
{ "NOSUCH\n66 EMIT\n", "UNKNOWN WORD: 'NOSUCH'\n ERROR\nok> B ok\nok> ", 1 },
|
||||
{ "1 2 NOSUCH 3 4\n+ 48 + EMIT\n", "UNKNOWN WORD: 'NOSUCH'\n ERROR\nok> 3 ok\nok> ", 1 },
|
||||
{ ": T 67 EMIT ABORT 68 EMIT ; T 70 EMIT\n69 EMIT\n", "C ok\nok> E ok\nok> ", 1 },
|
||||
{ ": M 70 EMIT\n71 EMIT ;\nM\n", " ok\nok> ok\nok> FG ok\nok> ", 1 },
|
||||
{ "IF\n72 EMIT\n", "IF: compile-only\n ERROR\nok> H ok\nok> ", 1 },
|
||||
{ ".\" hi there\"\n", "hi there ok\nok> ", 1 },
|
||||
{ "1 2 3\n+ + 48 + EMIT\n", " ok\nok> 6 ok\nok> ", 1 },
|
||||
{ ": T .\" A\" .\" B\" CR .\" C\" ; T\n", "AB\nC ok\nok> ", 1 },
|
||||
{ ": T1 ABORT ; : T2 T1 66 EMIT ; : T3 65 EMIT T2 67 EMIT ; T3\n68 EMIT\n", "A ok\nok> D ok\nok> ", 1 },
|
||||
{ "0 ABORT\" not\" 65 EMIT\n", "A ok\nok> ", 1 },
|
||||
{ ": P .\" two spaces \" 124 EMIT ; P\n", " two spaces | ok\nok> ", 1 },
|
||||
{ "65 EMIT CR 66 EMIT\n", "A\nB ok\nok> ", 1 },
|
||||
{ ": E .\" \" 65 EMIT ; E\n", "A ok\nok> ", 1 },
|
||||
/* v4's own */
|
||||
{ ": BAD 1 NOSUCH 2 ;\nBAD\n65 EMIT\n", "UNKNOWN WORD: 'NOSUCH'\n ERROR\nok> UNKNOWN WORD: 'BAD'\n ERROR\nok> A ok\nok> ", 0 },
|
||||
{ "1 ABORT\" now\" 65 EMIT\n66 EMIT\n", "now\n ok\nok> B ok\nok> ", 0 },
|
||||
{ ": B1 IF LOOP ;\n65 EMIT\n", " ERROR\nok> A ok\nok> ", 0 },
|
||||
{ ": A2 0 ABORT\" boom\" 67 EMIT ; A2\n", "C ok\nok> ", 0 },
|
||||
{ ": A1 ABORT\" boom\" 65 EMIT ; 1 A1 66 EMIT\n0 A1\n", "boom\n ok\nok> A ok\nok> ", 0 },
|
||||
{ "1 2 3 QUIT 68 EMIT\n+ + 48 + EMIT\n", "\nok> 6 ok\nok> ", 0 },
|
||||
{ ": Q1 QUIT ; : Q2 65 EMIT Q1 66 EMIT ; : Q3 Q2 67 EMIT ; Q3 68 EMIT\n69 EMIT\n", "A\nok> E ok\nok> ", 0 },
|
||||
{ ": HALF 1 2 [ QUIT\n65 EMIT\nHALF\n", "\nok> A ok\nok> UNKNOWN WORD: 'HALF'\n ERROR\nok> ", 0 },
|
||||
{ ": HALF 1 2 [ ABORT\n65 EMIT\n", " ok\nok> A ok\nok> ", 0 },
|
||||
{ "PAD PAD -1 CMOVE 65 EMIT\n66 EMIT\n", "A ERROR\nok> B ok\nok> ", 0 },
|
||||
{ ".\" no closing quote\n65 EMIT\n", "no closing quote ok\nok> A ok\nok> ", 0 },
|
||||
{ ".\" \"\n", " ok\nok> ", 0 },
|
||||
{ ": T ABORT\" \" ; 1 T\n", "\n ok\nok> ", 0 },
|
||||
{ "5 >R\n;\n", ">R: compile-only\n ERROR\nok> ;: compile-only\n ERROR\nok> ", 0 },
|
||||
{ "16 BASE ! FF 2/ 2/ EMIT\n", "? ok\nok> ", 0 },
|
||||
};
|
||||
#define NSCRIPT (sizeof script / sizeof script[0])
|
||||
|
||||
int main(void)
|
||||
{
|
||||
unsigned i;
|
||||
|
||||
printf("v4 host prompt tests: V4_CELL_BITS=%d, V4_NODE_WORDS=%u\n", V4_CELL_BITS, (unsigned)V4_NODE_WORDS);
|
||||
|
||||
{
|
||||
static const char *const files[] = { "core.v4", "input.v4", "dict.v4", "codegen.v4", "compile.v4", "forth.v4", "quit.v4" };
|
||||
CHECK(host_load(&tx, &n, files, 7), "the capsule assembles");
|
||||
}
|
||||
CHECK(v4_text_finish(&tx), "everything is defined: %s", v4_text_error(&tx));
|
||||
CHECK(v4_text_here(&tx) < DICT_W, "code stays below the dictionary space");
|
||||
printf(" capsule: %ld words\n", (long)v4_text_here(&tx) - 16);
|
||||
if (failures) { printf(" %d checks, %d failures\n", checks, failures); return 1; }
|
||||
w_quit = v4_text_word(&tx, "QUIT");
|
||||
w_key = v4_text_word(&tx, "KEY");
|
||||
w_key_end = v4_text_word(&tx, "CR"); /* the word after KEY in core.v4 */
|
||||
capsule_latest = v4_text_latest(&tx);
|
||||
CHECK(w_key_end > w_key && w_key_end - w_key <= 12, "KEY is the few words before CR");
|
||||
|
||||
/* ---- switch-on ---- */
|
||||
boot();
|
||||
CHECK(n.console_len == 5 && memcmp(n.console, "\nok> ", 5) == 0, "QUIT starts a new line and prompts");
|
||||
CHECK(n.input_pos == n.input_len, "then waits for a line");
|
||||
CHECK(run_until_waiting(5000) && last_steps == 64 && n.console_len == 5, "and goes on waiting, printing nothing");
|
||||
CHECK(canary_under_expect(), "with the data stack as it found it");
|
||||
|
||||
/* ---- the sessions ---- */
|
||||
for (i = 0; i < NSCRIPT; i++) {
|
||||
const transcript *t = &script[i];
|
||||
CHECK(is(session(t->in), t->want), "%ssession %u", t->v3 ? "v3: " : "", i);
|
||||
CHECK(n.mem[STATE] == 0, "session %u ends interpreting", i);
|
||||
}
|
||||
|
||||
/* ---- one line at a time: the node keeps its state between them ---- */
|
||||
boot();
|
||||
CHECK(is(say("VARIABLE V 7 V !\n"), " ok\nok> "), "a variable is set on one line");
|
||||
CHECK(is(say(": SHOW V @ 48 + EMIT ;\n"), " ok\nok> "), "a word defined on the next");
|
||||
CHECK(is(say("SHOW 1 V +! SHOW\n"), "78 ok\nok> "), "and both used on a third");
|
||||
CHECK(is(say("1 2 3 4 5 6\n"), " ok\nok> ") && is(say("+ + + + + 48 + EMIT\n"), "E ok\nok> "), "six values wait on the stack between lines");
|
||||
CHECK(is(say("SHOW"), ""), "nothing happens until the line is ended");
|
||||
CHECK(is(say(" SHOW\n"), "88 ok\nok> "), "and then all of it is read");
|
||||
CHECK(canary_under_expect(), "the data stack is as it was at switch-on");
|
||||
|
||||
/* ---- a definition over several lines, and an error in the middle of one ---- */
|
||||
boot();
|
||||
CHECK(is(say(": LONG\n"), " ok\nok> ") && n.mem[STATE] != 0, "a line that leaves a definition open still says ok");
|
||||
CHECK(is(say("65 EMIT\n"), " ok\nok> ") && is(say("66 EMIT ;\n"), " ok\nok> ") && n.mem[STATE] == 0, "it is finished two lines later");
|
||||
CHECK(is(say("LONG\n"), "AB ok\nok> "), "and runs");
|
||||
CHECK(is(say(": BROKEN 1 IF\n"), " ok\nok> ") && n.mem[STATE] != 0 && n.mem[CFP] != CFS_W, "a definition with an IF open");
|
||||
CHECK(is(say("NOSUCH\n"), "UNKNOWN WORD: 'NOSUCH'\n ERROR\nok> ") && n.mem[STATE] == 0 && n.mem[CFP] == CFS_W,
|
||||
"an error ends it and empties the control-flow stack");
|
||||
CHECK(is(say("BROKEN\n"), "UNKNOWN WORD: 'BROKEN'\n ERROR\nok> "), "and it was never defined");
|
||||
CHECK(is(say("LONG\n"), "AB ok\nok> "), "what was defined before is still there");
|
||||
|
||||
/* ---- QUIT, ABORT and a failed line each end a definition that is open ---- */
|
||||
boot();
|
||||
CHECK(is(say(": IQ QUIT ; IMMEDIATE : IA ABORT ; IMMEDIATE\n"), " ok\nok> "), "QUIT and ABORT as immediate words");
|
||||
CHECK(is(say(": H1 1 IF IQ\n"), "\nok> ") && n.mem[STATE] == 0 && n.mem[CFP] == CFS_W, "QUIT while compiling stops compiling");
|
||||
CHECK(is(say("65 EMIT\n"), "A ok\nok> ") && is(say("H1\n"), "UNKNOWN WORD: 'H1'\n ERROR\nok> "), "and the definition is gone");
|
||||
CHECK(is(say(": H2 1 IF IA\n"), " ok\nok> ") && n.mem[STATE] == 0 && n.mem[CFP] == CFS_W, "ABORT while compiling stops compiling");
|
||||
CHECK(is(say("66 EMIT\n"), "B ok\nok> ") && is(say("H2\n"), "UNKNOWN WORD: 'H2'\n ERROR\nok> "), "and the definition is gone");
|
||||
CHECK(is(say(": H3 1 IF [ PAD PAD -1 CMOVE ]\n"), " ERROR\nok> ") && n.mem[STATE] == 0 && n.mem[CFP] == CFS_W,
|
||||
"a word that sets NODE-ERROR while a definition is open ends it");
|
||||
CHECK(is(say("67 EMIT\n"), "C ok\nok> ") && is(say("H3\n"), "UNKNOWN WORD: 'H3'\n ERROR\nok> "), "and the definition is gone");
|
||||
CHECK(is(say(": H4 68 EMIT ; H4\n"), "D ok\nok> "), "the next definition compiles and runs");
|
||||
|
||||
/* ---- the text is in the definition, a counted string after the call ---- */
|
||||
boot();
|
||||
for (v4_cell k = n.mem[DP] / 4; k < DICT_END_W; k++) n.mem[k] = (v4_cell)-1; /* memory that was not zero */
|
||||
CHECK(is(say(": T .\" ABCDE\" ;\n"), " ok\nok> "), "a word that prints five characters");
|
||||
{
|
||||
v4_cell xt = n.mem[LATEST];
|
||||
CHECK((uint32_t)n.mem[xt + 1] == (5u | ('A' << 8) | ('B' << 16) | ((uint32_t)'C' << 24)) && (uint32_t)n.mem[xt + 2] == ('D' | ('E' << 8)),
|
||||
"the count and the characters follow the call, four to a cell, zeros after");
|
||||
CHECK((n.mem[DP] + 3) / 4 == xt + 4, "then the rest of the word: four cells in all");
|
||||
}
|
||||
/* every length from 0 to 12: the word goes on at the right cell */
|
||||
for (i = 0; i <= 12; i++) {
|
||||
char line[96], want[32];
|
||||
boot();
|
||||
snprintf(line, sizeof line, ": T 60 EMIT .\" %.*s\" 62 EMIT ; T\n", (int)i, "abcdefghijkl");
|
||||
snprintf(want, sizeof want, "<%.*s> ok\nok> ", (int)i, "abcdefghijkl");
|
||||
CHECK(is(say(line), want), ".\" with %u characters", i);
|
||||
snprintf(line, sizeof line, ": U 60 EMIT ABORT\" %.*s\" 62 EMIT ; 0 U 1 U 33 EMIT\n", (int)i, "abcdefghijkl");
|
||||
snprintf(want, sizeof want, "<><%.*s\n ok\nok> ", (int)i, "abcdefghijkl");
|
||||
CHECK(is(say(line), want), "ABORT\" with %u characters, false then true", i);
|
||||
}
|
||||
/* the longest: 76 characters fit an 80-character line after ." and a space.
|
||||
* EXPECT stops at the 80th character, so that line's new-line is still to
|
||||
* come and is read as an empty line (FORTH-79's EXPECT; see input.v4). */
|
||||
{
|
||||
char line[128], want[128], text[80];
|
||||
for (i = 0; i < 76; i++) text[i] = (char)('#' + i); /* no " in it */
|
||||
text[76] = 0;
|
||||
boot();
|
||||
snprintf(line, sizeof line, ".\" %s\"\n", text);
|
||||
snprintf(want, sizeof want, "%s ok\nok> ok\nok> ", text);
|
||||
CHECK(is(say(line), want), "a string that fills an 80-character line");
|
||||
boot();
|
||||
snprintf(line, sizeof line, ".\" %s\"\n", text + 1);
|
||||
snprintf(want, sizeof want, "%s ok\nok> ", text + 1);
|
||||
CHECK(is(say(line), want), "and one that fills a 79-character line");
|
||||
}
|
||||
|
||||
/* ---- QUERY takes 80 characters; what is over is the next line ---- */
|
||||
boot();
|
||||
{
|
||||
char line[128];
|
||||
memset(line, ' ', 100);
|
||||
memcpy(line, "65 EMIT", 7);
|
||||
memcpy(line + 70, "66 EMIT", 7);
|
||||
memcpy(line + 80, "67 EMIT 68 EMIT", 15);
|
||||
line[100] = '\n'; line[101] = 0;
|
||||
CHECK(is(say(line), "AB ok\nok> CD ok\nok> "), "a line of 100 characters is read as 80 and 20");
|
||||
}
|
||||
|
||||
/* ---- ABORT and QUIT from deep in a programme, again and again ---- */
|
||||
boot();
|
||||
CHECK(is(say(": A0 ABORT ; : A1 A0 ; : A2 A1 ; : A3 A2 ; : A4 A3 ; : A5 A4 ;\n"), " ok\nok> "), "ABORT six calls down");
|
||||
CHECK(is(say(": Q0 QUIT ; : Q1 Q0 ; : Q2 Q1 ; : Q3 Q2 ; : Q4 Q3 ; : Q5 Q4 ;\n"), " ok\nok> "), "QUIT six calls down");
|
||||
CHECK(is(say(": L0 10 0 DO I 5 = IF ABORT THEN LOOP ; : L1 3 0 DO L0 LOOP ;\n"), " ok\nok> "), "ABORT inside two loops");
|
||||
for (i = 0; i < 40; i++) {
|
||||
CHECK(is(say("65 EMIT A5 66 EMIT\n"), "A ok\nok> "), "ABORT from six deep, time %u", i);
|
||||
CHECK(is(say("67 EMIT Q5 68 EMIT\n"), "C\nok> "), "QUIT from six deep, time %u", i);
|
||||
CHECK(is(say("L1 69 EMIT\n"), " ok\nok> "), "ABORT out of two loops, time %u", i);
|
||||
CHECK(is(say(": SQ DUP * ; 7 SQ EMIT\n"), "1 ok\nok> "), "and the next line compiles and runs, time %u", i);
|
||||
}
|
||||
CHECK(canary_under_expect(), "none of it disturbed the data stack");
|
||||
|
||||
/* ---- how deep words may call each other from the prompt ----
|
||||
* N7 is eight words deep; with the prompt's call of INTERPRET that is all
|
||||
* nine return entries. A ninth word would overwrite the first (D-2), so
|
||||
* it is not tried here. */
|
||||
{
|
||||
unsigned deepest = 0;
|
||||
for (i = 0; i <= 7; i++) {
|
||||
char line[64], want[16];
|
||||
boot();
|
||||
if (!is(say(": N0 1+ ; : N1 N0 1+ ; : N2 N1 1+ ; : N3 N2 1+ ; : N4 N3 1+ ;\n"), " ok\nok> ")) break;
|
||||
if (!is(say(": N5 N4 1+ ; : N6 N5 1+ ; : N7 N6 1+ ;\n"), " ok\nok> ")) break;
|
||||
snprintf(line, sizeof line, "47 N%u EMIT 33 EMIT\n", i);
|
||||
snprintf(want, sizeof want, "%c! ok\nok> ", (char)('0' + i));
|
||||
if (!is(say(line), want)) break;
|
||||
deepest = i + 1;
|
||||
}
|
||||
printf(" from the prompt, words may call each other %u deep\n", deepest);
|
||||
CHECK(deepest == 8, "a word run from the prompt has all the return stack but the prompt's one entry");
|
||||
}
|
||||
/* and with text printed at the bottom of the chain */
|
||||
boot();
|
||||
CHECK(is(say(": P0 .\" deep\" ; : P1 P0 ; : P2 P1 ; : P3 P2 ; : P4 P3 ; P4\n"), "deep ok\nok> "), ".\" five calls down");
|
||||
|
||||
/* ---- how many values may wait on the stack from one line to the next ---- */
|
||||
{
|
||||
unsigned k, most = 0;
|
||||
for (k = 1; k <= 9; k++) {
|
||||
char line[96], want[16];
|
||||
size_t at = 0;
|
||||
unsigned m;
|
||||
boot();
|
||||
for (m = 0; m < k; m++) at += (size_t)snprintf(line + at, sizeof line - at, "%u ", m + 1);
|
||||
snprintf(line + at, sizeof line - at, "\n");
|
||||
if (strcmp(say(line), " ok\nok> ") != 0) break;
|
||||
for (at = 0, m = 1; m < k; m++) at += (size_t)snprintf(line + at, sizeof line - at, "+ ");
|
||||
snprintf(line + at, sizeof line - at, "32 + EMIT\n");
|
||||
snprintf(want, sizeof want, "%c ok\nok> ", (char)(32 + k * (k + 1) / 2));
|
||||
if (strcmp(say(line), want) != 0 || !canary_under_expect()) break;
|
||||
most = k;
|
||||
}
|
||||
printf(" %u values may wait on the stack while the next line is typed\n", most);
|
||||
CHECK(most >= 6, "reading a line leaves most of the stack to the user");
|
||||
}
|
||||
|
||||
/* ---- how much of the data stack a line has ---- */
|
||||
{
|
||||
unsigned d;
|
||||
for (d = 0; d < V4_DATA_DEPTH; d++) {
|
||||
unsigned k, good = 1;
|
||||
boot_with(d + 1);
|
||||
if (strcmp(say(": Z1 .\" x\" 1 2 + ; Z1 Z1 + 48 + EMIT\n"), "xx6 ok\nok> ") != 0) break;
|
||||
if (!canary_under_expect()) break;
|
||||
for (k = d + 1; k-- > 0; ) if (v4_dstack_pop(&n.ds) != (v4_cell)(0x5A000000 + k)) good = 0;
|
||||
if (!good) break;
|
||||
}
|
||||
printf(" defining and running a word from the prompt leaves %u data cells under it untouched\n", d);
|
||||
CHECK(d >= 3, "the prompt leaves room on the data stack");
|
||||
}
|
||||
|
||||
CHECK(v4_node_guards_intact(&n), "guards intact");
|
||||
|
||||
printf(" %d checks, %d failures\n", checks, failures);
|
||||
return failures ? 1 : 0;
|
||||
}
|
||||
Reference in New Issue
Block a user