/* test_foundation.c -- the first DECOMPOSITION.md definitions, executed. * * Section 4 says of its colon definitions that each "has been traced by hand, * but none has been executed". This file assembles the helpers, the sign and * zero tests, U< and UM* exactly as written there (plus 2DUP and - from * 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, checked * against the reference v4_umul over every pair of the edge vectors and 20000 * 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 * the right answer but an unbalanced stack is wrong. */ #include "v4/asm.h" #include "v4/testcode.h" #include "v4/umul.h" #include static int failures = 0, checks = 0; #define CHECK(c,...) do{checks++; if(!(c)){failures++; printf("FAIL %s:%d: ",__FILE__,__LINE__); printf(__VA_ARGS__); printf("\n");}}while(0) #define CANARY ((v4_cell)0x0C0FFEE5) #define MAXU ((v4_ucell)~(v4_ucell)0) #define FLAG(c) ((c) ? V4_ALL_ONES : (v4_cell)0) static v4_node n; static v4_exec_state es; 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_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; v4_node_reset(&n); v4_asm_begin(&as, &n, 16); /* : NIP push drop pop ; */ w_nip = v4_asm_label(&as); O(PUSH); O(DROP); O(RPOP); O(SEMI); /* : SWAP over push push drop pop pop ; */ w_swap = v4_asm_label(&as); O(OVER); O(PUSH); O(PUSH); O(DROP); O(RPOP); O(RPOP); O(SEMI); /* : OR over inv and xor ; */ w_or = v4_asm_label(&as); O(OVER); O(INV); O(AND); O(XOR); O(SEMI); /* : NEGATE inv 1 + ; */ w_negate = v4_asm_label(&as); O(INV); LIT(1); O(ADD); O(SEMI); /* : ROT push SWAP pop SWAP ; */ w_rot = v4_asm_label(&as); O(PUSH); CALL(w_swap); O(RPOP); CALL(w_swap); O(SEMI); /* : 0< -if L1 drop -1 ; L1: drop 0 ; */ w_zless = v4_asm_label(&as); ref = v4_asm_branch_fwd(&as, V4_OP_MINUS_IF); O(DROP); LIT(-1); O(SEMI); v4_asm_resolve(&as, ref, v4_asm_label(&as)); O(DROP); LIT(0); O(SEMI); /* : 0= if L1 drop 0 ; L1: drop -1 ; */ w_zequal = v4_asm_label(&as); ref = v4_asm_branch_fwd(&as, V4_OP_IF); O(DROP); LIT(0); O(SEMI); v4_asm_resolve(&as, ref, v4_asm_label(&as)); O(DROP); LIT(-1); O(SEMI); /* : 2DUP over over ; (section 5.1) */ w_2dup = v4_asm_label(&as); O(OVER); O(OVER); O(SEMI); /* : - NEGATE + ; (section 5.4), NEGATE in line */ w_minus = v4_asm_label(&as); O(INV); LIT(1); O(ADD); O(ADD); O(SEMI); /* : U< 2DUP xor 0< IF NIP 0< ELSE - 0< THEN ; * with section 2's IF: the flag is dropped on both arms. */ w_uless = v4_asm_label(&as); CALL(w_2dup); O(XOR); CALL(w_zless); ref = v4_asm_branch_fwd(&as, V4_OP_IF); O(DROP); CALL(w_nip); CALL(w_zless); O(SEMI); v4_asm_resolve(&as, ref, v4_asm_label(&as)); O(DROP); CALL(w_minus); CALL(w_zless); O(SEMI); /* : UM* ( u1 u2 -- ulo uhi ) section 4, D-3 * over 0< over and push R: m1 ? u2 : 0 * over over 0< and 1 and pop + push R: c_hi * over over and 1 and push R: c_hi c_lo * over 1 and NEGATE over 2/ and push R: c_hi c_lo t0 * a! 2/ pop s t0 A: u2 * 31 FOR +* UNEXT s hi A: lo * NIP a 2* pop + SWAP lo' hi * 2* a 0< NEGATE + pop + ; lo' hi' * NEGATE is placed in line. 31 is the cell width less one; the loop body * is the start of its own word so that unext restarts it. */ w_umstar = v4_asm_label(&as); O(OVER); CALL(w_zless); O(OVER); O(AND); O(PUSH); O(OVER); O(OVER); CALL(w_zless); O(AND); LIT(1); O(AND); O(RPOP); O(ADD); O(PUSH); O(OVER); O(OVER); O(AND); LIT(1); O(AND); O(PUSH); O(OVER); LIT(1); O(AND); O(INV); LIT(1); O(ADD); O(OVER); O(TWO_SLASH); O(AND); O(PUSH); O(BANG_A); O(TWO_SLASH); O(RPOP); LIT(V4_CELL_BITS - 1); O(PUSH); (void)v4_asm_label(&as); O(MUL_STEP); O(UNEXT); CALL(w_nip); O(PUSH_A); O(TWO_STAR); O(RPOP); O(ADD); CALL(w_swap); 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 * -if L0 * 2* over -if L1 drop 1 + jump L2 L1: drop L2: push 2* pop * jump SUB * L0: * 2* over -if L3 drop 1 + jump L4 L3: drop L4: push 2* pop * dup a xor -if L5 * drop -if NOSUB jump SUB * L5: drop dup inv a + inv -if L6 * drop jump NOSUB * L6: push drop pop jump SETBIT * SUB: inv a + inv * SETBIT: push 1 + pop * NOSUB: * NEXT * over push push drop pop pop ; * No calls inside the loop, and SWAP is in line. */ { v4_cell loop, l_sub, l_setbit, l_nosub; v4_asm_ref r0, r1, r2, r3, r4, r5, r6, to_sub1, to_sub2, to_nosub1, to_nosub2, to_setbit; w_ummod = v4_asm_label(&as); O(BANG_A); LIT(V4_CELL_BITS - 1); O(PUSH); loop = v4_asm_label(&as); r0 = v4_asm_branch_fwd(&as, V4_OP_MINUS_IF); /* hi's top bit was set: shift, then subtract regardless */ O(TWO_STAR); O(OVER); r1 = v4_asm_branch_fwd(&as, V4_OP_MINUS_IF); O(DROP); LIT(1); O(ADD); r2 = v4_asm_branch_fwd(&as, V4_OP_JUMP); v4_asm_resolve(&as, r1, v4_asm_label(&as)); O(DROP); v4_asm_resolve(&as, r2, v4_asm_label(&as)); O(PUSH); O(TWO_STAR); O(RPOP); to_sub1 = v4_asm_branch_fwd(&as, V4_OP_JUMP); /* L0: top bit clear: shift, then compare hi' with d */ v4_asm_resolve(&as, r0, v4_asm_label(&as)); O(TWO_STAR); O(OVER); r3 = v4_asm_branch_fwd(&as, V4_OP_MINUS_IF); O(DROP); LIT(1); O(ADD); r4 = v4_asm_branch_fwd(&as, V4_OP_JUMP); v4_asm_resolve(&as, r3, v4_asm_label(&as)); O(DROP); v4_asm_resolve(&as, r4, v4_asm_label(&as)); O(PUSH); O(TWO_STAR); O(RPOP); O(DUP); O(PUSH_A); O(XOR); r5 = v4_asm_branch_fwd(&as, V4_OP_MINUS_IF); O(DROP); to_nosub1 = v4_asm_branch_fwd(&as, V4_OP_MINUS_IF); to_sub2 = v4_asm_branch_fwd(&as, V4_OP_JUMP); v4_asm_resolve(&as, r5, v4_asm_label(&as)); /* L5 */ O(DROP); O(DUP); O(INV); O(PUSH_A); O(ADD); O(INV); r6 = v4_asm_branch_fwd(&as, V4_OP_MINUS_IF); O(DROP); to_nosub2 = v4_asm_branch_fwd(&as, V4_OP_JUMP); v4_asm_resolve(&as, r6, v4_asm_label(&as)); /* L6 */ O(PUSH); O(DROP); O(RPOP); to_setbit = v4_asm_branch_fwd(&as, V4_OP_JUMP); l_sub = v4_asm_label(&as); O(INV); O(PUSH_A); O(ADD); O(INV); l_setbit = v4_asm_label(&as); O(PUSH); LIT(1); O(ADD); O(RPOP); l_nosub = v4_asm_label(&as); v4_asm_branch(&as, V4_OP_NEXT, loop); O(OVER); O(PUSH); O(PUSH); O(DROP); O(RPOP); O(RPOP); O(SEMI); v4_asm_resolve(&as, to_sub1, l_sub); v4_asm_resolve(&as, to_sub2, l_sub); v4_asm_resolve(&as, to_setbit, l_setbit); v4_asm_resolve(&as, to_nosub1, l_nosub); 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"); } /* Call `word` with a canary and up to three arguments on fresh stacks. */ static int call(v4_cell word, unsigned argc, v4_cell a, v4_cell b, v4_cell c) { v4_dstack_reset(&n.ds); v4_rstack_reset(&n.rs); v4_exec_reset(&es); v4_heat_reset(&h); v4_dstack_push(&n.ds, CANARY); 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, 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) { return n.ds.t == t && n.ds.s == CANARY; } static int left2(v4_cell s, v4_cell t) { if (n.ds.t != t || n.ds.s != s) return 0; (void)v4_dstack_pop(&n.ds); return n.ds.s == CANARY; } static int left3(v4_cell third, v4_cell s, v4_cell t) { if (n.ds.t != t) return 0; (void)v4_dstack_pop(&n.ds); return left2(third, s); } static const v4_cell vec[] = { 0, 1, 2, 3, -1, -2, 12345, -12345, (v4_cell)(V4_MSB - 1u), (v4_cell)V4_MSB, (v4_cell)(V4_MSB + 1u), (v4_cell)(V4_MSB >> 1), (v4_cell)((V4_MSB >> 1) - 1u), (v4_cell)(MAXU / 3u), (v4_cell)(MAXU / 3u * 2u) }; #define NVEC (sizeof vec / sizeof vec[0]) /* Does UM* as written give the true product? */ static int umstar_exact(v4_ucell u1, v4_ucell u2) { v4_ucell lo, hi; v4_umul(u1, u2, &lo, &hi); 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; } /* 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 * 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[4]; 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)[4], 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); build(); for (unsigned i = 0; i < NVEC; i++) { v4_cell a = vec[i]; v4_ucell ua = (v4_ucell)a; CHECK(call(w_negate, 1, a, 0, 0) && left1((v4_cell)(0u - ua)), "NEGATE [%u]", i); CHECK(call(w_zless, 1, a, 0, 0) && left1(FLAG(ua & V4_MSB)), "0< [%u]", i); CHECK(call(w_zequal, 1, a, 0, 0) && left1(FLAG(a == 0)), "0= [%u]", i); for (unsigned j = 0; j < NVEC; j++) { v4_cell b = vec[j]; v4_ucell ub = (v4_ucell)b; CHECK(call(w_nip, 2, a, b, 0) && left1(b), "NIP [%u,%u]", i, j); CHECK(call(w_swap, 2, a, b, 0) && left2(b, a), "SWAP [%u,%u]", i, j); CHECK(call(w_or, 2, a, b, 0) && left1((v4_cell)(ua | ub)), "OR [%u,%u]", i, j); CHECK(call(w_2dup, 2, a, b, 0) && n.ds.t == b && n.ds.s == a && (v4_dstack_pop(&n.ds), v4_dstack_pop(&n.ds), left2(a, b)), "2DUP [%u,%u]", i, j); CHECK(call(w_minus, 2, a, b, 0) && left1((v4_cell)(ua - ub)), "- [%u,%u]", i, j); CHECK(call(w_uless, 2, a, b, 0) && left1(FLAG(ua < ub)), "U< [%u,%u]", i, j); for (unsigned k = 0; k < NVEC; k++) { v4_cell c = vec[k]; CHECK(call(w_rot, 3, a, b, c) && left3(b, c, a), "ROT [%u,%u,%u]", i, j, k); } CHECK(umstar_exact(ua, ub), "UM* [%u,%u]", i, j); } } /* UM* over the full range: products of pseudo-random operands, and of * operands chosen near the edges D-3 makes dangerous (top bit set, all * ones, just under a power of two). */ { v4_ucell x = (v4_ucell)0x9E3779B9u; for (unsigned i = 0; i < 20000; i++) { v4_ucell u1, u2; x ^= x << 13; x ^= x >> 7; x ^= x << 17; u1 = x; x ^= x << 13; x ^= x >> 7; x ^= x << 17; u2 = x; switch (i & 3u) { case 1: u1 |= V4_MSB; break; case 2: u1 |= V4_MSB; u2 |= V4_MSB; break; case 3: u1 = MAXU - (u1 & 7u); break; default: break; } CHECK(umstar_exact(u1, u2), "UM* random [%u]", i); } } /* The two cases that broke UM* as first written in section 4. */ 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); } } /* 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[][4] = { { 0, 0, 0 }, { -1, -1, 0 }, { 3, -1, 0 }, { -1, 3, 0 }, { 12345, -12345, 0 } }; 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 } }; 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"); { 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"); printf(" %d checks, %d failures\n", checks, failures); return failures ? 1 : 0; }