admin/LithosAnanake
1
1
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity
Files
092036c97a2f343dde6cd5e3c6d50fdaa6a5c0cd
LithosAnanake/v4/tests/test_foundation.c
T
rajamesandClaude Opus 5.5 092036c97a feat(v4.0.0): call-free D+ (D-2 stack headroom) 
D+ as written in 5.7 was exact but kept two cells on the return stack
while calling U> -> SWAP/U<, leaving its caller one return entry: any
word calling a word that calls D+ (M+, D-, D=, Q.+, Q.-) would have a
return address silently overwritten.

The new D+ makes no calls. Both high cells wait on the return stack; the
carry out of the low-cell add comes from sign tests -- if the low cells'
top bits differ, there is a carry exactly when the sum's top bit is
clear; if they match, exactly when both are set.

Headroom (data cells under args / return entries): 4/1 -> 6/5.
Checked against C over all 50625 edge-vector quadruples and 20000
pseudo-random pairs (weighted to top-bit cases and low sums wrapping to
0), at 32- and 64-bit cells, optimised and ASan+UBSan. Retargeting each
of the four carry branches fails more than 13000 checks.

Co-Authored-By: Claude Opus 5.5 <noreply@anthropic.com>
2026-10-02 22:46:11 -04:00

716 lines
29 KiB
C
Raw Blame History

/* 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. 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
* 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 <stdio.h>
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+ ( 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 ;
* 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);
}
}
/* 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] = {
{ 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 }, { (v4_cell)V4_MSB, 0, (v4_cell)V4_MSB, 0 },
{ 1, 0, 2, 0 }
};
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);
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;
}
Reference in New Issue View Git Blame Copy Permalink