From 481d484e93e8174c4295034f51bcd8f3061caf8d Mon Sep 17 00:00:00 2001 From: rajames Date: Sat, 3 Oct 2026 18:37:53 -0400 Subject: [PATCH] feat(v4.0.0): the mixed and double leftovers M- M* M/MOD MOD */ */MOD, D0< D2* D2/ 2ROT, 2DROP and 2>R 2R@ 2R>, beside UM* and SM/REM in test_foundation.c. Executed on the golden model at both cell widths against C and results recorded from the v3 binary. M- widens n before negating it, so the most negative n is right. */MOD goes through a full double product. D2/ is one +* step. M- and M/MOD take the double in the standard order ( lo hi ), as M+ does; v3 took its low cell on top. The foundation test's node is now full: 958 of the 960 words below its variables. Co-Authored-By: Claude Opus 5.5 --- docs/v4.0.0/DECOMPOSITION.md | 32 ++--- v4/tests/test_foundation.c | 248 ++++++++++++++++++++++++++++++++++- 2 files changed, 263 insertions(+), 17 deletions(-) diff --git a/docs/v4.0.0/DECOMPOSITION.md b/docs/v4.0.0/DECOMPOSITION.md index 47a3aafb..c31039a8 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! FILL ERASE MOVE COUNT CMOVE CMOVE> BLANK -TRAILING COMPARE SEARCH SCAN SKIP DECIMAL HEX OCTAL UM* * UM/MOD Q.FROM-INT Q.TO-INT Q.* Q./ Q.EXP Q.SQRT Q.LOG Q.SIN Q.COS HOLD SIGN # #S . .R U. U.R D. D.R ? DUMP Q.PRINT TYPE SEND RECV`. Words that clobber `B`: +document that clobber `A`: `@ ! +! -! 2@ 2! C@ C! D2/ M* FILL ERASE MOVE COUNT CMOVE CMOVE> BLANK -TRAILING COMPARE SEARCH SCAN SKIP DECIMAL HEX OCTAL UM* * UM/MOD Q.FROM-INT Q.TO-INT Q.* Q./ Q.EXP Q.SQRT Q.LOG Q.SIN Q.COS HOLD SIGN # #S . .R U. U.R D. D.R ? DUMP Q.PRINT TYPE SEND RECV`. Words that clobber `B`: `COMPARE SEARCH Q./ Q.EXP Q.SQRT Q.LOG Q.SIN Q.COS <# HOLD SIGN # #S #> . .R U. U.R D. D.R ? DUMP Q.PRINT EMIT CR SPACE SPACES TYPE SEND RECV`. **Return-stack words** (`>R R> R@ 2>R 2R> 2R@ I J UNLOOP` and the loop runtimes) are always IN. @@ -422,13 +422,13 @@ A double is two 32-bit cells on a mesh node. | Word | Fate | v4 definition | | --- | --- | --- | | `M+` | CAP | `S>D D+` — executed on the golden model (2026-10-02). | -| `M-` | CAP | `NEGATE M+` | -| `M*` | CAP | `2DUP xor push ABS SWAP ABS UM* pop 0< IF DNEGATE THEN` | -| `M/MOD` | CAP | `SM/REM` | -| `MOD` | CAP | `/MOD drop` | +| `M-` | CAP | `( d n -- d )`: `S>D DNEGATE jump D+`, `S>D` by a sign test in line. `n` is widened before it is negated, so the most negative `n` is subtracted correctly; `NEGATE M+` would add it. Executed on the golden model (2026-10-03) against C and results recorded from the v3 binary (v3 took the double with its low cell on top; the standard order is kept here, as for `M+`). Leaves its caller 5 data cells and 5 return entries. | +| `M*` | CAP | `( n1 n2 -- d )`: `over over xor push -if A inv 1 + A: push -if B inv 1 + B: pop UM* pop -if P drop jump DNEGATE P: drop ;` — the unsigned product of the magnitudes, negated when the signs differ; the sign tests are native. Executed on the golden model (2026-10-03) against C and results recorded from the v3 binary. Leaves its caller 6 data cells and 4 return entries. Clobbers `A`. | +| `M/MOD` | CAP | `( d n -- rem quot )`: `jump SM/REM`. Truncating, the remainder with the dividend's sign, as v3. v3 took the double with its low cell on top (`dhigh dlow n`), the reverse of what its own `M*` leaves; the standard order is kept here, so `M* ... M/MOD` composes. Executed on the golden model (2026-10-03), including results recorded from the v3 binary with the double's cells exchanged. Leaves its caller 5 data cells and 3 return entries. | +| `MOD` | CAP | `/MOD drop`, with `/MOD`'s body in line: `push S>D pop SM/REM drop`. The remainder has the dividend's sign, as v3. Executed on the golden model (2026-10-03) against C and results recorded from the v3 binary. Leaves its caller 5 data cells and 2 return entries. Division by zero is unspecified, as for `/`. | | `/MOD` | CAP | `push S>D pop SM/REM` — executed on the golden model (2026-10-02). | -| `*/` | CAP | `*/MOD NIP` | -| `*/MOD` | CAP | `push M* pop SM/REM` | +| `*/` | CAP | `*/MOD NIP`, as `push M* pop SM/REM push drop pop`. Executed on the golden model (2026-10-03). Leaves its caller 5 data cells and 2 return entries. | +| `*/MOD` | CAP | `( n1 n2 n3 -- rem quot )`: `push M* pop jump SM/REM` — the product is a full double, so the answer is exact whenever the quotient fits a cell. v3 multiplied in one cell at 64-bit cells and so was right only while `n1 * n2` fitted one; the two agree there. Executed on the golden model (2026-10-03) against the identity `quot * n3 + rem = n1 * n2` on every combination of the edge values, and results recorded from the v3 binary. Leaves its caller 5 data cells and 2 return entries. | ### 5.7 Double-cell numbers @@ -440,22 +440,22 @@ A double is two 32-bit cells on a mesh node. | `D-` | CAP | `DNEGATE D+` — executed on the golden model (2026-10-02). | | `DABS` | CAP | `dup 0< IF DNEGATE THEN` — executed on the golden model (2026-10-02). | | `D0=` | CAP | `OR 0=` — executed on the golden model (2026-10-02). | -| `D0<` | CAP | `NIP 0<` | +| `D0<` | CAP | `NIP 0<`, as `push drop pop jump 0<`. Executed on the golden model (2026-10-03), including results recorded from the v3 binary. | | `D=` | CAP | `D- D0=` — executed on the golden model (2026-10-02). | | `D<` | CAP | `ROT 2DUP = IF 2DROP U< ELSE SWAP < NIP NIP THEN` — executed on the golden model (2026-10-02). | | `(D<)` | CAP | `( d1 d2 -- d1 d2 flag )`, call-free; internal to `DMAX` and `DMIN`. Copies of the high cells go on top; if they differ the flag comes from them, else from the low cells unsigned. The value tested always has its top bit set exactly when `d1 < d2`: `ah` (high signs differ), `ah - bh` (agree), `bl` (low top bits differ), `al - bl` (agree); `x - y` with `y` on top is `push inv pop + inv`. `dup push push over pop over over xor if TIE drop over over xor -if HS drop drop jump S1 HS: drop push inv pop + inv S1: -if N1 drop -1 jump D1 N1: drop 0 D1: pop SWAP ; TIE: drop drop drop dup push push over pop over over xor -if LS drop NIP jump S2 LS: drop push inv pop + inv S2: -if N2 drop -1 jump D2 N2: drop 0 D2: pop pop ROT ;` with `SWAP`, `NIP` and `ROT` in line. Executed on the golden model (2026-10-02). | | `DMAX` | CAP | `(D<) if L drop push push drop drop pop pop ; L: drop drop drop ;` Executed on the golden model (2026-10-02). Replaces `2OVER 2OVER D< IF 2SWAP THEN 2DROP`, which needs 8 data cells plus `D<`'s 2: the whole 10-deep data stack, so it failed whenever the caller held anything at all (D-2). | | `DMIN` | CAP | `(D<) if L drop drop drop ; L: drop push push drop drop pop pop ;` Executed on the golden model (2026-10-02); replaces `2OVER 2OVER D< 0= IF 2SWAP THEN 2DROP` for the same reason as `DMAX`. | -| `D2*` | CAP | `2* over 0< NEGATE OR SWAP 2* SWAP` | -| `D2/` | CAP | `dup 1 and push 2/ SWAP 1 RSHIFT pop IF MSB OR THEN SWAP` | -| `2DROP` | IN | `drop drop` | -| `2DUP` | IN | `over over` | +| `D2*` | CAP | `2* over -if P drop 1 + jump J P: drop J: push 2* pop` — the low cell's top bit enters the high cell; a native sign test in place of `over 0< NEGATE OR`. Executed on the golden model (2026-10-03), including results recorded from the v3 binary. | +| `D2/` | CAP | `push a! 0 pop +* push drop a pop` — one `+*` with `S = 0` is an exact arithmetic right shift of `T:A`, as in `Q.FROM-INT`. It replaces `dup 1 and push 2/ SWAP 1 RSHIFT pop IF MSB OR THEN SWAP`. Executed on the golden model (2026-10-03), including results recorded from the v3 binary. Clobbers `A`. | +| `2DROP` | IN | `drop drop` — executed on the golden model (2026-10-03). | +| `2DUP` | IN | `over over` — executed on the golden model (2026-10-03). | | `2SWAP` | CAP | `ROT push ROT pop`, with `ROT` and `SWAP` in line so it makes no calls. Executed on the golden model (2026-10-02). Called, `ROT` and `SWAP` left its caller 2 return entries; in line, 4. | | `2OVER` | CAP | `push push 2DUP pop pop 2SWAP` — executed on the golden model (2026-10-02). | -| `2ROT` | CAP | `2>R 2SWAP 2R> 2SWAP` | -| `2>R` | IN | `SWAP push push` | -| `2R>` | IN | `pop pop SWAP` | -| `2R@` | IN | `pop pop 2DUP push push SWAP` | +| `2ROT` | CAP | `push push 2SWAP pop pop jump 2SWAP`. Executed on the golden model (2026-10-03), including a result recorded from the v3 binary. With six cells of its own it leaves its caller 3 data cells and 1 return entry. | +| `2>R` | IN | `SWAP push push` — executed on the golden model (2026-10-03) with `2R@` and `2R>`; the high cell is on top of the return stack, as in v3. | +| `2R>` | IN | `pop pop SWAP` — see `2>R`. | +| `2R@` | IN | `pop pop 2DUP push push SWAP` — see `2>R`. | ### 5.8 Number formatting and output diff --git a/v4/tests/test_foundation.c b/v4/tests/test_foundation.c index 82373090..25440262 100644 --- a/v4/tests/test_foundation.c +++ b/v4/tests/test_foundation.c @@ -79,7 +79,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_star, w_slash, w_mplus, w_dminus, w_d0equal, w_dequal, + w_slashmod, w_star, w_slash, w_mminus, w_mstar, w_mslashmod, w_mod, w_starslashmod, + w_starslash, w_d0less, w_d2star, w_d2slash, w_2rot, w_2drop, t_2r, t_2rorder, w_mplus, w_dminus, w_d0equal, w_dequal, 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, @@ -1434,7 +1435,101 @@ static void build(void) O(DROP); O(FETCH_A); LIT(-256); O(AND); O(ADD); O(STORE_A); O(SEMI); } + /* ---- the rest of 5.6 and 5.7 ---- */ +#define FWD(op) v4_asm_branch_fwd(&as, V4_OP_##op) +#define HERE_(r) v4_asm_resolve(&as, (r), v4_asm_label(&as)) +#define SWAP_INLINE() do { O(OVER); O(PUSH); O(PUSH); O(DROP); O(RPOP); O(RPOP); } while (0) + { + v4_asm_ref a, b; + + /* : M- ( d n -- d ) S>D DNEGATE jump D+ + * S>D in line: dup -if P drop -1 jump J P: drop 0 J: + * d - n as d + (-n) with n widened first, so the most negative n is + * subtracted correctly (NEGATE M+ would add it). */ + w_mminus = v4_asm_label(&as); + O(DUP); a = FWD(MINUS_IF); O(DROP); LIT(-1); b = FWD(JUMP); + HERE_(a); O(DROP); LIT(0); + HERE_(b); + CALL(w_dnegate); v4_asm_branch(&as, V4_OP_JUMP, w_dplus); + + /* : M* ( n1 n2 -- d ) + * over over xor push R: sign of the product + * -if A inv 1 + A: push -if B inv 1 + B: pop |n1| |n2| + * UM* pop -if P drop jump DNEGATE P: drop ; */ + w_mstar = v4_asm_label(&as); + O(OVER); O(OVER); O(XOR); O(PUSH); + a = FWD(MINUS_IF); O(INV); LIT(1); O(ADD); HERE_(a); + O(PUSH); + a = FWD(MINUS_IF); O(INV); LIT(1); O(ADD); HERE_(a); + O(RPOP); + CALL(w_umstar); O(RPOP); a = FWD(MINUS_IF); + O(DROP); v4_asm_branch(&as, V4_OP_JUMP, w_dnegate); + HERE_(a); O(DROP); O(SEMI); + + /* : M/MOD ( d n -- rem quot ) jump SM/REM */ + w_mslashmod = v4_asm_label(&as); + v4_asm_branch(&as, V4_OP_JUMP, w_smrem); + + /* : MOD ( n1 n2 -- rem ) /MOD drop, /MOD's body in line */ + w_mod = v4_asm_label(&as); + O(PUSH); CALL(w_s2d); O(RPOP); CALL(w_smrem); O(DROP); O(SEMI); + + // : */MOD ( n1 n2 n3 -- rem quot ) push M* pop jump SM/REM + w_starslashmod = v4_asm_label(&as); + O(PUSH); CALL(w_mstar); O(RPOP); v4_asm_branch(&as, V4_OP_JUMP, w_smrem); + + // : */ ( n1 n2 n3 -- quot ) push M* pop SM/REM push drop pop ; that is, */MOD NIP + w_starslash = v4_asm_label(&as); + O(PUSH); CALL(w_mstar); O(RPOP); CALL(w_smrem); O(PUSH); O(DROP); O(RPOP); O(SEMI); + + /* : D0< ( d -- flag ) push drop pop jump 0< NIP 0< */ + w_d0less = v4_asm_label(&as); + O(PUSH); O(DROP); O(RPOP); v4_asm_branch(&as, V4_OP_JUMP, w_zless); + + /* : D2* ( d -- 2d ) + * 2* over -if P drop 1 + jump J P: drop J: push 2* pop ; + * the low cell's top bit enters the high cell. */ + w_d2star = v4_asm_label(&as); + O(TWO_STAR); O(OVER); a = FWD(MINUS_IF); O(DROP); LIT(1); O(ADD); b = FWD(JUMP); + HERE_(a); O(DROP); + HERE_(b); + O(PUSH); O(TWO_STAR); O(RPOP); O(SEMI); + + /* : D2/ ( d -- d/2 ) push a! 0 pop +* push drop a pop ; + * one +* with S = 0 is an exact arithmetic right shift of T:A (as in + * Q.FROM-INT). Clobbers A. */ + w_d2slash = v4_asm_label(&as); + O(PUSH); O(BANG_A); LIT(0); O(RPOP); O(MUL_STEP); O(PUSH); O(DROP); O(PUSH_A); O(RPOP); O(SEMI); + + /* : 2ROT ( d1 d2 d3 -- d2 d3 d1 ) push push 2SWAP pop pop jump 2SWAP */ + w_2rot = v4_asm_label(&as); + O(PUSH); O(PUSH); CALL(w_2swap); O(RPOP); O(RPOP); v4_asm_branch(&as, V4_OP_JUMP, w_2swap); + + /* 2DROP is drop drop */ + w_2drop = v4_asm_label(&as); + O(DROP); O(DROP); O(SEMI); + + /* ( d -- d d ) 2>R 2R@ 2R> in line: + * 2>R is SWAP push push + * 2R@ is pop pop 2DUP push push SWAP + * 2R> is pop pop SWAP */ + t_2r = v4_asm_label(&as); + SWAP_INLINE(); O(PUSH); O(PUSH); + O(RPOP); O(RPOP); O(OVER); O(OVER); O(PUSH); O(PUSH); SWAP_INLINE(); + O(RPOP); O(RPOP); SWAP_INLINE(); + O(SEMI); + + /* ( lo hi -- hi lo ) 2>R R> R> the high cell is on top of R, as in v3 */ + t_2rorder = v4_asm_label(&as); + SWAP_INLINE(); O(PUSH); O(PUSH); O(RPOP); O(RPOP); O(SEMI); + } +#undef SWAP_INLINE +#undef HERE_ +#undef FWD + CHECK(v4_asm_ok(&as), "foundation words assemble"); + CHECK(v4_asm_label(&as) <= BYTES, "code stays below the variables"); + printf(" code: %ld of %u words\n", (long)v4_asm_label(&as) - 16, (unsigned)V4_NODE_WORDS); } /* Call `word` with a canary and up to three arguments on fresh stacks. */ @@ -1547,6 +1642,51 @@ static int smrem_exact(v4_cell q, v4_cell nn, v4_cell r) return call(w_smrem, 3, (v4_cell)dl, (v4_cell)dh, nn) && left2(r, q); } +/* Six arguments, for 2ROT. */ +static int call6(v4_cell word, const v4_cell *a, unsigned dfill, unsigned rfill) +{ + unsigned i; + v4_dstack_reset(&n.ds); + v4_rstack_reset(&n.rs); + v4_exec_reset(&es); + for (i = 0; i < dfill; i++) v4_dstack_push(&n.ds, (v4_cell)(0x5A000000 + i)); + v4_dstack_push(&n.ds, CANARY); + for (i = 0; i < 6; i++) v4_dstack_push(&n.ds, a[i]); + for (i = 0; i < rfill; i++) v4_rstack_push(&n.rs, (v4_cell)(0x6B000000 + i)); + return v4_test_call(&n, &es, &h, word, 4000000) > 0; +} +static int rot6_ok(const v4_cell *a, unsigned dfill, unsigned rfill) +{ + static const unsigned from[6] = { 2, 3, 4, 5, 0, 1 }; /* d2 d3 d1 */ + unsigned i; + if (!call6(w_2rot, a, dfill, rfill)) return 0; + for (i = 6; i-- > 0; ) if (v4_dstack_pop(&n.ds) != a[from[i]]) return 0; + if (v4_dstack_pop(&n.ds) != CANARY) return 0; + for (i = dfill; i-- > 0; ) if (v4_dstack_pop(&n.ds) != (v4_cell)(0x5A000000 + i)) return 0; + for (i = rfill; i-- > 0; ) if (v4_rstack_pop(&n.rs) != (v4_cell)(0x6B000000 + i)) return 0; + return 1; +} + +/* n1 * n2 / n3 through a double product. Returns 1 when the truncated + * quotient fits a cell and (r, q) is it: q*n3 + r = n1*n2, |r| < |n3|, r zero + * or of the product's sign; 0 when it fits and (r, q) is wrong; -1 when it + * does not fit (unspecified, as for SM/REM). */ +static int starslash_ref(v4_cell n1, v4_cell n2, v4_cell n3, v4_cell r, v4_cell q) +{ + v4_ucell pl, ph, al, ah, ql, qh, sl, sh, un3 = n3 < 0 ? 0u - (v4_ucell)n3 : (v4_ucell)n3, ur; + int pneg; + smul(n1, n2, &pl, &ph); + pneg = (ph & V4_MSB) != 0; + al = pl; ah = ph; + if (pneg) dneg(pl, ph, &al, &ah); + if (ah >= (V4_MSB >> 1)) return -1; + if (((ah << 1) | (al >> (V4_CELL_BITS - 1))) >= un3) return -1; /* |p| >= |n3| * 2^(N-1) */ + smul(q, n3, &ql, &qh); + dadd(ql, qh, (v4_ucell)r, r < 0 ? MAXU : 0u, &sl, &sh); + ur = r < 0 ? 0u - (v4_ucell)r : (v4_ucell)r; + return sl == pl && sh == ph && ur < un3 && (r == 0 || (r < 0) == pneg); +} + /* Q48.16 (section 5.26). v3's Q.+ and Q.- are uint64_t a + b and a - b, * wrapping (v3/include/q48_16.h). Here a Q value is a double: at 32-bit * cells its two halves, at 64-bit cells the value sign-extended (D-8). */ @@ -2098,6 +2238,79 @@ int main(void) } } + /* The rest of 5.6 and 5.7. "v3:" marks results recorded from the v3 + * binary on 2026-10-03; v3's M- and M/MOD took the double with its low + * cell on top, so their arguments are in v4's order here. */ + CHECK(call(w_mstar, 2, 6, 7, 0) && left2(42, 0), "v3: 6 7 M*"); + CHECK(call(w_mstar, 2, -6, 7, 0) && left2(-42, -1), "v3: -6 7 M*"); + CHECK(call(w_mod, 2, 17, 5, 0) && left1(2), "v3: 17 5 MOD"); + CHECK(call(w_mod, 2, -17, 5, 0) && left1(-2), "v3: -17 5 MOD"); + CHECK(call(w_mod, 2, 17, -5, 0) && left1(2), "v3: 17 -5 MOD"); + CHECK(call(w_starslash, 3, 7, 3, 2) && left1(10), "v3: 7 3 2 */"); + CHECK(call(w_starslash, 3, -7, 3, 2) && left1(-10), "v3: -7 3 2 */"); + CHECK(call(w_starslashmod, 3, 7, 3, 2) && left2(1, 10), "v3: 7 3 2 */MOD"); + CHECK(call(w_starslashmod, 3, -7, 3, 2) && left2(-1, -10), "v3: -7 3 2 */MOD"); + CHECK(call(w_d0less, 2, 5, 0, 0) && left1(0), "v3: 5 0 D0<"); + CHECK(call(w_d0less, 2, 5, -1, 0) && left1(-1), "v3: 5 -1 D0<"); + CHECK(call(w_d2star, 2, 3, 0, 0) && left2(6, 0), "v3: 3 0 D2*"); + CHECK(call(w_d2star, 2, -1, 0, 0) && left2(-2, 1), "v3: -1 0 D2*"); + CHECK(call(w_d2slash, 2, 6, 0, 0) && left2(3, 0), "v3: 6 0 D2/"); + CHECK(call(w_d2slash, 2, 1, 1, 0) && left2((v4_cell)V4_MSB, 0), "v3: 1 1 D2/"); + CHECK(call(w_d2slash, 2, -4, -1, 0) && left2(-2, -1), "v3: -4 -1 D2/"); + CHECK(call(w_mslashmod, 3, 100, 0, 7) && left2(2, 14), "v3: 100 7 M/MOD"); + CHECK(call(w_mslashmod, 3, -100, -1, 7) && left2(-2, -14), "v3: -100 7 M/MOD"); + CHECK(call(w_mminus, 3, 100, 0, 7) && left2(93, 0), "v3: 100 7 M-"); + CHECK(call(w_mminus, 3, 100, 0, -7) && left2(107, 0), "v3: 100 -7 M-"); + CHECK(call(w_2drop, 3, 1, 2, 3) && left1(1), "v3: 1 2 3 2DROP"); + CHECK(call(t_2r, 2, 1, 2, 0) && v4_dstack_pop(&n.ds) == 2 && v4_dstack_pop(&n.ds) == 1 && left2(1, 2), + "v3: 1 2 2>R 2R@ 2R>"); + CHECK(call(t_2rorder, 2, 1, 2, 0) && left2(2, 1), "2>R leaves the high cell on top of R"); + { + static const v4_cell six[6] = { 1, 2, 3, 4, 5, 6 }; + CHECK(rot6_ok(six, 0, 0), "v3: 1 2 3 4 5 6 2ROT"); + } + for (unsigned i = 0; i < NVEC; i++) + for (unsigned j = 0; j < NVEC; j++) { + v4_cell a = vec[i], b = vec[j]; + v4_ucell ua = (v4_ucell)a, ub = (v4_ucell)b, pl, ph; + smul(a, b, &pl, &ph); + CHECK(call(w_mstar, 2, a, b, 0) && left2((v4_cell)pl, (v4_cell)ph), "M* [%u,%u]", i, j); + CHECK(call(w_d0less, 2, a, b, 0) && left1(FLAG(b < 0)), "D0< [%u,%u]", i, j); + CHECK(call(w_d2star, 2, a, b, 0) + && left2((v4_cell)(ua << 1), (v4_cell)((ub << 1) | (ua >> (V4_CELL_BITS - 1)))), "D2* [%u,%u]", i, j); + CHECK(call(w_d2slash, 2, a, b, 0) + && left2((v4_cell)((ua >> 1) | (ub << (V4_CELL_BITS - 1))), (v4_cell)((ub >> 1) | (ub & V4_MSB))), + "D2/ [%u,%u]", i, j); + CHECK(call(w_2drop, 3, 77, a, b) && left1(77), "2DROP [%u,%u]", i, j); + CHECK(call(t_2r, 2, a, b, 0) && v4_dstack_pop(&n.ds) == b && v4_dstack_pop(&n.ds) == a && left2(a, b), + "2>R 2R@ 2R> [%u,%u]", i, j); + if (b != 0 && !(a == (v4_cell)V4_MSB && b == -1)) { + CHECK(call(w_mod, 2, a, b, 0) && left1(a % b), "MOD [%u,%u]", i, j); + CHECK(call(w_mslashmod, 3, a, a < 0 ? -1 : 0, b) && left2(a % b, a / b), "M/MOD [%u,%u]", i, j); + } + for (unsigned k = 0; k < NVEC; k++) { + v4_cell c = vec[k], r, q; + int ok; + { + v4_cell six[6]; + six[0] = a; six[1] = b; six[2] = c; six[3] = vec[(i + 5) % NVEC]; six[4] = vec[(j + 7) % NVEC]; six[5] = vec[(k + 3) % NVEC]; + CHECK(rot6_ok(six, 0, 0), "2ROT [%u,%u,%u]", i, j, k); + } + if (c == 0) continue; + if (!call(w_starslashmod, 3, a, b, c)) { CHECK(0, "*/MOD returns [%u,%u,%u]", i, j, k); continue; } + q = n.ds.t; r = n.ds.s; + ok = starslash_ref(a, b, c, r, q); + CHECK(ok != 0, "*/MOD [%u,%u,%u]", i, j, k); + if (ok == 1) { + CHECK(left2(r, q), "*/MOD leaves two cells [%u,%u,%u]", i, j, k); + CHECK(call(w_starslash, 3, a, b, c) && left1(q), "*/ [%u,%u,%u]", i, j, k); + } + } + } + /* M/MOD is SM/REM: a double that does not fit a cell */ + CHECK(call(w_mslashmod, 3, 0, 5, 10) && n.ds.s == 0 + && (v4_ucell)n.ds.t == (v4_ucell)1 << (V4_CELL_BITS - 1), "M/MOD of 5 * 2^N by 10"); + /* SM/REM: every quotient, divisor and in-range remainder sign drawn from * the edge vectors, then pseudo-random. */ for (unsigned i = 0; i < NVEC; i++) @@ -2163,6 +2376,13 @@ int main(void) dadd(ua, ub, (v4_ucell)c, c < 0 ? MAXU : 0u, &rl, &rh); CHECK(call(w_mplus, 3, vec[i], vec[j], c) && left2((v4_cell)rl, (v4_cell)rh), "M+ [%u,%u,%u]", i, j, k); + { + v4_ucell nl, nh, dl, dh; + dneg((v4_ucell)c, c < 0 ? MAXU : 0u, &nl, &nh); + dadd(ua, ub, nl, nh, &dl, &dh); + CHECK(call(w_mminus, 3, vec[i], vec[j], c) && left2((v4_cell)dl, (v4_cell)dh), + "M- [%u,%u,%u]", i, j, k); + } for (unsigned l = 0; l < NVEC; l++) { v4_ucell nl, nh; dneg((v4_ucell)vec[k], (v4_ucell)vec[l], &nl, &nh); @@ -2803,6 +3023,32 @@ int main(void) { (v4_cell)V4_MSB, 0, (v4_cell)V4_MSB, 0 }, { 1, 0, 2, 0 } }; headroom("M+", w_mplus, 3, mplus_args, 4, 2, &dh, &rh); + headroom("M-", w_mminus, 3, mplus_args, 4, 2, &dh, &rh); + CHECK(dh >= 4 && rh >= 4, "M- leaves room"); + { + static const v4_cell six[6] = { 1, 2, 3, 4, 5, 6 }; + static const v4_cell d1_args[][4] = { { 5, -1, 0, 0 }, { -1, 0, 0, 0 }, { 1, 1, 0, 0 } }; + static const v4_cell ms_args[][4] = { { 7, 3, 0, 0 }, { -7, 3, 0, 0 }, { -7, -3, 0, 0 } }; + static const v4_cell ss_args[][4] = { { 7, 3, 2, 0 }, { -7, 3, 2, 0 }, { 7, -3, -2, 0 } }; + int d, r; + headroom("M*", w_mstar, 2, ms_args, 3, 2, &dh, &rh); + CHECK(dh >= 4 && rh >= 4, "M* leaves room"); + headroom("M/MOD", w_mslashmod, 3, smrem_args, 5, 2, &dh, &rh); + headroom("MOD", w_mod, 2, slashmod_args, 4, 1, &dh, &rh); + CHECK(dh >= 3 && rh >= 2, "MOD leaves room"); + headroom("*/MOD", w_starslashmod, 3, ss_args, 3, 2, &dh, &rh); + CHECK(dh >= 3 && rh >= 2, "*/MOD leaves room"); + headroom("*/", w_starslash, 3, ss_args, 3, 1, &dh, &rh); + CHECK(dh >= 3 && rh >= 2, "*/ leaves room"); + headroom("D0<", w_d0less, 2, d1_args, 3, 1, &dh, &rh); + headroom("D2*", w_d2star, 2, d1_args, 3, 2, &dh, &rh); + headroom("D2/", w_d2slash, 2, d1_args, 3, 2, &dh, &rh); + CHECK(dh >= 5 && rh >= 6, "D2/ leaves room"); + for (d = 0; d < V4_DATA_DEPTH; d++) if (!rot6_ok(six, (unsigned)d + 1u, 0)) break; + for (r = 0; r < V4_RET_DEPTH; r++) if (!rot6_ok(six, 0, (unsigned)r + 1u)) break; + printf(" 2ROT headroom: data %d below canary, return %d below its return address\n", d, r); + CHECK(d >= 2 && r >= 1, "2ROT leaves room"); + } headroom("D-", w_dminus, 4, dsub_args, 6, 2, &dh, &rh); headroom("D0=", w_d0equal, 2, two_args, 5, 1, &dh, &rh); headroom("D=", w_dequal, 4, dsub_args, 6, 1, &dh, &rh);