diff --git a/docs/v4.0.0/DECOMPOSITION.md b/docs/v4.0.0/DECOMPOSITION.md index 6aaaf38a..bf5985b5 100644 --- a/docs/v4.0.0/DECOMPOSITION.md +++ b/docs/v4.0.0/DECOMPOSITION.md @@ -404,7 +404,7 @@ A double is two 32-bit cells on a mesh node. | Word | Fate | v4 definition | | --- | --- | --- | | `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. | +| `D+` | CAP | `push over push push drop pop over over xor -if L1 drop + -if C1 jump C0 L1: drop over -if L2 drop + jump C1 L2: drop + C0: pop pop + ; C1: pop pop + 1 + ;` — call-free. The carry out of the low cells is found by sign tests: if their top bits differ, there is a carry exactly when the sum's top bit is clear; if they match, exactly when both are set. Executed on the golden model (2026-10-02); leaves its caller 6 data cells under its arguments and 5 return entries. Replaces `push SWAP push over + 2DUP U> ROT drop NEGATE pop pop + +`, which was exact but left 1 return entry. | | `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` — executed on the golden model (2026-10-02). | diff --git a/v4/tests/test_foundation.c b/v4/tests/test_foundation.c index cd51d14f..ecea80b0 100644 --- a/v4/tests/test_foundation.c +++ b/v4/tests/test_foundation.c @@ -12,8 +12,9 @@ * 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 + * built as q*n + r. D+ is the call-free version in 5.7, checked against C + * over every quadruple of the edge vectors and pseudo-random pairs. /MOD, + * U>, ABS, S>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 @@ -235,11 +236,41 @@ static void build(void) 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); + /* : D+ ( d1 d2 -- d3 ) 5.7, call-free + * push over push push drop pop al bl R: bh ah + * over over xor -if L1 top bits of al, bl differ: + * drop + -if C1 jump C0 carry iff sum's top bit clear + * L1: drop over -if L2 same: carry iff both set + * drop + jump C1 + * L2: drop + + * C0: pop pop + ; + * C1: pop pop + 1 + ; */ + { + v4_asm_ref l1, l2, c1a, c1b, c0a; + v4_cell c0, c1; + + w_dplus = v4_asm_label(&as); + O(PUSH); O(OVER); O(PUSH); O(PUSH); O(DROP); O(RPOP); + O(OVER); O(OVER); O(XOR); + l1 = v4_asm_branch_fwd(&as, V4_OP_MINUS_IF); + O(DROP); O(ADD); + c1a = v4_asm_branch_fwd(&as, V4_OP_MINUS_IF); + c0a = v4_asm_branch_fwd(&as, V4_OP_JUMP); + v4_asm_resolve(&as, l1, v4_asm_label(&as)); + O(DROP); O(OVER); + l2 = v4_asm_branch_fwd(&as, V4_OP_MINUS_IF); + O(DROP); O(ADD); + c1b = v4_asm_branch_fwd(&as, V4_OP_JUMP); + v4_asm_resolve(&as, l2, v4_asm_label(&as)); + O(DROP); O(ADD); + c0 = v4_asm_label(&as); + O(RPOP); O(RPOP); O(ADD); O(SEMI); + c1 = v4_asm_label(&as); + O(RPOP); O(RPOP); O(ADD); LIT(1); O(ADD); O(SEMI); + v4_asm_resolve(&as, c0a, c0); + v4_asm_resolve(&as, c1a, c1); + v4_asm_resolve(&as, c1b, c1); + } /* : DNEGATE ( d -- -d ) 5.7, call-free * inv over if L1 drop push inv 1 + pop ; @@ -618,6 +649,21 @@ int main(void) } } + /* D+ on pseudo-random doubles, weighted toward low cells whose top bits + * decide the carry. */ + { + v4_ucell x = (v4_ucell)0x41C64E6Du, v[4], sl, sh; + for (unsigned i = 0; i < 20000; i++) { + for (unsigned k = 0; k < 4; k++) { x ^= x << 13; x ^= x >> 7; x ^= x << 17; v[k] = x; } + if (i & 1u) v[0] |= V4_MSB; + if (i & 2u) v[2] |= V4_MSB; + if (i & 4u) v[2] = 0u - v[0]; /* low sum wraps to 0 */ + dadd(v[0], v[1], v[2], v[3], &sl, &sh); + CHECK(call4(w_dplus, (v4_cell)v[0], (v4_cell)v[1], (v4_cell)v[2], (v4_cell)v[3]) + && left2((v4_cell)sl, (v4_cell)sh), "D+ random [%u]", i); + } + } + /* Stack headroom of the two longest definitions. */ { static const v4_cell umstar_args[][4] = { @@ -647,9 +693,12 @@ int main(void) 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 } + { -1, 0, 1, 0 }, { 5, 7, 9, 11 }, { -1, -1, -1, -1 }, + { (v4_cell)V4_MSB, 0, 1, 0 }, { (v4_cell)V4_MSB, 0, (v4_cell)V4_MSB, 0 }, + { 1, 0, 2, 0 } }; - headroom("D+", w_dplus, 4, dplus_args, 4, 2, &dh, &rh); + headroom("D+", w_dplus, 4, dplus_args, 6, 2, &dh, &rh); + CHECK(rh >= 5, "D+ leaves 5 return entries"); 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);