From ed6b11ad882c6003128f52dfd5160997523f7722 Mon Sep 17 00:00:00 2001 From: rajames Date: Mon, 5 Oct 2026 15:49:43 -0400 Subject: [PATCH] feat(v4.0.0): (CATCH) and (EMIT-HOOK), the two nucleus hooks POST needs (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 --- docs/v4.0.0/NUCLEUS.md | 21 ++++++++++++++++----- v4/capsule/core.v4 | 12 ++++++++++-- v4/capsule/quit.v4 | 16 +++++++++++++++- v4/tests/host_map.h | 4 ++++ 4 files changed, 45 insertions(+), 8 deletions(-) diff --git a/docs/v4.0.0/NUCLEUS.md b/docs/v4.0.0/NUCLEUS.md index 5da25b2a..81f99846 100644 --- a/docs/v4.0.0/NUCLEUS.md +++ b/docs/v4.0.0/NUCLEUS.md @@ -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. diff --git a/v4/capsule/core.v4 b/v4/capsule/core.v4 index 4fc67003..79af2840 100644 --- a/v4/capsule/core.v4 +++ b/v4/capsule/core.v4 @@ -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 ; diff --git a/v4/capsule/quit.v4 b/v4/capsule/quit.v4 index 5ca68534..44926d11 100644 --- a/v4/capsule/quit.v4 +++ b/v4/capsule/quit.v4 @@ -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) diff --git a/v4/tests/host_map.h b/v4/tests/host_map.h index e3da8dd6..1919bf11 100644 --- a/v4/tests/host_map.h +++ b/v4/tests/host_map.h @@ -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);