diff --git a/docs/v4.0.0/DECOMPOSITION.md b/docs/v4.0.0/DECOMPOSITION.md index 2cfb4c70..6aaaf38a 100644 --- a/docs/v4.0.0/DECOMPOSITION.md +++ b/docs/v4.0.0/DECOMPOSITION.md @@ -256,15 +256,27 @@ dependency order. \ times as many instruction words. \ ---- signed division, truncating toward zero (v3 semantics) ------------- +\ The quotient takes the sign of d xor n, the remainder the sign of d. Sign +\ tests are native -if (as in 0<) and NEGATE is in line, so the only calls +\ are DNEGATE and UM/MOD, both call-free inside. : SM/REM ( d n -- rem quot ) - 2DUP xor push \ R: quotient sign - over push \ R: remainder sign (sign of dividend) - ABS push DABS pop UM/MOD - pop 0< IF push NEGATE pop THEN - pop 0< IF NEGATE THEN ; + over over xor push \ R: quotient sign (top bit) + over push \ R: + remainder sign (top bit of d) + -if L0 inv 1 + L0: push \ R: + |n| + -if L1 DNEGATE L1: \ |d| + pop UM/MOD \ urem uquot + pop -if L2 drop push inv 1 + pop jump L3 L2: drop L3: + pop -if L4 drop inv 1 + ; L4: drop ; +\ Executed on the golden model (2026-10-02): exact whenever the truncated +\ quotient fits a signed cell, at 32- and 64-bit cells. Stack use (D-2): up +\ to 5 data cells under the three arguments and 3 return-stack entries under +\ its return address; /MOD, one call further out, leaves 2. The first +\ version, built on ABS, DABS, 0< and NEGATE calls, overflowed the return +\ stack inside DABS -> DNEGATE -> D+ -> U> and never returned correctly for +\ a negative dividend. ``` -`2DUP`, `-`, `ABS`, and `DABS` are defined in §5; the compiler resolves forward references within the +`2DUP`, `-`, and `DNEGATE` are defined in §5; the compiler resolves forward references within the core capsule. --- @@ -341,7 +353,7 @@ Section numbers match the v3 primitive reference. | `1+` `1-` `2+` `2-` | IN | `1 +`, `-1 +`, `2 +`, `-2 +` | | `2*` | OP | `2*` | | `2/` | OP | `2/` | -| `ABS` | CAP | `dup 0< IF NEGATE THEN` | +| `ABS` | CAP | `dup 0< IF NEGATE THEN` — executed on the golden model (2026-10-02). | | `NEGATE` | CAP | §4 | | `MIN` | CAP | `2DUP > IF SWAP THEN drop` | | `MAX` | CAP | `2DUP < IF SWAP THEN drop` | @@ -367,7 +379,7 @@ Section numbers match the v3 primitive reference. | `<=` | CAP | `> 0=` | | `>=` | CAP | `< 0=` | | `U<` | CAP | §4 | -| `U>` | CAP | `SWAP U<` | +| `U>` | CAP | `SWAP U<` — executed on the golden model (2026-10-02). | | `WITHIN` | CAP | `over - push - pop U<` | | `TRUE` | IN | `-1` | | `FALSE` | IN | `0` | @@ -383,7 +395,7 @@ A double is two 32-bit cells on a mesh node. | `M*` | CAP | `2DUP xor push ABS SWAP ABS UM* pop 0< IF DNEGATE THEN` | | `M/MOD` | CAP | `SM/REM` | | `MOD` | CAP | `/MOD drop` | -| `/MOD` | CAP | `push S>D pop SM/REM` | +| `/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` | @@ -391,11 +403,11 @@ A double is two 32-bit cells on a mesh node. | Word | Fate | v4 definition | | --- | --- | --- | -| `S>D` | CAP | `dup 0<` | -| `D+` | CAP | `push SWAP push over + 2DUP U> ROT drop NEGATE pop pop + +` | -| `DNEGATE` | CAP | `inv SWAP inv SWAP 1 0 D+` | +| `S>D` | CAP | `dup 0<` — executed on the golden model (2026-10-02). | +| `D+` | CAP | `push SWAP push over + 2DUP U> ROT drop NEGATE pop pop + +` — executed on the golden model and exact (2026-10-02), but leaves its caller only **1** return-stack entry (D-2): anything that calls a word that calls `D+` overwrites a return address. Not yet revised. | +| `DNEGATE` | CAP | `inv over if L1 drop push inv 1 + pop ; L1: drop 1 + ;` — call-free: `~d + 1`, carrying into the high cell exactly when the low cell is 0. Executed on the golden model (2026-10-02). Replaces `inv SWAP inv SWAP 1 0 D+`, which left a caller no return-stack room, so `DABS` could not run at all. | | `D-` | CAP | `DNEGATE D+` | -| `DABS` | CAP | `dup 0< IF DNEGATE THEN` | +| `DABS` | CAP | `dup 0< IF DNEGATE THEN` — executed on the golden model (2026-10-02). | | `D0=` | CAP | `OR 0=` | | `D0<` | CAP | `NIP 0<` | | `D=` | CAP | `D- D0=` | diff --git a/v4/tests/test_foundation.c b/v4/tests/test_foundation.c index 55401678..cd51d14f 100644 --- a/v4/tests/test_foundation.c +++ b/v4/tests/test_foundation.c @@ -6,12 +6,15 @@ * section 5, which U< needs) and runs them on the golden model against the C * operation each one stands for. * - * UM* is the full-range version that section 4 gives under D-3, and is checked + * UM* is the full-range version that section 4 gives under D-3, checked * against the reference v4_umul over every pair of the edge vectors and 20000 - * pseudo-random pairs at each cell width. UM/MOD, the call-free version - * section 4 gives, checked against q*d + r = uhi:ulo, r < d over the edge vectors and - * 20000 pseudo-random cases with uhi < ud. Both are also probed for how much - * of the 10- and 9-deep circular stacks (D-2) they leave to their caller. + * pseudo-random pairs at each cell width. UM/MOD is section 4's call-free + * version, checked against q*d + r = uhi:ulo, r < d over the edge vectors and + * 20000 pseudo-random cases with uhi < ud. SM/REM and DNEGATE are the + * call-free versions in sections 4 and 5.7; SM/REM is checked on dividends + * built as q*n + r. /MOD, U>, ABS, S>D, D+ and DABS are as written in + * section 5 and checked against C. Every one is also probed for how much of + * the 10- and 9-deep circular stacks (D-2) it leaves to its caller. * * Every call is made with a canary under the arguments, and the canary must * still be directly under the results afterwards: a definition that leaves @@ -35,12 +38,29 @@ static v4_heat h; 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_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; #define O(name) v4_asm_op(&as, V4_OP_##name) #define LIT(v) v4_asm_lit(&as, (v4_cell)(v)) #define CALL(w) v4_asm_branch(&as, V4_OP_CALL, (w)) +/* Section 2's capsule IF ... THEN: the flag is dropped on both paths. */ +static v4_asm_ref if_(void) +{ + v4_asm_ref r = v4_asm_branch_fwd(&as, V4_OP_IF); + v4_asm_op(&as, V4_OP_DROP); + return r; +} +static void then_(v4_asm_ref r) +{ + v4_asm_ref j = v4_asm_branch_fwd(&as, V4_OP_JUMP); + v4_asm_resolve(&as, r, v4_asm_label(&as)); + v4_asm_op(&as, V4_OP_DROP); + v4_asm_resolve(&as, j, v4_asm_label(&as)); +} + static void build(void) { v4_asm_ref ref; @@ -201,6 +221,79 @@ static void build(void) v4_asm_resolve(&as, to_nosub2, l_nosub); } + /* ---- section 5 words that SM/REM and /MOD rest on, as written there. */ + + /* : U> SWAP U< ; 5.5 */ + w_ugreater = v4_asm_label(&as); + CALL(w_swap); CALL(w_uless); O(SEMI); + + /* : ABS dup 0< IF NEGATE THEN ; 5.4 */ + w_abs = v4_asm_label(&as); + O(DUP); CALL(w_zless); ref = if_(); CALL(w_negate); then_(ref); O(SEMI); + + /* : S>D dup 0< ; 5.7 */ + w_s2d = v4_asm_label(&as); + O(DUP); CALL(w_zless); O(SEMI); + + /* : D+ push SWAP push over + 2DUP U> ROT drop NEGATE pop pop + + ; 5.7 */ + w_dplus = v4_asm_label(&as); + O(PUSH); CALL(w_swap); O(PUSH); O(OVER); O(ADD); O(OVER); O(OVER); + CALL(w_ugreater); CALL(w_rot); O(DROP); CALL(w_negate); + O(RPOP); O(RPOP); O(ADD); O(ADD); O(SEMI); + + /* : DNEGATE ( d -- -d ) 5.7, call-free + * inv over if L1 drop push inv 1 + pop ; + * L1: drop 1 + ; + * -d = ~d + 1: the + 1 carries into hi exactly when lo = 0. */ + w_dnegate = v4_asm_label(&as); + O(INV); O(OVER); ref = v4_asm_branch_fwd(&as, V4_OP_IF); + O(DROP); O(PUSH); O(INV); LIT(1); O(ADD); O(RPOP); O(SEMI); + v4_asm_resolve(&as, ref, v4_asm_label(&as)); + O(DROP); LIT(1); O(ADD); O(SEMI); + + /* : DABS dup 0< IF DNEGATE THEN ; 5.7 */ + w_dabs = v4_asm_label(&as); + O(DUP); CALL(w_zless); ref = if_(); CALL(w_dnegate); then_(ref); O(SEMI); + + /* : SM/REM ( d n -- rem quot ) section 4 + * over over xor push R: quotient sign (top bit) + * over push R: + remainder sign (of d) + * -if L0 inv 1 + L0: push R: + |n| + * -if L1 DNEGATE L1: |d| + * pop UM/MOD urem uquot + * pop -if L2 drop push inv 1 + pop jump L3 L2: drop L3: + * pop -if L4 drop inv 1 + ; L4: drop ; + * Sign tests are native -if, as in 0<; NEGATE is in line. */ + { + v4_asm_ref l0, l1, l2, l3, l4; + w_smrem = v4_asm_label(&as); + O(OVER); O(OVER); O(XOR); O(PUSH); O(OVER); O(PUSH); + l0 = v4_asm_branch_fwd(&as, V4_OP_MINUS_IF); + O(INV); LIT(1); O(ADD); + v4_asm_resolve(&as, l0, v4_asm_label(&as)); + O(PUSH); + l1 = v4_asm_branch_fwd(&as, V4_OP_MINUS_IF); + CALL(w_dnegate); + v4_asm_resolve(&as, l1, v4_asm_label(&as)); + O(RPOP); CALL(w_ummod); + O(RPOP); + l2 = v4_asm_branch_fwd(&as, V4_OP_MINUS_IF); + O(DROP); O(PUSH); O(INV); LIT(1); O(ADD); O(RPOP); + l3 = v4_asm_branch_fwd(&as, V4_OP_JUMP); + v4_asm_resolve(&as, l2, v4_asm_label(&as)); + O(DROP); + v4_asm_resolve(&as, l3, v4_asm_label(&as)); + O(RPOP); + l4 = v4_asm_branch_fwd(&as, V4_OP_MINUS_IF); + O(DROP); O(INV); LIT(1); O(ADD); O(SEMI); + v4_asm_resolve(&as, l4, v4_asm_label(&as)); + O(DROP); O(SEMI); + } + + /* : /MOD push S>D pop SM/REM ; 5.6 */ + w_slashmod = v4_asm_label(&as); + O(PUSH); CALL(w_s2d); O(RPOP); CALL(w_smrem); O(SEMI); + CHECK(v4_asm_ok(&as), "foundation words assemble"); } @@ -218,6 +311,20 @@ static int call(v4_cell word, unsigned argc, v4_cell a, v4_cell b, v4_cell c) return v4_test_call(&n, &es, &h, word, 100000) > 0; } +/* The same with four arguments. */ +static int call4(v4_cell word, v4_cell a, v4_cell b, v4_cell c, v4_cell d) +{ + v4_dstack_reset(&n.ds); + v4_rstack_reset(&n.rs); + v4_exec_reset(&es); + v4_dstack_push(&n.ds, CANARY); + v4_dstack_push(&n.ds, a); + v4_dstack_push(&n.ds, b); + v4_dstack_push(&n.ds, c); + v4_dstack_push(&n.ds, d); + return v4_test_call(&n, &es, &h, word, 100000) > 0; +} + /* The results, top first, then the canary. */ static int left1(v4_cell t) { @@ -268,6 +375,38 @@ static int ummod_exact(v4_ucell lo, v4_ucell hi, v4_ucell d) return r < d && slo == lo && phi == hi; } +/* Doubles in C, as (lo, hi) with hi the high cell, for the section 5.7 and + * SM/REM checks. */ +static void dadd(v4_ucell al, v4_ucell ah, v4_ucell bl, v4_ucell bh, + v4_ucell *rl, v4_ucell *rh) +{ + *rl = al + bl; + *rh = ah + bh + (*rl < al); +} +static void dneg(v4_ucell l, v4_ucell h, v4_ucell *rl, v4_ucell *rh) +{ + dadd(~l, ~h, 1u, 0u, rl, rh); +} +/* Signed q * n as a signed double. */ +static void smul(v4_cell q, v4_cell nn, v4_ucell *rl, v4_ucell *rh) +{ + v4_ucell uq = (v4_ucell)q, un = (v4_ucell)nn; + if (q < 0) uq = 0u - uq; + if (nn < 0) un = 0u - un; + v4_umul(uq, un, rl, rh); + if ((q < 0) != (nn < 0)) dneg(*rl, *rh, rl, rh); +} + +/* SM/REM on the dividend d = q*n + r, built so that (r, q) is the + * truncating answer: |r| < |n|, and r is zero or has the sign of d. */ +static int smrem_exact(v4_cell q, v4_cell nn, v4_cell r) +{ + v4_ucell pl, ph, dl, dh; + smul(q, nn, &pl, &ph); + dadd(pl, ph, (v4_ucell)r, r < 0 ? MAXU : 0u, &dl, &dh); + return call(w_smrem, 3, (v4_cell)dl, (v4_cell)dh, nn) && left2(r, q); +} + /* 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 @@ -279,7 +418,7 @@ static int ummod_exact(v4_ucell lo, v4_ucell hi, v4_ucell d) static int fits(v4_cell word, unsigned argc, const v4_cell *arg, unsigned nres, unsigned dfill, unsigned rfill) { - v4_cell want[3]; + v4_cell want[4]; unsigned i; v4_dstack_reset(&n.ds); @@ -308,7 +447,7 @@ static int fits(v4_cell word, unsigned argc, const v4_cell *arg, * tuples chosen to take every branch. The data figure counts cells below the * canary, so the caller may hold canary + headroom cells under the arguments. */ static void headroom(const char *name, v4_cell word, unsigned argc, - const v4_cell (*args)[3], unsigned nargs, unsigned nres, + const v4_cell (*args)[4], unsigned nargs, unsigned nres, int *dh, int *rh) { int d, r; @@ -415,12 +554,76 @@ int main(void) } } + /* Section 5 words under SM/REM and /MOD, against their C meaning. */ + for (unsigned i = 0; i < NVEC; i++) { + v4_cell a = vec[i]; + v4_ucell ua = (v4_ucell)a; + CHECK(call(w_abs, 1, a, 0, 0) && left1(a < 0 ? (v4_cell)(0u - ua) : a), "ABS [%u]", i); + CHECK(call(w_s2d, 1, a, 0, 0) && left2(a, FLAG(a < 0)), "S>D [%u]", i); + for (unsigned j = 0; j < NVEC; j++) { + v4_cell b = vec[j]; + v4_ucell ub = (v4_ucell)b, rl, rh; + CHECK(call(w_ugreater, 2, a, b, 0) && left1(FLAG(ua > ub)), "U> [%u,%u]", i, j); + dneg(ua, ub, &rl, &rh); + CHECK(call(w_dnegate, 2, a, b, 0) && left2((v4_cell)rl, (v4_cell)rh), "DNEGATE [%u,%u]", i, j); + if (b >= 0) { rl = ua; rh = ub; } + CHECK(call(w_dabs, 2, a, b, 0) && left2((v4_cell)rl, (v4_cell)rh), "DABS [%u,%u]", i, j); + for (unsigned k = 0; k < NVEC; k++) + for (unsigned l = 0; l < NVEC; l++) { + v4_ucell sl, sh; + dadd(ua, ub, (v4_ucell)vec[k], (v4_ucell)vec[l], &sl, &sh); + CHECK(call4(w_dplus, a, b, vec[k], vec[l]) + && left2((v4_cell)sl, (v4_cell)sh), "D+ [%u,%u,%u,%u]", i, j, k, l); + } + if (b != 0 && !(a == (v4_cell)V4_MSB && b == -1)) + CHECK(call(w_slashmod, 2, a, b, 0) && left2(a % b, a / b), "/MOD [%u,%u]", i, j); + } + } + + /* 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++) + for (unsigned j = 0; j < NVEC; j++) { + v4_cell q = vec[i], nn = vec[j]; + v4_ucell un = nn < 0 ? 0u - (v4_ucell)nn : (v4_ucell)nn; + int neg = (q < 0) != (nn < 0); + if (nn == 0) continue; + CHECK(smrem_exact(q, nn, 0), "SM/REM r=0 [%u,%u]", i, j); + if (un > 1u) { + v4_cell r = (v4_cell)(un - 1u); + if (q == 0) { + CHECK(smrem_exact(q, nn, r), "SM/REM r>0 q=0 [%u,%u]", i, j); + CHECK(smrem_exact(q, nn, (v4_cell)(0u - (v4_ucell)r)), "SM/REM r<0 q=0 [%u,%u]", i, j); + } else { + CHECK(smrem_exact(q, nn, neg ? (v4_cell)(0u - (v4_ucell)r) : r), + "SM/REM r=max [%u,%u]", i, j); + } + } + } + { + v4_ucell x = (v4_ucell)0x6C078965u; + for (unsigned i = 0; i < 20000; i++) { + v4_cell q, nn, r; + v4_ucell un, ur; + x ^= x << 13; x ^= x >> 7; x ^= x << 17; q = (v4_cell)x; + x ^= x << 13; x ^= x >> 7; x ^= x << 17; nn = (v4_cell)x; + x ^= x << 13; x ^= x >> 7; x ^= x << 17; ur = x; + if (i & 1u) nn = (v4_cell)((v4_ucell)nn >> (x & 31u)); /* small divisors */ + if (i & 2u) q = (v4_cell)((v4_ucell)q >> (x & 31u)); /* small quotients */ + if (nn == 0) nn = 1; + un = nn < 0 ? 0u - (v4_ucell)nn : (v4_ucell)nn; + r = (v4_cell)(ur % un); + if (q == 0 ? (x & 4u) : ((q < 0) != (nn < 0))) r = (v4_cell)(0u - (v4_ucell)r); + CHECK(smrem_exact(q, nn, r), "SM/REM random [%u]", i); + } + } + /* Stack headroom of the two longest definitions. */ { - static const v4_cell umstar_args[][3] = { + static const v4_cell umstar_args[][4] = { { 0, 0, 0 }, { -1, -1, 0 }, { 3, -1, 0 }, { -1, 3, 0 }, { 12345, -12345, 0 } }; - static const v4_cell ummod_args[][3] = { + static const v4_cell ummod_args[][4] = { { 0, 0, 1 }, { -1, -2, -1 }, { 12345, 0, 7 }, { -1, 0x7FFF, 0x8000 }, { 0, (v4_cell)(V4_MSB - 1u), (v4_cell)V4_MSB } }; @@ -429,6 +632,31 @@ int main(void) CHECK(dh >= 0 && rh >= 0, "UM* runs at all"); headroom("UM/MOD", w_ummod, 3, ummod_args, 5, 2, &dh, &rh); CHECK(dh >= 0 && rh >= 0, "UM/MOD runs at all"); + + { + static const v4_cell one_args[][4] = { { 5, 0, 0 }, { -5, 0, 0 }, { 0, 0, 0 } }; + static const v4_cell two_args[][4] = { + { 5, 0, 0 }, { 0, -1, 0 }, { -5, -1, 0 }, { -1, 5, 0 }, { 0, 0, 0 } + }; + static const v4_cell smrem_args[][4] = { + { 7, 0, 2 }, { -7, -1, 2 }, { 7, 0, -2 }, { -7, -1, -2 }, { 0, 0, -3 } + }; + static const v4_cell slashmod_args[][4] = { + { 7, 2, 0 }, { -7, 2, 0 }, { 7, -2, 0 }, { -7, -2, 0 } + }; + headroom("ABS", w_abs, 1, one_args, 3, 1, &dh, &rh); + headroom("U>", w_ugreater, 2, two_args, 5, 1, &dh, &rh); + static const v4_cell dplus_args[][4] = { + { -1, 0, 1, 0 }, { 5, 7, 9, 11 }, { -1, -1, -1, -1 }, { (v4_cell)V4_MSB, 0, 1, 0 } + }; + headroom("D+", w_dplus, 4, dplus_args, 4, 2, &dh, &rh); + headroom("DNEGATE", w_dnegate, 2, two_args, 5, 2, &dh, &rh); + headroom("DABS", w_dabs, 2, two_args, 5, 2, &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); + CHECK(dh >= 0 && rh >= 0, "/MOD runs at all"); + } } CHECK(v4_node_guards_intact(&n), "guards intact");