From 861f800b7fde50ea43ed7115b82842ccc8e24d48 Mon Sep 17 00:00:00 2001
From: rajames <rajames@strshipos.com>
Date: Sat, 3 Oct 2026 20:53:56 -0400
Subject: [PATCH] feat(v4.0.0): KEY and ?TERMINAL on the console registers

?TERMINAL reads CONSOLE-STATUS; KEY polls it until a character is
pending and then takes it from CONSOLE-RX.  Executed on the golden
model at both cell widths, including a transcript of the v3 binary, and
KEY shown still waiting after 5000 instruction words with no input.

v3's KEY returned -1 at the end of its input; here KEY waits.

Co-Authored-By: Claude Opus 5.5 <noreply@anthropic.com>
---
 docs/v4.0.0/DECOMPOSITION.md |   8 ++-
 v4/tests/test_terminal.c     | 127 ++++++++++++++++++++++++++++++++++-
 2 files changed, 129 insertions(+), 6 deletions(-)

diff --git a/docs/v4.0.0/DECOMPOSITION.md b/docs/v4.0.0/DECOMPOSITION.md
index 38f5e6c0..70739894 100644
--- a/docs/v4.0.0/DECOMPOSITION.md
+++ b/docs/v4.0.0/DECOMPOSITION.md
@@ -148,7 +148,7 @@ times, as on the F18. `FOR ... UNEXT` is the same but the body must fit in one i
 
 **Register conventions.** `A` and `B` are caller-saved. A word that uses them says so. Words in this
 document that clobber `A`: `@ ! +! -! 2@ 2! C@ C! D2/ M* FILL ERASE MOVE COUNT CMOVE CMOVE> BLANK -TRAILING COMPARE SEARCH SCAN SKIP DECIMAL HEX OCTAL UM* * UM/MOD Q.FROM-INT Q.TO-INT Q.* Q./ Q.EXP Q.SQRT Q.LOG Q.SIN Q.COS +LOOP J HOLD SIGN # #S . .R U. U.R D. D.R ? DUMP Q.PRINT TYPE SEND RECV`. Words that clobber `B`:
-`COMPARE SEARCH Q./ Q.EXP Q.SQRT Q.LOG Q.SIN Q.COS <# HOLD SIGN # #S #> . .R U. U.R D. D.R ? DUMP Q.PRINT EMIT CR SPACE SPACES TYPE SEND RECV`.
+`COMPARE SEARCH Q./ Q.EXP Q.SQRT Q.LOG Q.SIN Q.COS <# HOLD SIGN # #S #> . .R U. U.R D. D.R ? DUMP Q.PRINT EMIT CR SPACE SPACES TYPE KEY ?TERMINAL SEND RECV`.
 
 **Return-stack words** (`>R R> R@ 2>R 2R> 2R@ I J UNLOOP` and the loop runtimes) are always IN.
 
@@ -644,8 +644,8 @@ width and print a flood of spaces.
 | Word | Fate | Notes |
 | --- | --- | --- |
 | `EMIT` | DEV | Console service: one-character message. Until the mesh exists it is a store to the `CONSOLE-TX` register (§7): `CONSOLE-TX b! !b`. As in v3, the low byte of the cell is the character. Executed on the golden model (2026-10-03). Clobbers `B`. |
-| `KEY` | DEV | Console service: blocking receive. |
-| `?TERMINAL` | DEV | Console service: non-blocking status. |
+| `KEY` | DEV | Console service: blocking receive. Until the mesh exists it reads the `CONSOLE-STATUS` and `CONSOLE-RX` registers (§7): `L: CONSOLE-STATUS b! @b  if WAIT  drop  CONSOLE-RX b! @b ;   WAIT: drop  jump L` — it asks whether a character is pending until one is, then takes it. The character is 0–255. v3's `KEY` returned −1 at the end of its input; here there is no end of input, and `KEY` waits. Executed on the golden model (2026-10-03), including a transcript of the v3 binary, and shown still waiting after 5000 instruction words with nothing pending. Leaves its caller 9 data cells and 8 return entries. Clobbers `B`. |
+| `?TERMINAL` | DEV | Console service: non-blocking status. Until the mesh exists: `CONSOLE-STATUS b! @b` — −1 when a character is pending, 0 when not, as v3; it takes nothing. Executed on the golden model (2026-10-03). Clobbers `B`. |
 | `TYPE` | CAP | `( baddr u -- )`. Loop of `C@ EMIT`, or one string message to the console node: `-if OK  drop drop NODE-ERROR b! -1 !b ;  OK: if DONE  over C@ EMIT  push 1 + pop  -1 +  jump OK  DONE: drop drop ;` — nothing for `u = 0`; for `u < 0` nothing is printed and `NODE-ERROR` is set, where v3 printed nothing and raised its error flag. The address range is not checked (out-of-range addressing is still open, `node.h`). Executed on the golden model (2026-10-03). Leaves its caller 6 data cells and 6 return entries. Clobbers `A` and `B`. |
 | `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). |
@@ -959,3 +959,5 @@ Addresses are assigned in the node memory map (D-4). Names only here.
 | `PORT-STATUS` | R | Per-port ready flags, for non-blocking polls. |
 | `NODE-ERROR` | R/W | Arithmetic error flag: set to −1 by `Q./` on division by zero (D-11), by `Q.SQRT` / `Q.LOG` outside their domain (D-12) and by `HOLD` on a bad character or a full buffer (D-13), cleared by writing 0. `VM-ERROR?` reads it. |
 | `CONSOLE-TX` | W | Console transmit: a store sends the low 8 bits of the value as one character. This is what `EMIT` writes to. On the single-node golden model it is a capture register: the character is appended to a buffer on the node and memory is not written (`v4_node_console_attach`, `v4/include/v4/node.h`), so printing words can be run and their output compared with v3's. With the mesh (step 2) it becomes the port to the console node. |
+| `CONSOLE-RX` | R | Console receive: a fetch gives the next pending character, 0–255, and takes it; with none pending it gives −1 and takes nothing. This is what `KEY` reads. On the single-node golden model the characters come from a queue the test feeds (`v4_node_console_input_attach`, `v4_node_console_feed`, `v4/include/v4/node.h`). Only the data fetches `@`, `@+` and `@b` see the register; instruction words and literals at the same address are read as memory. With the mesh (step 2) it becomes the port from the console node, and a read with nothing pending will block instead. |
+| `CONSOLE-STATUS` | R | Console receive status: a fetch gives −1 when a character is pending and 0 when not, and changes nothing. `?TERMINAL` reads it, and `KEY` polls it. On the mesh it is the console port's bit of `PORT-STATUS`. |
diff --git a/v4/tests/test_terminal.c b/v4/tests/test_terminal.c
index fafbf3f1..1984526e 100644
--- a/v4/tests/test_terminal.c
+++ b/v4/tests/test_terminal.c
@@ -1,4 +1,4 @@
-/* test_terminal.c -- EMIT, CR, SPACE and TYPE, executed.
+/* test_terminal.c -- EMIT, CR, SPACE, TYPE, KEY and ?TERMINAL, executed.
  *
  * DECOMPOSITION.md 5.10.  EMIT is a device service; on the single-node model
  * it is a store to the CONSOLE-TX capture register (node.h), so what these
@@ -9,7 +9,14 @@
  * bytes, nothing for u = 0, and for u < 0 prints nothing and raises its error
  * flag.  v4 sets NODE-ERROR in that last case, as D-13 does for HOLD.
  *
- * Two transcripts of the real v3 binary are recorded below as expected
+ * KEY ( -- c ) and ?TERMINAL ( -- flag ) are device services too; on the
+ * single-node model they read the CONSOLE-RX and CONSOLE-STATUS registers
+ * (node.h), which hand out characters the test feeds.  v3: KEY is the next
+ * character of input, waiting for one; ?TERMINAL is -1 when one is ready and
+ * 0 when not.  At the end of its input v3's KEY returns -1; here there is no
+ * end of input, and KEY waits.
+ *
+ * Three transcripts of the real v3 binary are recorded below as expected
  * output.  They were taken on 2026-10-03 from
  *   printf '<script>\n' | build/amd64/standard/starforth -s
  * as the text between "System initialization complete." and "Goodbye!".
@@ -31,6 +38,8 @@ static int failures = 0, checks = 0;
 /* The memory map is open (D-4); the test chooses the addresses. */
 #define NODE_ERROR ((v4_cell)(V4_NODE_WORDS - 2u))
 #define CONSOLE_TX ((v4_cell)(V4_NODE_WORDS - 4u))
+#define CONSOLE_RX ((v4_cell)(V4_NODE_WORDS - 6u))
+#define CONSOLE_ST ((v4_cell)(V4_NODE_WORDS - 7u))
 #define STRINGS    ((v4_cell)(V4_NODE_WORDS - 64u))     /* 32 cells of byte-packed text */
 #define STR_BADDR  ((v4_cell)(STRINGS * 4))
 
@@ -40,7 +49,8 @@ static v4_heat       h;
 static v4_asm        as;
 
 static v4_cell w_swap, w_lshift, w_rshift, w_cfetch,
-               w_emit, w_cr, w_space, w_type, t_v3a, t_v3b;
+               w_emit, w_cr, w_space, w_type, t_v3a, t_v3b,
+               w_key, w_qterminal, t_v3k, t_echo;
 
 #define O(name)  v4_asm_op(&as, V4_OP_##name)
 #define LIT(v)   v4_asm_lit(&as, (v4_cell)(v))
@@ -153,6 +163,35 @@ static void build(void)
     HERE_(b);
     O(DROP); O(DROP); O(SEMI);
 
+    /* ---- terminal input, 5.10 ---- */
+
+    /* : ?TERMINAL ( -- flag )   CONSOLE-STATUS b! @b ; */
+    w_qterminal = v4_asm_label(&as);
+    LIT(CONSOLE_ST); O(BANG_B); O(FETCH_B); O(SEMI);
+
+    /* : KEY ( -- c )
+     *   L: CONSOLE-STATUS b! @b  if WAIT  drop  CONSOLE-RX b! @b ;
+     *   WAIT: drop  jump L
+     * It asks whether a character is pending until one is, then takes it. */
+    w_key = v4_asm_label(&as);
+    l = v4_asm_label(&as);
+    LIT(CONSOLE_ST); O(BANG_B); O(FETCH_B); a = FWD(IF);
+    O(DROP); LIT(CONSOLE_RX); O(BANG_B); O(FETCH_B); O(SEMI);
+    HERE_(a);
+    O(DROP); JUMP(l);
+
+    /* ( -- c )   KEY  KEY EMIT          v3: KEY . KEY EMIT on the input "AB" */
+    t_v3k = v4_asm_label(&as);
+    CALL(w_key); CALL(w_key); CALL(w_emit); O(SEMI);
+
+    /* ( n -- )   n times KEY EMIT:   L: if DONE  KEY EMIT  -1 +  jump L   DONE: drop ; */
+    t_echo = v4_asm_label(&as);
+    l = v4_asm_label(&as);
+    a = FWD(IF);
+    CALL(w_key); CALL(w_emit); LIT(-1); O(ADD); JUMP(l);
+    HERE_(a);
+    O(DROP); O(SEMI);
+
     /* ---- the two v3 transcripts ---- */
 
     /* 65 EMIT 66 EMIT SPACE 67 EMIT CR 68 EMIT 321 EMIT */
@@ -181,6 +220,19 @@ static int call(v4_cell word, unsigned argc, v4_cell a, v4_cell b)
     return v4_test_call(&n, &es, &h, word, 4000000) > 0 && n.ds.t == CANARY;
 }
 
+/* For a word that leaves results: true when it returns; the caller then pops
+ * the results and the canary. */
+static int ran(v4_cell word)
+{
+    v4_dstack_reset(&n.ds);
+    v4_rstack_reset(&n.rs);
+    v4_exec_reset(&es);
+    v4_heat_reset(&h);
+    v4_node_console_attach(&n, CONSOLE_TX);
+    v4_dstack_push(&n.ds, CANARY);
+    return v4_test_call(&n, &es, &h, word, 100000) > 0;
+}
+
 /* What was printed, exactly. */
 static int printed(const void *want, unsigned len)
 {
@@ -291,9 +343,78 @@ int main(void)
         CHECK(n.mem[CONSOLE_TX] == 0, "and the register's memory word");
     }
 
+    /* ---- KEY and ?TERMINAL ---- */
+    v4_node_console_input_attach(&n, CONSOLE_RX, CONSOLE_ST);
+    n.mem[CONSOLE_RX] = 0x5151; n.mem[CONSOLE_ST] = 0x5252;
+
+    /* v3:  KEY . KEY EMIT  on the input "AB"  prints  65 B */
+    CHECK(v4_node_console_feed(&n, "AB", 2) == 2, "fed");
+    CHECK(ran(t_v3k) && v4_dstack_pop(&n.ds) == 65 && v4_dstack_pop(&n.ds) == CANARY && printed("B", 1),
+          "v3: KEY . KEY EMIT on \"AB\" gives 65 and prints B");
+
+    /* ?TERMINAL: 0 with nothing pending, -1 with something, and it takes nothing. */
+    CHECK(ran(w_qterminal) && v4_dstack_pop(&n.ds) == 0 && v4_dstack_pop(&n.ds) == CANARY,
+          "?TERMINAL is 0 with nothing pending");
+    CHECK(v4_node_console_feed(&n, "x", 1) == 1, "fed");
+    for (i = 0; i < 3; i++)
+        CHECK(ran(w_qterminal) && v4_dstack_pop(&n.ds) == -1 && v4_dstack_pop(&n.ds) == CANARY,
+              "?TERMINAL is -1 with a character pending [%u]", i);
+    CHECK(ran(w_key) && v4_dstack_pop(&n.ds) == 'x' && v4_dstack_pop(&n.ds) == CANARY,
+          "and KEY then takes that character");
+    CHECK(ran(w_qterminal) && v4_dstack_pop(&n.ds) == 0, "after which ?TERMINAL is 0 again");
+
+    /* KEY: every byte value, in order, as 0 .. 255. */
+    {
+        unsigned char all[256];
+        for (i = 0; i < 256; i++) all[i] = (unsigned char)(255u - i);
+        CHECK(v4_node_console_feed(&n, all, 256) == 256, "fed");
+        for (i = 0; i < 256; i++)
+            CHECK(ran(w_key) && v4_dstack_pop(&n.ds) == (v4_cell)all[i]
+                  && v4_dstack_pop(&n.ds) == CANARY, "KEY byte %u", (unsigned)all[i]);
+    }
+
+    /* KEY EMIT, forty times: what goes in comes out. */
+    CHECK(v4_node_console_feed(&n, text + 20, 40) == 40, "fed");
+    CHECK(call(t_echo, 1, 40, 0) && printed(text + 20, 40), "KEY EMIT echoes the input");
+
+    /* KEY waits: with nothing pending it has not returned after 5000
+     * instruction words; a character fed then is the one it returns. */
+    {
+        long steps = 0;
+        v4_dstack_reset(&n.ds);
+        v4_rstack_reset(&n.rs);
+        v4_exec_reset(&es);
+        v4_dstack_push(&n.ds, CANARY);
+        v4_rstack_push(&n.rs, V4_TEST_HALT);
+        n.p = w_key;
+        while (n.p != V4_TEST_HALT && steps < 5000) { (void)v4_exec_step_word(&n, &es, &h); steps++; }
+        CHECK(n.p != V4_TEST_HALT && n.ds.t == CANARY, "KEY is still waiting after %ld words", steps);
+        CHECK(v4_node_console_feed(&n, "!", 1) == 1, "fed");
+        while (n.p != V4_TEST_HALT && steps < 5100) { (void)v4_exec_step_word(&n, &es, &h); steps++; }
+        CHECK(n.p == V4_TEST_HALT && v4_dstack_pop(&n.ds) == '!' && v4_dstack_pop(&n.ds) == CANARY,
+              "and returns the character once there is one");
+    }
+    CHECK(n.mem[CONSOLE_RX] == 0x5151 && n.mem[CONSOLE_ST] == 0x5252, "KEY and ?TERMINAL write no memory");
+
     /* What they leave their caller (D-2). */
     {
         int dh, rh;
+        v4_cell r;
+        for (dh = 0; dh < V4_DATA_DEPTH; dh++) {
+            unsigned q;
+            (void)v4_node_console_feed(&n, "k", 1);
+            v4_dstack_reset(&n.ds); v4_rstack_reset(&n.rs); v4_exec_reset(&es);
+            for (q = 0; q <= (unsigned)dh; q++) v4_dstack_push(&n.ds, (v4_cell)(0x5A000000 + q));
+            v4_dstack_push(&n.ds, CANARY);
+            if (v4_test_call(&n, &es, &h, w_key, 1000) <= 0) break;
+            r = v4_dstack_pop(&n.ds);
+            if (r != 'k' || v4_dstack_pop(&n.ds) != CANARY) break;
+            for (q = (unsigned)dh + 1u; q-- > 0; ) if (v4_dstack_pop(&n.ds) != (v4_cell)(0x5A000000 + q)) break;
+            if (q != (unsigned)-1) break;
+        }
+        v4_node_console_input_attach(&n, CONSOLE_RX, CONSOLE_ST);
+        printf("  KEY headroom: data %d below canary\n", dh);
+        CHECK(dh >= 7, "KEY leaves room");
         headroom("EMIT", w_emit, 1, 65, 0, "A", 1, &dh, &rh);
         CHECK(dh >= 7 && rh >= 7, "EMIT leaves room");
         headroom("CR", w_cr, 0, 0, 0, "\n", 1, &dh, &rh);