diff --git a/docs/v4.0.0/DECOMPOSITION.md b/docs/v4.0.0/DECOMPOSITION.md index d331182f..fd893f59 100644 --- a/docs/v4.0.0/DECOMPOSITION.md +++ b/docs/v4.0.0/DECOMPOSITION.md @@ -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 ) diff --git a/v4/tests/test_foundation.c b/v4/tests/test_foundation.c index a72654f9..b94fff3f 100644 --- a/v4/tests/test_foundation.c +++ b/v4/tests/test_foundation.c @@ -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);