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 <noreply@anthropic.com>
This commit is contained in:
rajames
co-authored by
Claude Opus 5.5
Claude Opus 5.5
parent
d948e0c1a3
commit
981f4180ce
@@ -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. |
|
||||
|
||||
@@ -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];
|
||||
|
||||
Reference in New Issue
Block a user