feat(v4.0.0): SM/REM and DNEGATE call-free; execute /MOD and its section 5 words

SM/REM as written in section 4 never returned correctly for a negative
dividend. It holds three entries on the return stack and then calls
DABS -> DNEGATE -> D+ -> U> -> SWAP/U<, which overflows the 9-deep
circular return stack (D-2). DABS itself could not run: DNEGATE as
written (inv SWAP inv SWAP 1 0 D+) left its caller no return entries.

- DNEGATE: inv over if L1 drop push inv 1 + pop ; L1: drop 1 + ;
  i.e. ~d + 1, carrying into the high cell exactly when lo = 0.
- SM/REM: sign tests are native -if (as in 0<) and NEGATE is in line;
  the only calls are DNEGATE and UM/MOD, both call-free inside.

Executed on the golden model at 32- and 64-bit cells, optimised and
under ASan+UBSan:
- SM/REM on dividends built as q*n + r with |r| < |n| and r signed as
  d: every edge-vector q, n with r = 0 and r = +-(|n|-1), plus 20000
  pseudo-random cases.
- /MOD, U>, ABS, S>D, D+ and DABS as written in section 5, against C
  (D+ over all 50625 edge-vector quadruples).
Mutations of DNEGATE's carry and of each SM/REM sign branch are caught.

Headroom (data cells under args / return entries under return address):
  SM/REM 5/3, /MOD 5/2, DNEGATE 7/7, DABS 7/6, ABS 8/7, U> 6/5.
D+ as written is exact but leaves only 1 return entry; recorded in
DECOMPOSITION.md 5.7 as not yet revised.

Co-Authored-By: Claude Opus 5.5 <noreply@anthropic.com>
This commit is contained in:
rajames
2026-10-02 22:44:04 -04:00
co-authored by Claude Opus 5.5
parent 3b9d1e4337
commit 93d09840da
2 changed files with 263 additions and 23 deletions
+25 -13
View File
@@ -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=` |
+238 -10
View File
@@ -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");