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 <noreply@anthropic.com>

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 ;
 
@@ -379,8 +381,8 @@ Section numbers match the v3 primitive reference.
 | `OR` | CAP | §4 |
 | `INVERT` | OP | `inv` |
 | `NOT` | CAP | `0=` (FORTH-79 logical not, as in v3) |
-| `LSHIFT` | CAP | `BEGIN dup WHILE 1- SWAP 2* SWAP REPEAT drop` |
-| `RSHIFT` | CAP | `BEGIN dup WHILE 1- SWAP 2/ MSB inv and SWAP REPEAT drop` (clears the sign bit each step; `MSB` is the cell-width top-bit constant) |
+| `LSHIFT` | CAP | `BEGIN dup WHILE 1- SWAP 2* SWAP REPEAT drop` — executed on the golden model (2026-10-03). |
+| `RSHIFT` | CAP | `BEGIN dup WHILE 1- SWAP 2/ MSB inv and SWAP REPEAT drop` (clears the sign bit each step; `MSB` is the cell-width top-bit constant) — executed on the golden model (2026-10-03). |
 | `0=` `0<` | CAP | §4 |
 | `0<>` | CAP | `0= 0=` |
 | `0>` | CAP | `dup 0< SWAP 0= OR 0=` (correct for the most negative number) |

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)
 
@@ -81,7 +83,8 @@ static v4_cell w_nip, w_swap, w_or, w_negate, w_rot, w_zless, w_zequal,
                w_qfromint, w_qtoint, w_less, w_equal, w_dless, w_2swap, w_2over,
                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_q1, w_q0, w_qscale, w_q1_times, w_q0_plus, w_q1_toint, w_one_fromint,
+               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))
@@ -1325,6 +1328,52 @@ static void build(void)
 #undef Q_ZERO
 #undef Q_ONE
 
+    /* : LSHIFT ( x n -- x<<n )  BEGIN dup WHILE 1- SWAP 2* SWAP REPEAT drop ;      5.5
+     * : RSHIFT ( x n -- x>>n )  BEGIN dup WHILE 1- SWAP 2/ MSB inv and SWAP REPEAT drop ;
+     * As written.  Section 2 expands BEGIN ... WHILE ... REPEAT as it does IF:
+     *   L0: dup if L1  drop <body> jump L0   L1: drop
+     * 1- is in line (-1 +); SWAP is a call. */
+    {
+        v4_cell l0;
+        v4_asm_ref l1;
+        w_lshift = v4_asm_label(&as);
+        l0 = v4_asm_label(&as);
+        O(DUP); l1 = v4_asm_branch_fwd(&as, V4_OP_IF);
+        O(DROP); LIT(-1); O(ADD); CALL(w_swap); O(TWO_STAR); CALL(w_swap);
+        v4_asm_branch(&as, V4_OP_JUMP, l0);
+        v4_asm_resolve(&as, l1, v4_asm_label(&as));
+        O(DROP); O(DROP); O(SEMI);
+
+        w_rshift = v4_asm_label(&as);
+        l0 = v4_asm_label(&as);
+        O(DUP); l1 = v4_asm_branch_fwd(&as, V4_OP_IF);
+        O(DROP); LIT(-1); O(ADD); CALL(w_swap);
+        O(TWO_SLASH); LIT((v4_cell)V4_MSB); O(INV); O(AND); CALL(w_swap);
+        v4_asm_branch(&as, V4_OP_JUMP, l0);
+        v4_asm_resolve(&as, l1, v4_asm_label(&as));
+        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");
 }
 
@@ -2589,6 +2638,39 @@ int main(void)
         }
     }
 
+    /* LSHIFT and RSHIFT as written, against C, for every count 0 .. N (a
+     * count of N must give 0). */
+    for (unsigned i = 0; i < NVEC; i++)
+        for (unsigned c = 0; c <= V4_CELL_BITS; c++) {
+            v4_ucell u = (v4_ucell)vec[i];
+            v4_ucell l = c < V4_CELL_BITS ? u << c : 0u;
+            v4_ucell r = c < V4_CELL_BITS ? u >> c : 0u;
+            CHECK(call(w_lshift, 2, vec[i], (v4_cell)c, 0) && left1((v4_cell)l), "LSHIFT [%u,%u]", i, c);
+            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. */
     {
@@ -2717,6 +2799,13 @@ int main(void)
             CHECK(dh >= 2 && rh >= 2, "Q.SIN leaves room");
             headroom("Q.COS", w_qcos, 2, qtrig_args, 6, 2, &dh, &rh);
             CHECK(dh >= 2 && rh >= 2, "Q.COS leaves room");
+            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);