admin/LithosAnanake
1
1
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

feat(v4.0.0): (CATCH) and (EMIT-HOOK), the two nucleus hooks POST needs

Browse Source 
(CATCH): while it is not zero, a line that ends in an error sets it to -1
and ends " ok" instead of " ERROR".  (EMIT-HOOK): the xt of a word that is
given each character EMIT would send to the console.  The prompt loop sets
(EMIT-HOOK) to 0 at the end of every line.  docs/v4.0.0/NUCLEUS.md 6.3,
amended: it said one nucleus word would do.

Verified: make -C v4 test passes at both widths; by hand at the hosted
prompt, an unknown word and a division by zero are caught, the output hook
receives every character, and an uncaught error still says ERROR.

Co-Authored-By: Claude Opus 5.5 <noreply@anthropic.com>
This commit is contained in:
rajames
2026-10-05 15:49:43 -04:00
co-authored by Claude Opus 5.5
parent 506b645726
commit ed6b11ad88
4 changed files with 45 additions and 8 deletions
Download Patch File Download Diff File Expand all files Collapse all files
docs/v4.0.0/NUCLEUS.md
+16 -5
View File
@@ -156,11 +156,22 @@ departure is reported.
### 6.3 Form
`post79.4th` defines a small harness in FORTH — a case is written
`T{ 1 2 3 ROT -> 2 3 1 }T` — and a tally. Cases that check printed output
or an expected error use harness words for those. The harness needs one
thing from the nucleus that FORTH-79 does not provide: a way to run a case
and regain control if it raises an error. That is one nucleus word.
`post79.4th` defines a small harness in FORTH and a tally. The harness
needs two things from the nucleus that FORTH-79 does not provide. Both are
variables an assembled word consults, and both have FORTH names:
| Variable | Consulted by | Effect while not zero |
|---|---|---|
| `(CATCH)` | the prompt loop (`quit.v4`) | A line that ends in an error does not say `ERROR`: `(CATCH)` is set to −1 and the line ends ` ok`. POST can then go on to its next case, and can check a case that must fail. |
| `(EMIT-HOOK)` | `EMIT` (`core.v4`) | It holds the xt of a word ( c -- ) that is given each character instead of the console. POST uses it to compare what a case prints, and it keeps the messages of expected errors out of the boot log. |
The prompt loop sets `(EMIT-HOOK)` to 0 at the end of every line, so the
console cannot be left silent. (This section first said one nucleus word
would do; reading `quit.v4` and `core.v4` showed it takes these two.
Amended 2026-10-05.)
An error always ends the line it is on, so a case is several short lines
and the harness words work across them.
After the last case POST prints the number of cases, passes and failures,
and names each failing case.
v4/capsule/core.v4
+10 -2
View File
@@ -5,7 +5,7 @@
\ written here as text for the text assembler (v4/include/v4/text.h).
\
\ Constants the loader supplies: N-1 (cell bits - 1), NODE-ERROR, CONSOLE-TX,
\ CONSOLE-RX, CONSOLE-STATUS, BASE.
\ CONSOLE-RX, CONSOLE-STATUS, BASE, (EMIT-HOOK).
\
\ ERRORS (D-18). A word that finds an error takes its arguments off the stack
\ and stores a code in NODE-ERROR. On a node with a prompt that store is a
@@ -91,8 +91,16 @@ header CMOVE
DONE: drop drop drop ;
\ ---- section 5.10: the console -------------------------------------------
\ EMIT sends the character to the console, unless (EMIT-HOOK) holds the xt
\ of a word: then that word is given it instead ( c -- ), and returns to
\ EMIT's caller. Everything the node prints goes through EMIT, so a hook
\ sees all of it. The prompt takes the hook off at the end of every line
\ (quit.v4), so that nothing can leave the console silent. POST uses it
\ to compare what a case prints (docs/v4.0.0/NUCLEUS.md 6.3).
header EMIT
: EMIT ( c -- ) CONSOLE-TX b! !b ;
: EMIT ( c -- )
(EMIT-HOOK) b! @b if NONE push ;
NONE: drop CONSOLE-TX b! !b ;
header KEY
: KEY ( -- c )
L: CONSOLE-STATUS b! @b if WAIT drop CONSOLE-RX b! @b ;
v4/capsule/quit.v4
+15 -1
View File
@@ -35,14 +35,25 @@ macro R-CLEAR RSTACK-DEPTH b! a !b endmacro
\ 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 ends " ok". 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 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)
(EMIT-HOOK) b! 0 !b \ the console is the console again
if GO -1 + if OK
drop (RESET) $52524520 (EMIT4) $524F (EMIT4) CR jump READ \ " ERROR"
drop (RESET)
(CATCH) b! @b if LOUD drop -1 !b 1 jump (REPL) \ caught: the line ends " ok"
LOUD: drop $52524520 (EMIT4) $524F (EMIT4) CR jump READ \ " ERROR"
OK: drop $6B6F20 (EMIT4) CR jump READ \ " ok"
GO: drop
READ:
@@ -57,6 +68,9 @@ macro R-CLEAR RSTACK-DEPTH b! a !b endmacro
\ 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 (CATCH) inline : (CATCH)' (CATCH) ;
header (EMIT-HOOK) inline : (EMIT-HOOK)' (EMIT-HOOK) ;
header QUIT
: QUIT R-CLEAR (RESET) CR 0 jump (REPL)
v4/tests/host_map.h
+4
View File
@@ -65,6 +65,8 @@
#define SRC_HOOK (BVARS + 9)
#define STORAGE_REG (BVARS + 10)
#define ACL_HOOK (BUF0_W - 6) /* the xt of the access control recheck word, or 0 */
#define EMIT_HOOK (BUF0_W - 7) /* the xt of a word EMIT gives its character to, or 0: the console */
#define CATCH (BUF0_W - 8) /* non-zero: a line's error is recorded here, -1, and the line ends " ok" */
#define LOG_LEVEL (BUF0_W - 5) /* the level at or below which a message is printed */
#define BOOT_CELLS (BVARS + 14) /* (BOOT): DP and LATEST as the loader left them, 2 cells */
#define BUF0_W (BVARS - 2 * 256) /* the two block buffers, 256 cells each */
@@ -138,6 +140,8 @@ static int host_load(v4_text *tx, v4_node *n, const char *const *files, unsigned
v4_text_constant(tx, "BLK", BLK);
v4_text_constant(tx, "(SRC)", SRC);
v4_text_constant(tx, "(SRC-HOOK)", SRC_HOOK);
v4_text_constant(tx, "(EMIT-HOOK)", EMIT_HOOK);
v4_text_constant(tx, "(CATCH)", CATCH);
v4_text_constant(tx, "BLOCK-NUMBER", STORAGE_REG);
v4_text_constant(tx, "BLOCK-ADDRESS", STORAGE_REG + 1);
v4_text_constant(tx, "BLOCK-COMMAND", STORAGE_REG + 2);