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

feat(v4.0.0): KEY and ?TERMINAL on the console registers

Browse Source 
?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>
This commit is contained in:
rajames
2026-10-03 20:53:56 -04:00
co-authored by Claude Opus 5.5
parent 2c16183788
commit 861f800b7f
2 changed files with 129 additions and 6 deletions
Download Patch File Download Diff File Expand all files Collapse all files
docs/v4.0.0/DECOMPOSITION.md
+5 -3
View File
@@ -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`. |
v4/tests/test_terminal.c
+124 -3
View File
@@ -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);