test(v4.0.0): execute UM/MOD on the golden model; measure stack headroom

UM/MOD is assembled exactly as DECOMPOSITION.md section 4 gives it and
needs no change: it is exact for every uhi < ud at 32- and 64-bit cells.
It is checked against q*d + r = uhi:ulo with r < d through v4_umul, so
no second C divider has to be trusted. Coverage: all edge-vector triples
with uhi < ud plus 20000 pseudo-random cases (top-bit, small and
near-maximum divisors), optimised and under ASan+UBSan. Two hand
mutations each fail more than 15000 checks.

New headroom probe: runs a word with marked cells under the canary and
under its return address and reports how many survive, since the D-2
circular stacks overwrite silently instead of faulting. Measured:
  UM*     6 data cells under its args, 4 return entries under its return
  UM/MOD  3 data cells under its args, 3 return entries under its return

DECOMPOSITION.md: UM/MOD marked executed, with its defined range and
stack limits.

Co-Authored-By: Claude Opus 5.5 <noreply@anthropic.com>
This commit is contained in:
rajames
2026-10-02 19:48:04 -04:00
co-authored by Claude Opus 5.5
parent 9a391eb0ad
commit 41f59afeb3
2 changed files with 165 additions and 3 deletions
+6
View File
@@ -232,6 +232,12 @@ dependency order.
IF a - SWAP 1 OR SWAP THEN
NEXT
SWAP ;
\ Executed on the golden model unchanged (2026-10-02): exact, q*d + r = uhi:ulo
\ with r < d, for every uhi < ud at 32- and 64-bit cells. Outside that range
\ (uhi >= ud, including ud = 0) the result is unspecified, as in FORTH-79; it
\ always terminates after 32 steps. Stack use (D-2): at most 3 data cells may
\ lie under the three arguments and at most 3 return-stack entries under its
\ return address. For UM* the same limits are 6 and 4.
\ ---- signed division, truncating toward zero (v3 semantics) -------------
: SM/REM ( d n -- rem quot )
+159 -3
View File
@@ -8,7 +8,10 @@
*
* UM* is the full-range version that section 4 gives under D-3, and is checked
* against the reference v4_umul over every pair of the edge vectors and 20000
* pseudo-random pairs at each cell width.
* pseudo-random pairs at each cell width. UM/MOD is exactly as section 4
* gives it, 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.
*
* 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
@@ -32,7 +35,7 @@ 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_2dup, w_minus, w_uless, w_umstar, w_ummod;
#define O(name) v4_asm_op(&as, V4_OP_##name)
#define LIT(v) v4_asm_lit(&as, (v4_cell)(v))
@@ -123,6 +126,41 @@ static void build(void)
O(TWO_STAR); O(PUSH_A); CALL(w_zless); O(INV); LIT(1); O(ADD); O(ADD);
O(RPOP); O(ADD); O(SEMI);
/* : UM/MOD ( ulo uhi ud -- urem uquot ) section 4
* a!
* 31 FOR
* over 0< NEGATE push
* dup 0< push
* 2* pop pop SWAP push OR pop
* push SWAP 2* SWAP pop
* over a U< 0= OR
* IF a - SWAP 1 OR SWAP THEN
* NEXT
* SWAP ;
* NEGATE in line; IF as section 2 compiles it. */
{
v4_cell loop;
v4_asm_ref skip, done;
w_ummod = v4_asm_label(&as);
O(BANG_A); LIT(V4_CELL_BITS - 1); O(PUSH);
loop = v4_asm_label(&as);
O(OVER); CALL(w_zless); O(INV); LIT(1); O(ADD); O(PUSH);
O(DUP); CALL(w_zless); O(PUSH);
O(TWO_STAR); O(RPOP); O(RPOP); CALL(w_swap); O(PUSH); CALL(w_or); O(RPOP);
O(PUSH); CALL(w_swap); O(TWO_STAR); CALL(w_swap); O(RPOP);
O(OVER); O(PUSH_A); CALL(w_uless); CALL(w_zequal); CALL(w_or);
skip = v4_asm_branch_fwd(&as, V4_OP_IF);
O(DROP); O(PUSH_A); CALL(w_minus);
CALL(w_swap); LIT(1); CALL(w_or); CALL(w_swap);
done = v4_asm_branch_fwd(&as, V4_OP_JUMP);
v4_asm_resolve(&as, skip, v4_asm_label(&as));
O(DROP);
v4_asm_resolve(&as, done, v4_asm_label(&as));
v4_asm_branch(&as, V4_OP_NEXT, loop);
CALL(w_swap); O(SEMI);
}
CHECK(v4_asm_ok(&as), "foundation words assemble");
}
@@ -137,7 +175,7 @@ static int call(v4_cell word, unsigned argc, v4_cell a, v4_cell b, v4_cell c)
if (argc > 0) v4_dstack_push(&n.ds, a);
if (argc > 1) v4_dstack_push(&n.ds, b);
if (argc > 2) v4_dstack_push(&n.ds, c);
return v4_test_call(&n, &es, &h, word, 1000) > 0;
return v4_test_call(&n, &es, &h, word, 100000) > 0;
}
/* The results, top first, then the canary. */
@@ -174,6 +212,81 @@ static int umstar_exact(v4_ucell u1, v4_ucell u2)
return call(w_umstar, 2, (v4_cell)u1, (v4_cell)u2, 0) && left2((v4_cell)lo, (v4_cell)hi);
}
/* UM/MOD against the identity it must satisfy: q*d + r = uhi:ulo, r < d.
* Checked through v4_umul (itself tested in test_umul.c) rather than against
* a second division routine, so no C divider has to be trusted. */
static int ummod_exact(v4_ucell lo, v4_ucell hi, v4_ucell d)
{
v4_ucell r, q, plo, phi, slo;
if (!call(w_ummod, 3, (v4_cell)lo, (v4_cell)hi, (v4_cell)d)) return 0;
q = (v4_ucell)n.ds.t;
r = (v4_ucell)n.ds.s;
if (!left2((v4_cell)r, (v4_cell)q)) return 0;
v4_umul(q, d, &plo, &phi);
slo = plo + r;
phi += (slo < plo);
return r < d && slo == lo && phi == hi;
}
/* 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
* are circular (D-2), so a word that needs more depth than is free does not
* fault: it silently overwrites the oldest cells, and this is how that shows. */
#define DFILL(i) ((v4_cell)(0x5A000000 + (i)))
#define RFILL(i) ((v4_cell)(0x6B000000 + (i)))
static int fits(v4_cell word, unsigned argc, const v4_cell *arg,
unsigned nres, unsigned dfill, unsigned rfill)
{
v4_cell want[3];
unsigned i;
v4_dstack_reset(&n.ds);
v4_rstack_reset(&n.rs);
v4_exec_reset(&es);
for (i = 0; i < argc; i++) v4_dstack_push(&n.ds, arg[i]);
if (v4_test_call(&n, &es, &h, word, 100000) <= 0) return 0;
for (i = 0; i < nres; i++) want[i] = v4_dstack_pop(&n.ds);
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, DFILL(i));
v4_dstack_push(&n.ds, CANARY);
for (i = 0; i < argc; i++) v4_dstack_push(&n.ds, arg[i]);
for (i = 0; i < rfill; i++) v4_rstack_push(&n.rs, RFILL(i));
if (v4_test_call(&n, &es, &h, word, 100000) <= 0) return 0;
for (i = 0; i < nres; i++) if (v4_dstack_pop(&n.ds) != want[i]) return 0;
if (v4_dstack_pop(&n.ds) != CANARY) return 0;
for (i = dfill; i-- > 0; ) if (v4_dstack_pop(&n.ds) != DFILL(i)) return 0;
for (i = rfill; i-- > 0; ) if (v4_rstack_pop(&n.rs) != RFILL(i)) return 0;
return 1;
}
/* The most marked cells that survive on each stack, over a set of argument
* 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,
int *dh, int *rh)
{
int d, r;
unsigned k;
for (d = 0; d < V4_DATA_DEPTH; d++) {
for (k = 0; k < nargs; k++) if (!fits(word, argc, args[k], nres, (unsigned)d + 1u, 0)) break;
if (k < nargs) break;
}
for (r = 0; r < V4_RET_DEPTH; r++) {
for (k = 0; k < nargs; k++) if (!fits(word, argc, args[k], nres, 0, (unsigned)r + 1u)) break;
if (k < nargs) break;
}
*dh = d; *rh = r;
printf(" %s headroom: data %d below canary, return %d below its return address\n",
name, d, r);
}
int main(void)
{
printf("v4 foundation tests: V4_CELL_BITS=%d\n", V4_CELL_BITS);
@@ -235,6 +348,49 @@ int main(void)
CHECK(umstar_exact(MAXU, MAXU), "UM* MAX*MAX: carry out of T (D-3)");
CHECK(umstar_exact(V4_MSB - 1u, 3u), "UM* (2^(n-1)-1)*3");
/* UM/MOD over its defined range, uhi < ud. */
for (unsigned i = 0; i < NVEC; i++)
for (unsigned j = 0; j < NVEC; j++)
for (unsigned k = 0; k < NVEC; k++) {
v4_ucell lo = (v4_ucell)vec[i], hi = (v4_ucell)vec[j], d = (v4_ucell)vec[k];
if (hi < d)
CHECK(ummod_exact(lo, hi, d), "UM/MOD [%u,%u,%u]", i, j, k);
}
{
v4_ucell x = (v4_ucell)0x2545F491u;
for (unsigned i = 0; i < 20000; i++) {
v4_ucell lo, hi, d;
x ^= x << 13; x ^= x >> 7; x ^= x << 17; lo = x;
x ^= x << 13; x ^= x >> 7; x ^= x << 17; d = x;
x ^= x << 13; x ^= x >> 7; x ^= x << 17; hi = x;
switch (i & 3u) {
case 1: d |= V4_MSB; break; /* top bit of d set */
case 2: d >>= (unsigned)(x & 31u); break; /* small divisors */
case 3: d = MAXU - (d & 7u); break; /* d just under 2^n */
default: break;
}
if (d == 0) d = 1;
hi %= d; /* uhi < ud */
CHECK(ummod_exact(lo, hi, d), "UM/MOD random [%u]", i);
}
}
/* Stack headroom of the two longest definitions. */
{
static const v4_cell umstar_args[][3] = {
{ 0, 0, 0 }, { -1, -1, 0 }, { 3, -1, 0 }, { -1, 3, 0 }, { 12345, -12345, 0 }
};
static const v4_cell ummod_args[][3] = {
{ 0, 0, 1 }, { -1, -2, -1 }, { 12345, 0, 7 }, { -1, 0x7FFF, 0x8000 },
{ 0, (v4_cell)(V4_MSB - 1u), (v4_cell)V4_MSB }
};
int dh, rh;
headroom("UM*", w_umstar, 2, umstar_args, 5, 2, &dh, &rh);
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");
}
CHECK(v4_node_guards_intact(&n), "guards intact");
printf(" %d checks, %d failures\n", checks, failures);