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

test(v4.0.0): execute LSHIFT and RSHIFT on the golden model

Browse Source 
Both run exactly as written in DECOMPOSITION.md 5.5 and need no change.
Checked against C on the edge vectors for every count 0 .. N (a count
of N gives 0), at 32- and 64-bit cells, optimised and ASan+UBSan
(`make test`, `make sanitize`). Removing RSHIFT's sign-bit mask fails.

Headroom (data under args / return): 7/5 each.

They are dependencies of C@ and C!, which the pictured-output hold
buffer needs.

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>
This commit is contained in:
rajames
2026-10-03 11:10:03 -04:00
co-authored by Claude Opus 5.5
parent 13ec4b1b6c
commit f030edcd08
2 changed files with 44 additions and 3 deletions
Download Patch File Download Diff File Expand all files Collapse all files
docs/v4.0.0/DECOMPOSITION.md
+2 -2
View File
@@ -379,8 +379,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
+42 -1
View File
@@ -81,7 +81,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;
#define O(name) v4_asm_op(&as, V4_OP_##name)
#define LIT(v) v4_asm_lit(&as, (v4_cell)(v))
@@ -1325,6 +1326,32 @@ 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);
}
CHECK(v4_asm_ok(&as), "foundation words assemble");
}
@@ -2589,6 +2616,17 @@ 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);
}
/* 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 +2755,9 @@ 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);
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);