From 2e4d1330ea09503ad3afa708e5b31727d54c0b2f Mon Sep 17 00:00:00 2001 From: rajames Date: Sat, 3 Oct 2026 11:16:16 -0400 Subject: [PATCH] test(v4.0.0): execute C@ and C! on the golden model Both run exactly as written in DECOMPOSITION.md 5.3 and need no change: four bytes to a cell, little-endian, byte address = 4 * word address + byte index, at either cell width. Checked at 32- and 64-bit cells, optimised and ASan+UBSan (`make test`, `make sanitize`): every byte of two adjacent words, eight values including ones wider than a byte, with the other bytes of the word, the upper half of a 64-bit cell and the neighbouring words left untouched. Breaking C!'s mask or C@'s mask fails. Headroom (data under args / return): C@ 6/4, C! 5/4. Test results on the amd64 host only. This is a development check, not acceptance (JUSTIFICATION.md section 16). Co-Authored-By: Claude Opus 5.5 --- docs/v4.0.0/DECOMPOSITION.md | 8 +++--- v4/tests/test_foundation.c | 50 +++++++++++++++++++++++++++++++++++- 2 files changed, 54 insertions(+), 4 deletions(-) diff --git a/docs/v4.0.0/DECOMPOSITION.md b/docs/v4.0.0/DECOMPOSITION.md index 8c66fa0f..170ce5e9 100644 --- a/docs/v4.0.0/DECOMPOSITION.md +++ b/docs/v4.0.0/DECOMPOSITION.md @@ -330,15 +330,17 @@ Section numbers match the v3 primitive reference. | `-!` | CAP | `a! NEGATE @ + !` | | `2@` | CAP | `a! @+ @` (low cell at `addr`, high at `addr+1`, as in v3) | | `2!` | CAP | `a! SWAP !+ !` | -| `C@` | CAP | See below (D-1). | -| `C!` | CAP | See below (D-1). | +| `C@` | CAP | See below (D-1). Executed on the golden model (2026-10-03). | +| `C!` | CAP | See below (D-1). Executed on the golden model (2026-10-03). | | `FILL` | CAP | See below. | | `MOVE` | CAP | `push 2DUP U< IF pop CMOVE> ELSE pop CMOVE THEN` | | `ERASE` | CAP | `0 FILL` | | `CELLS` | IN | Empty (word-addressed). Becomes `2* 2*` if D-1 chooses bytes. | ```forth -\ byte access on a word-addressed node, little-endian +\ byte access on a word-addressed node, little-endian: four bytes to a cell at +\ either cell width (so compiled code is the same, D-9), byte address = 4 * word +\ address + byte index. `@` and `!` inside are the opcodes, addressing through A. : C@ ( baddr -- c ) dup 3 and 3 LSHIFT SWAP 2 RSHIFT a! @ SWAP RSHIFT 255 and ; diff --git a/v4/tests/test_foundation.c b/v4/tests/test_foundation.c index 991b0482..25bc2b3e 100644 --- a/v4/tests/test_foundation.c +++ b/v4/tests/test_foundation.c @@ -66,6 +66,8 @@ static int failures = 0, checks = 0; #define QL ((v4_cell)(V4_NODE_WORDS - 32u)) /* (QT), Q.SIN / Q.COS's 6-cell variable: sign, x^2, term, sum, n, subtract. */ #define QT ((v4_cell)(V4_NODE_WORDS - 40u)) +/* Scratch words for the byte-access tests. */ +#define BYTES ((v4_cell)(V4_NODE_WORDS - 48u)) #define MAXU ((v4_ucell)~(v4_ucell)0) #define FLAG(c) ((c) ? V4_ALL_ONES : (v4_cell)0) @@ -82,7 +84,7 @@ static v4_cell w_nip, w_swap, w_or, w_negate, w_rot, w_zless, w_zequal, w_dmax, w_dmin, w_qgt_doc, w_qgt, w_dltkeep, w_qstar, w_d2starc, w_uqdiv, w_qslash, w_qexp, w_qsqrt, w_qlog, w_qreduce, w_qsin, l_trig, w_qcos, w_q1, w_q0, w_qscale, w_q1_times, w_q0_plus, w_q1_toint, w_one_fromint, - w_lshift, w_rshift; + w_lshift, w_rshift, w_cfetch, w_cstore; #define O(name) v4_asm_op(&as, V4_OP_##name) #define LIT(v) v4_asm_lit(&as, (v4_cell)(v)) @@ -1352,6 +1354,26 @@ static void build(void) O(DROP); O(DROP); O(SEMI); } + /* Byte access on a word-addressed node (D-1), as written in 5.3: four + * bytes to a cell, little-endian; a byte address is 4 * word address + + * byte index. `@` and `!` here are the opcodes, addressing through A. + * : C@ ( baddr -- c ) + * dup 3 and 3 LSHIFT SWAP 2 RSHIFT a! @ SWAP RSHIFT 255 and ; + * : C! ( c baddr -- ) + * dup 2 RSHIFT a! 3 and 3 LSHIFT SWAP 255 and over LSHIFT + * SWAP 255 SWAP LSHIFT inv @ and OR ! ; */ + w_cfetch = v4_asm_label(&as); + O(DUP); LIT(3); O(AND); LIT(3); CALL(w_lshift); + CALL(w_swap); LIT(2); CALL(w_rshift); O(BANG_A); O(FETCH_A); + CALL(w_swap); CALL(w_rshift); LIT(255); O(AND); O(SEMI); + + w_cstore = v4_asm_label(&as); + O(DUP); LIT(2); CALL(w_rshift); O(BANG_A); + LIT(3); O(AND); LIT(3); CALL(w_lshift); + CALL(w_swap); LIT(255); O(AND); O(OVER); CALL(w_lshift); + CALL(w_swap); LIT(255); CALL(w_swap); CALL(w_lshift); O(INV); + O(FETCH_A); O(AND); CALL(w_or); O(STORE_A); O(SEMI); + CHECK(v4_asm_ok(&as), "foundation words assemble"); } @@ -2627,6 +2649,28 @@ int main(void) CHECK(call(w_rshift, 2, vec[i], (v4_cell)c, 0) && left1((v4_cell)r), "RSHIFT [%u,%u]", i, c); } + /* C@ and C! as written: every byte of two adjacent words, several + * values, the other bytes and the neighbouring words left alone. */ + { + static const v4_ucell cv[] = { 0, 1, 0x41, 0x7F, 0x80, 0xFF, 0x1FF, 0xABCD }; + const v4_ucell pat = (v4_ucell)0xA5C3F00Fu | ((MAXU >> 16 >> 16) << 16 << 16); + for (unsigned b = 0; b < 8; b++) + for (unsigned k = 0; k < sizeof cv / sizeof cv[0]; k++) { + v4_cell w = BYTES + 1 + (v4_cell)(b / 4u); + unsigned sh = 8u * (b % 4u); + v4_ucell want = (pat & ~((v4_ucell)0xFFu << sh)) | ((cv[k] & 0xFFu) << sh); + v4_cell baddr = (BYTES + 1) * 4 + (v4_cell)b; + for (unsigned j = 0; j < 4; j++) v4_node_store(&n, BYTES + (v4_cell)j, (v4_cell)pat); + CHECK(call(w_cstore, 2, (v4_cell)cv[k], baddr, 0) && n.ds.t == CANARY, + "C! returns [%u,%u]", b, k); + CHECK((v4_ucell)v4_node_load(&n, w) == want, "C! stores [%u,%u]", b, k); + for (unsigned j = 0; j < 4; j++) + if (BYTES + (v4_cell)j != w) + CHECK((v4_ucell)v4_node_load(&n, BYTES + (v4_cell)j) == pat, "C! neighbours [%u,%u,%u]", b, k, j); + CHECK(call(w_cfetch, 1, baddr, 0, 0) && left1((v4_cell)(cv[k] & 0xFFu)), "C@ [%u,%u]", b, k); + } + } + /* Q./ at the overflow boundary: |a| * 2^16 against |b| * 2^(2N-1), for * divisors around 2^16 and 2^17, every sign. */ { @@ -2758,6 +2802,10 @@ int main(void) static const v4_cell shift_args[][4] = { { -1, 0, 0, 0 }, { -1, 5, 0, 0 }, { 12345, 31, 0, 0 } }; headroom("LSHIFT", w_lshift, 2, shift_args, 3, 1, &dh, &rh); headroom("RSHIFT", w_rshift, 2, shift_args, 3, 1, &dh, &rh); + static const v4_cell cf_args[][4] = { { (V4_NODE_WORDS - 47) * 4 + 3, 0, 0, 0 }, { (V4_NODE_WORDS - 47) * 4, 0, 0, 0 } }; + static const v4_cell cs_args[][4] = { { 0x41, (V4_NODE_WORDS - 47) * 4 + 3, 0, 0 }, { 0xFF, (V4_NODE_WORDS - 47) * 4, 0, 0 } }; + headroom("C@", w_cfetch, 1, cf_args, 2, 1, &dh, &rh); + headroom("C!", w_cstore, 2, cs_args, 2, 0, &dh, &rh); headroom("SM/REM", w_smrem, 3, smrem_args, 5, 2, &dh, &rh); CHECK(rh >= 1, "SM/REM leaves room for /MOD's return address"); headroom("/MOD", w_slashmod, 2, slashmod_args, 4, 2, &dh, &rh);