From 981f4180ced30a151bfa74fd7da23e64c4998c16 Mon Sep 17 00:00:00 2001 From: rajames Date: Fri, 2 Oct 2026 22:58:04 -0400 Subject: [PATCH] feat(v4.0.0): Q.FROM-INT and Q.TO-INT as +* double shifts DECOMPOSITION.md 5.26 described both words in prose only. They are now written out, call-free, on one observation: +* with S = 0 never adds, so each step is an exact arithmetic right shift of the double T:A. : Q.FROM-INT ( n -- q ) push 0 a! 0 pop 15 FOR +* UNEXT push drop a pop ; T:A = n:0 is n * 2^N; N-16 shifts leave n * 2^16 (count 15 at 32-bit cells, 47 at 64). : Q.TO-INT ( q -- n ) push a! 0 pop 15 FOR +* UNEXT drop drop a ; 16 shifts at every width; the low cell is left in A. Rounds toward minus infinity, as v3's arithmetic shift does. Both clobber A; added to the section 2 list. Checked at 32- and 64-bit cells, optimised and ASan+UBSan: - Q.FROM-INT against n * 2^16 for edge values and 20000 pseudo-random n, and against v3's q48_from_u64 for n >= 0 (low cell at 64-bit, D-10). - Q.TO-INT against v3's (int64_t)q >> 16 on the edge Q values and 20000 pseudo-random Q values, and against a C double shift on 20000 arbitrary doubles. - Round trip Q.TO-INT(Q.FROM-INT(n)) = n. Mutating either shift count or the S = 0 setup fails 40000+ checks. Note: make sanitize prints UBSan reports but does not fail on them. One was found here, in the test's own random shift amount (fixed); a grep of the full sanitize output now shows no runtime errors. Co-Authored-By: Claude Opus 5.5 --- docs/v4.0.0/DECOMPOSITION.md | 6 +-- v4/tests/test_foundation.c | 99 +++++++++++++++++++++++++++++++++++- 2 files changed, 100 insertions(+), 5 deletions(-) diff --git a/docs/v4.0.0/DECOMPOSITION.md b/docs/v4.0.0/DECOMPOSITION.md index e4e2340d..6d07a2f0 100644 --- a/docs/v4.0.0/DECOMPOSITION.md +++ b/docs/v4.0.0/DECOMPOSITION.md @@ -147,7 +147,7 @@ IF body1 ELSE body2 THEN → if L1 drop body1 jump L2 times, as on the F18. `FOR ... UNEXT` is the same but the body must fit in one instruction word. **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! UM* * UM/MOD SEND RECV`. Words that clobber `B`: +document that clobber `A`: `@ ! +! -! 2@ 2! C@ C! UM* * UM/MOD Q.FROM-INT Q.TO-INT SEND RECV`. Words that clobber `B`: `SEND RECV`. **Return-stack words** (`>R R> R@ 2>R 2R> 2R@ I J UNLOOP` and the loop runtimes) are always IN. @@ -650,8 +650,8 @@ word. Per D-10 it occupies two cells on a 64-bit node too. Per D-8, v4 Q values | `Q./` | CAP | Shifted long division. **Division by zero sets an error** (v3 returned 0 silently). | | `Q.ABS` `Q.NEG` | CAP | `DABS`, `DNEGATE` — executed on the golden model (2026-10-02) against v3's `q48_abs` and `0 - q`: bit-for-bit at 32-bit cells, including v3's wrap of Q min to itself; at 64-bit cells the low cell is v3's and the high cell is the true sign, per D-10. | | `Q.LOG` `Q.EXP` `Q.SQRT` `Q.SIN` `Q.COS` | CAP | Algorithms ported from `q48_words.c`; the hosted C versions are the golden model. | -| `Q.FROM-INT` | CAP | `S>D` shifted left 16. Negative values are no longer clamped to 0. | -| `Q.TO-INT` | CAP | Shift right 16, take the low cell. | +| `Q.FROM-INT` | CAP | `push 0 a! 0 pop 15 FOR +* UNEXT push drop a pop` — `n * 2^16` as a signed double. `+*` with `S = 0` never adds, so each step is an exact arithmetic right shift of `T:A`; starting from `T:A = n:0` (that is, `n * 2^N`) and shifting `N-16` bits leaves `n * 2^16`. The count is `N-17`: 15 at 32-bit cells, 47 at 64. Negative values are no longer clamped to 0. Executed on the golden model (2026-10-02): matches v3's `q48_from_u64` for `n >= 0` (at 64-bit cells in the low cell, where v3 wraps for `n >= 2^47`, per D-10). Clobbers `A`. | +| `Q.TO-INT` | CAP | `push a! 0 pop 15 FOR +* UNEXT drop drop a` — the same `+*` shift, 16 bits at every cell width, leaving the low cell in `A`. Rounds toward minus infinity, as v3's arithmetic shift does (−1.5 gives −2). Executed on the golden model (2026-10-02): v3's `q48_to_u64` exactly at 64-bit cells, its low cell at 32. Clobbers `A`. | | `Q.1` `Q.0` `Q.SCALE` | IN | Double-cell constants. | | `Q.=` `Q.<` `Q.>` `Q.0=` `Q.MAX` `Q.MIN` | CAP | `D=`, `D<`, `SWAP D<` (for `Q.>`), `D0=`, `DMAX`, `DMIN`. Signed. | | `Q.PRINT` | CAP | Pictured output, five fractional digits. | diff --git a/v4/tests/test_foundation.c b/v4/tests/test_foundation.c index a8512021..da962186 100644 --- a/v4/tests/test_foundation.c +++ b/v4/tests/test_foundation.c @@ -17,7 +17,9 @@ * U>, ABS, S>D, DABS, M+, D-, D0= and D= are as written in section 5 and * checked against C. Q.+, Q.-, Q.ABS and Q.NEG (section 5.26: the D+, D-, * DABS and DNEGATE words) are checked against v3's 64-bit q48_add, q48_sub, - * q48_abs and 0 - q, with Q values two cells wide at both widths (D-10). Every word is + * q48_abs and 0 - q, with Q values two cells wide at both widths (D-10). + * Q.FROM-INT and Q.TO-INT are checked against n * 2^16 and q >> 16 in C and + * against v3's q48_from_u64 and q48_to_u64 where v4 keeps v3's meaning. Every word is * also probed for how much of the 10- and 9-deep circular stacks (D-2) it * leaves to its caller. * @@ -46,7 +48,8 @@ static v4_asm as; static v4_cell w_nip, w_swap, w_or, w_negate, w_rot, w_zless, w_zequal, w_2dup, w_minus, w_uless, w_umstar, w_ummod, w_ugreater, w_abs, w_s2d, w_dplus, w_dnegate, w_dabs, w_smrem, - w_slashmod, w_mplus, w_dminus, w_d0equal, w_dequal; + w_slashmod, w_mplus, w_dminus, w_d0equal, w_dequal, + w_qfromint, w_qtoint; #define O(name) v4_asm_op(&as, V4_OP_##name) #define LIT(v) v4_asm_lit(&as, (v4_cell)(v)) @@ -346,6 +349,31 @@ static void build(void) w_dequal = v4_asm_label(&as); CALL(w_dminus); CALL(w_d0equal); O(SEMI); + /* +* with S = 0 never adds: each step is an exact arithmetic right shift + * of the double T:A by one bit. Both words below are built on that. */ + + /* : Q.FROM-INT ( n -- q ) 5.26 + * push 0 a! 0 pop 15 FOR +* UNEXT push drop a pop ; + * T:A = n:0 is n * 2^N; shifted right N-16 bits it is n * 2^16. 15 is + * N-17 at 32-bit cells (47 at 64). Clobbers A. */ + w_qfromint = v4_asm_label(&as); + O(PUSH); LIT(0); O(BANG_A); LIT(0); O(RPOP); + LIT(V4_CELL_BITS - 17); O(PUSH); + (void)v4_asm_label(&as); + O(MUL_STEP); O(UNEXT); + O(PUSH); O(DROP); O(PUSH_A); O(RPOP); O(SEMI); + + /* : Q.TO-INT ( q -- n ) 5.26 + * push a! 0 pop 15 FOR +* UNEXT drop drop a ; + * T:A = q shifted right 16 bits; the low cell is A. 15 at every cell + * width. Clobbers A. */ + w_qtoint = v4_asm_label(&as); + O(PUSH); O(BANG_A); LIT(0); O(RPOP); + LIT(15); O(PUSH); + (void)v4_asm_label(&as); + O(MUL_STEP); O(UNEXT); + O(DROP); O(DROP); O(PUSH_A); O(SEMI); + CHECK(v4_asm_ok(&as), "foundation words assemble"); } @@ -521,6 +549,21 @@ static int q1_matches_v3(v4_cell word, uint64_t a, uint64_t v3) #endif } +/* x shifted right `k` bits, arithmetic, without C's implementation-defined + * right shift of a negative value. */ +static v4_ucell asr_u(v4_ucell x, unsigned k) +{ + v4_ucell r = x >> k; + if (k && (x & V4_MSB)) r |= ~(MAXU >> k); + return r; +} +static uint64_t asr64(uint64_t x, unsigned k) +{ + uint64_t r = x >> k; + if (k && (x >> 63)) r |= ~((~(uint64_t)0) >> k); + return r; +} + /* Stack headroom. Run `word` with `dfill` marked cells under the canary and * `rfill` marked cells under its return address, and report whether the * results, the canary and every marked cell come back intact. The F18 stacks @@ -821,6 +864,58 @@ int main(void) } printf(" Q.+ random cases that overflow Q48.16: %u of 20000\n", over); + /* Q.FROM-INT: n * 2^16 as a signed double. v3 clamps n < 0 to 0 + * (section 5.26 retires that) and wraps at 64 bits, so v3's value is + * checked only for n >= 0, and at 64-bit cells only in the low cell + * (D-10). */ + for (unsigned i = 0; i < NVEC + 20000u; i++) { + v4_cell nn, el, eh; + if (i < NVEC) nn = vec[i]; + else { + x ^= x << 13; x ^= x >> 7; x ^= x << 17; + nn = (v4_cell)(v4_ucell)x; + if (i & 1u) nn = (v4_cell)asr_u((v4_ucell)nn, (unsigned)(x >> 58) % V4_CELL_BITS); + } + el = (v4_cell)((v4_ucell)nn << 16); + eh = (v4_cell)asr_u((v4_ucell)nn, V4_CELL_BITS - 16); + CHECK(call(w_qfromint, 1, nn, 0, 0) && left2(el, eh), "Q.FROM-INT [%u]", i); + if (nn >= 0) { + uint64_t v3 = (uint64_t)(v4_ucell)nn << 16; + v4_cell vl, vh; + qcells(v3, &vl, &vh); + CHECK(call(w_qfromint, 1, nn, 0, 0) && n.ds.s == vl + && (V4_CELL_BITS == 64 || n.ds.t == vh), "Q.FROM-INT v3 [%u]", i); + } + /* and back */ + CHECK(call(w_qfromint, 1, nn, 0, 0) + && (v4_test_call(&n, &es, &h, w_qtoint, 100000) > 0) && left1(nn), + "Q.TO-INT Q.FROM-INT [%u]", i); + } + + /* Q.TO-INT: v3's (int64_t)q >> 16, arithmetic. At 32-bit cells the + * result is its low cell; at 64-bit cells it is v3's value exactly. */ + for (unsigned i = 0; i < nq + 20000u; i++) { + uint64_t q; + v4_cell ql, qh; + if (i < nq) q = qv[i]; + else { + x ^= x << 13; x ^= x >> 7; x ^= x << 17; q = x; + if (i & 1u) q = asr64(q, (unsigned)(x >> 58)); + } + qcells(q, &ql, &qh); + CHECK(call(w_qtoint, 2, ql, qh, 0) && left1((v4_cell)(v4_ucell)asr64(q, 16)), + "Q.TO-INT v3 [%u]", i); + } + /* and on any double, not only sign-extended ones */ + for (unsigned i = 0; i < 20000; i++) { + v4_ucell lo, hi; + x ^= x << 13; x ^= x >> 7; x ^= x << 17; lo = (v4_ucell)x; + x ^= x << 13; x ^= x >> 7; x ^= x << 17; hi = (v4_ucell)x; + CHECK(call(w_qtoint, 2, (v4_cell)lo, (v4_cell)hi, 0) + && left1((v4_cell)((lo >> 16) | (hi << (V4_CELL_BITS - 16)))), + "Q.TO-INT double [%u]", i); + } + /* Q.ABS and Q.NEG against v3's q48_abs and 0 - q. */ for (unsigned i = 0; i < nq; i++) { uint64_t q = qv[i];