rajamesandClaude Opus 5.5
981f4180ce
DECOMPOSITION.md 5.26 described both words in prose only. They are now
written out, call-free, on one observation: +* with S = 0 never adds, so
each step is an exact arithmetic right shift of the double T:A.
: Q.FROM-INT ( n -- q ) push 0 a! 0 pop 15 FOR +* UNEXT push drop a pop ;
T:A = n:0 is n * 2^N; N-16 shifts leave n * 2^16 (count 15 at
32-bit cells, 47 at 64).
: Q.TO-INT ( q -- n ) push a! 0 pop 15 FOR +* UNEXT drop drop a ;
16 shifts at every width; the low cell is left in A. Rounds toward
minus infinity, as v3's arithmetic shift does.
Both clobber A; added to the section 2 list.
Checked at 32- and 64-bit cells, optimised and ASan+UBSan:
- Q.FROM-INT against n * 2^16 for edge values and 20000 pseudo-random n,
and against v3's q48_from_u64 for n >= 0 (low cell at 64-bit, D-10).
- Q.TO-INT against v3's (int64_t)q >> 16 on the edge Q values and 20000
pseudo-random Q values, and against a C double shift on 20000
arbitrary doubles.
- Round trip Q.TO-INT(Q.FROM-INT(n)) = n.
Mutating either shift count or the S = 0 setup fails 40000+ checks.
Note: make sanitize prints UBSan reports but does not fail on them. One
was found here, in the test's own random shift amount (fixed); a grep of
the full sanitize output now shows no runtime errors.
Co-Authored-By: Claude Opus 5.5 <noreply@anthropic.com>
998 lines
41 KiB
C
998 lines
41 KiB
C
/* 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, DABS, M+, D-, D0= and D= are as written in section 5 and
|
|
* checked against C. Q.+, Q.-, Q.ABS and Q.NEG (section 5.26: the D+, D-,
|
|
* DABS and DNEGATE words) are checked against v3's 64-bit q48_add, q48_sub,
|
|
* q48_abs and 0 - q, with Q values two cells wide at both widths (D-10).
|
|
* Q.FROM-INT and Q.TO-INT are checked against n * 2^16 and q >> 16 in C and
|
|
* against v3's q48_from_u64 and q48_to_u64 where v4 keeps v3's meaning. Every word 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 <stdint.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, w_mplus, w_dminus, w_d0equal, w_dequal,
|
|
w_qfromint, w_qtoint;
|
|
|
|
#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);
|
|
|
|
/* : M+ S>D D+ ; 5.6 */
|
|
w_mplus = v4_asm_label(&as);
|
|
CALL(w_s2d); CALL(w_dplus); O(SEMI);
|
|
|
|
/* : D- DNEGATE D+ ; 5.7 */
|
|
w_dminus = v4_asm_label(&as);
|
|
CALL(w_dnegate); CALL(w_dplus); O(SEMI);
|
|
|
|
/* : D0= OR 0= ; 5.7 */
|
|
w_d0equal = v4_asm_label(&as);
|
|
CALL(w_or); CALL(w_zequal); O(SEMI);
|
|
|
|
/* : D= D- D0= ; 5.7 */
|
|
w_dequal = v4_asm_label(&as);
|
|
CALL(w_dminus); CALL(w_d0equal); O(SEMI);
|
|
|
|
/* +* with S = 0 never adds: each step is an exact arithmetic right shift
|
|
* of the double T:A by one bit. Both words below are built on that. */
|
|
|
|
/* : Q.FROM-INT ( n -- q ) 5.26
|
|
* push 0 a! 0 pop 15 FOR +* UNEXT push drop a pop ;
|
|
* T:A = n:0 is n * 2^N; shifted right N-16 bits it is n * 2^16. 15 is
|
|
* N-17 at 32-bit cells (47 at 64). Clobbers A. */
|
|
w_qfromint = v4_asm_label(&as);
|
|
O(PUSH); LIT(0); O(BANG_A); LIT(0); O(RPOP);
|
|
LIT(V4_CELL_BITS - 17); O(PUSH);
|
|
(void)v4_asm_label(&as);
|
|
O(MUL_STEP); O(UNEXT);
|
|
O(PUSH); O(DROP); O(PUSH_A); O(RPOP); O(SEMI);
|
|
|
|
/* : Q.TO-INT ( q -- n ) 5.26
|
|
* push a! 0 pop 15 FOR +* UNEXT drop drop a ;
|
|
* T:A = q shifted right 16 bits; the low cell is A. 15 at every cell
|
|
* width. Clobbers A. */
|
|
w_qtoint = v4_asm_label(&as);
|
|
O(PUSH); O(BANG_A); LIT(0); O(RPOP);
|
|
LIT(15); O(PUSH);
|
|
(void)v4_asm_label(&as);
|
|
O(MUL_STEP); O(UNEXT);
|
|
O(DROP); O(DROP); O(PUSH_A); 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);
|
|
}
|
|
|
|
/* Q48.16 (section 5.26). v3's Q.+ and Q.- are uint64_t a + b and a - b,
|
|
* wrapping (v3/include/q48_16.h). Here a Q value is a double: at 32-bit
|
|
* cells its two halves, at 64-bit cells the value sign-extended (D-8). */
|
|
static void qcells(uint64_t q, v4_cell *lo, v4_cell *hi)
|
|
{
|
|
#if V4_CELL_BITS == 32
|
|
*lo = (v4_cell)(v4_ucell)(q & 0xFFFFFFFFu);
|
|
*hi = (v4_cell)(v4_ucell)(q >> 32);
|
|
#else
|
|
*lo = (v4_cell)(v4_ucell)q;
|
|
*hi = (q >> 63) ? V4_ALL_ONES : 0;
|
|
#endif
|
|
}
|
|
|
|
/* Run Q.+ (the D+ word) or Q.- (the D- word) on a and b and compare with
|
|
* v3's 64-bit wrapping result. At 32-bit cells the double must equal v3's
|
|
* value bit for bit. At 64-bit cells the low cell must equal v3's value and
|
|
* the high cell must be the true sign of the unwrapped result. */
|
|
static int q_matches_v3(v4_cell word, uint64_t a, uint64_t b, uint64_t v3)
|
|
{
|
|
v4_cell al, ah, bl, bh, rl, rh;
|
|
qcells(a, &al, &ah);
|
|
qcells(b, &bl, &bh);
|
|
if (!call4(word, al, ah, bl, bh)) return 0;
|
|
#if V4_CELL_BITS == 32
|
|
qcells(v3, &rl, &rh);
|
|
return left2(rl, rh);
|
|
#else
|
|
{
|
|
v4_ucell xl, xh, nl, nh;
|
|
if (word == w_dminus) { dneg((v4_ucell)bl, (v4_ucell)bh, &nl, &nh); }
|
|
else { nl = (v4_ucell)bl; nh = (v4_ucell)bh; }
|
|
dadd((v4_ucell)al, (v4_ucell)ah, nl, nh, &xl, &xh);
|
|
rl = (v4_cell)(v4_ucell)v3;
|
|
rh = (v4_cell)xh;
|
|
return (v4_ucell)rl == xl && left2(rl, rh);
|
|
}
|
|
#endif
|
|
}
|
|
|
|
/* The same for the one-operand Q words: Q.ABS (the DABS word) and Q.NEG
|
|
* (the DNEGATE word). `wl`, `wh` is the exact double result, which at
|
|
* 64-bit cells may differ from v3 in the high cell only (D-10). */
|
|
static int q1_matches_v3(v4_cell word, uint64_t a, uint64_t v3)
|
|
{
|
|
v4_cell al, ah, rl, rh;
|
|
v4_ucell xl, xh;
|
|
qcells(a, &al, &ah);
|
|
if (!call(word, 2, al, ah, 0)) return 0;
|
|
#if V4_CELL_BITS == 32
|
|
(void)xl; (void)xh;
|
|
qcells(v3, &rl, &rh);
|
|
return left2(rl, rh);
|
|
#else
|
|
if (word == w_dnegate || ah < 0) dneg((v4_ucell)al, (v4_ucell)ah, &xl, &xh);
|
|
else { xl = (v4_ucell)al; xh = (v4_ucell)ah; }
|
|
rl = (v4_cell)(v4_ucell)v3;
|
|
rh = (v4_cell)xh;
|
|
return (v4_ucell)rl == xl && left2(rl, rh);
|
|
#endif
|
|
}
|
|
|
|
/* x shifted right `k` bits, arithmetic, without C's implementation-defined
|
|
* right shift of a negative value. */
|
|
static v4_ucell asr_u(v4_ucell x, unsigned k)
|
|
{
|
|
v4_ucell r = x >> k;
|
|
if (k && (x & V4_MSB)) r |= ~(MAXU >> k);
|
|
return r;
|
|
}
|
|
static uint64_t asr64(uint64_t x, unsigned k)
|
|
{
|
|
uint64_t r = x >> k;
|
|
if (k && (x >> 63)) r |= ~((~(uint64_t)0) >> k);
|
|
return r;
|
|
}
|
|
|
|
/* 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);
|
|
}
|
|
}
|
|
|
|
/* M+, D-, D0= and D= against C: every edge-vector combination, then
|
|
* pseudo-random doubles. */
|
|
for (unsigned i = 0; i < NVEC; i++)
|
|
for (unsigned j = 0; j < NVEC; j++) {
|
|
v4_ucell ua = (v4_ucell)vec[i], ub = (v4_ucell)vec[j], rl, rh;
|
|
CHECK(call(w_d0equal, 2, vec[i], vec[j], 0) && left1(FLAG(ua == 0 && ub == 0)),
|
|
"D0= [%u,%u]", i, j);
|
|
for (unsigned k = 0; k < NVEC; k++) {
|
|
v4_cell c = vec[k];
|
|
dadd(ua, ub, (v4_ucell)c, c < 0 ? MAXU : 0u, &rl, &rh);
|
|
CHECK(call(w_mplus, 3, vec[i], vec[j], c) && left2((v4_cell)rl, (v4_cell)rh),
|
|
"M+ [%u,%u,%u]", i, j, k);
|
|
for (unsigned l = 0; l < NVEC; l++) {
|
|
v4_ucell nl, nh;
|
|
dneg((v4_ucell)vec[k], (v4_ucell)vec[l], &nl, &nh);
|
|
dadd(ua, ub, nl, nh, &rl, &rh);
|
|
CHECK(call4(w_dminus, vec[i], vec[j], vec[k], vec[l])
|
|
&& left2((v4_cell)rl, (v4_cell)rh), "D- [%u,%u,%u,%u]", i, j, k, l);
|
|
CHECK(call4(w_dequal, vec[i], vec[j], vec[k], vec[l])
|
|
&& left1(FLAG(i == k && j == l)), "D= [%u,%u,%u,%u]", i, j, k, l);
|
|
}
|
|
}
|
|
}
|
|
{
|
|
v4_ucell x = (v4_ucell)0x5851F42Du, v[4], rl, rh, nl, nh;
|
|
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[2] = v[0]; /* equal low cells */
|
|
if (i & 2u) v[3] = v[1]; /* equal high cells */
|
|
if (i & 4u) v[2] = 0u - v[0]; /* low sum wraps */
|
|
dadd(v[0], v[1], v[2], (v4_cell)v[2] < 0 ? MAXU : 0u, &rl, &rh);
|
|
CHECK(call(w_mplus, 3, (v4_cell)v[0], (v4_cell)v[1], (v4_cell)v[2])
|
|
&& left2((v4_cell)rl, (v4_cell)rh), "M+ random [%u]", i);
|
|
dneg(v[2], v[3], &nl, &nh);
|
|
dadd(v[0], v[1], nl, nh, &rl, &rh);
|
|
CHECK(call4(w_dminus, (v4_cell)v[0], (v4_cell)v[1], (v4_cell)v[2], (v4_cell)v[3])
|
|
&& left2((v4_cell)rl, (v4_cell)rh), "D- random [%u]", i);
|
|
CHECK(call4(w_dequal, (v4_cell)v[0], (v4_cell)v[1], (v4_cell)v[2], (v4_cell)v[3])
|
|
&& left1(FLAG(v[0] == v[2] && v[1] == v[3])), "D= random [%u]", i);
|
|
CHECK(call(w_d0equal, 2, (v4_cell)(v[0] & v[2]), (v4_cell)(v[1] & v[3]), 0)
|
|
&& left1(FLAG((v[0] & v[2]) == 0 && (v[1] & v[3]) == 0)), "D0= random [%u]", i);
|
|
}
|
|
}
|
|
|
|
/* Q.+ and Q.- (section 5.26: the D+ and D- words) against v3. */
|
|
{
|
|
static const uint64_t qv[] = {
|
|
0, 1, 0x8000u, 0x10000u, 0x18000u, /* 0, ulp, 0.5, 1.0, 1.5 */
|
|
(uint64_t)0 - 0x10000u, (uint64_t)0 - 1u, /* -1.0, -ulp */
|
|
0xFFFFu, 0x10001u, 0xFFFFFFFFu, 0x100000000u, /* across the 32-bit seam */
|
|
((uint64_t)1 << 63) - 1u, (uint64_t)1 << 63, /* Q max, Q min */
|
|
(uint64_t)12345 << 16, (uint64_t)0 - ((uint64_t)12345 << 16)
|
|
};
|
|
const unsigned nq = sizeof qv / sizeof qv[0];
|
|
uint64_t x = 0x9E3779B97F4A7C15u;
|
|
unsigned over = 0;
|
|
|
|
for (unsigned i = 0; i < nq; i++)
|
|
for (unsigned j = 0; j < nq; j++) {
|
|
CHECK(q_matches_v3(w_dplus, qv[i], qv[j], qv[i] + qv[j]), "Q.+ [%u,%u]", i, j);
|
|
CHECK(q_matches_v3(w_dminus, qv[i], qv[j], qv[i] - qv[j]), "Q.- [%u,%u]", i, j);
|
|
}
|
|
for (unsigned i = 0; i < 20000; i++) {
|
|
uint64_t a, b;
|
|
x ^= x << 13; x ^= x >> 7; x ^= x << 17; a = x;
|
|
x ^= x << 13; x ^= x >> 7; x ^= x << 17; b = x;
|
|
if (i & 1u) a >>= (unsigned)(x & 63u); /* mixed magnitudes */
|
|
if (i & 2u) b = (uint64_t)0 - b;
|
|
if (((a + b) ^ a) & ((a + b) ^ b) & ((uint64_t)1 << 63)) over++;
|
|
CHECK(q_matches_v3(w_dplus, a, b, a + b), "Q.+ random [%u]", i);
|
|
CHECK(q_matches_v3(w_dminus, a, b, a - b), "Q.- random [%u]", i);
|
|
}
|
|
printf(" Q.+ random cases that overflow Q48.16: %u of 20000\n", over);
|
|
|
|
/* Q.FROM-INT: n * 2^16 as a signed double. v3 clamps n < 0 to 0
|
|
* (section 5.26 retires that) and wraps at 64 bits, so v3's value is
|
|
* checked only for n >= 0, and at 64-bit cells only in the low cell
|
|
* (D-10). */
|
|
for (unsigned i = 0; i < NVEC + 20000u; i++) {
|
|
v4_cell nn, el, eh;
|
|
if (i < NVEC) nn = vec[i];
|
|
else {
|
|
x ^= x << 13; x ^= x >> 7; x ^= x << 17;
|
|
nn = (v4_cell)(v4_ucell)x;
|
|
if (i & 1u) nn = (v4_cell)asr_u((v4_ucell)nn, (unsigned)(x >> 58) % V4_CELL_BITS);
|
|
}
|
|
el = (v4_cell)((v4_ucell)nn << 16);
|
|
eh = (v4_cell)asr_u((v4_ucell)nn, V4_CELL_BITS - 16);
|
|
CHECK(call(w_qfromint, 1, nn, 0, 0) && left2(el, eh), "Q.FROM-INT [%u]", i);
|
|
if (nn >= 0) {
|
|
uint64_t v3 = (uint64_t)(v4_ucell)nn << 16;
|
|
v4_cell vl, vh;
|
|
qcells(v3, &vl, &vh);
|
|
CHECK(call(w_qfromint, 1, nn, 0, 0) && n.ds.s == vl
|
|
&& (V4_CELL_BITS == 64 || n.ds.t == vh), "Q.FROM-INT v3 [%u]", i);
|
|
}
|
|
/* and back */
|
|
CHECK(call(w_qfromint, 1, nn, 0, 0)
|
|
&& (v4_test_call(&n, &es, &h, w_qtoint, 100000) > 0) && left1(nn),
|
|
"Q.TO-INT Q.FROM-INT [%u]", i);
|
|
}
|
|
|
|
/* Q.TO-INT: v3's (int64_t)q >> 16, arithmetic. At 32-bit cells the
|
|
* result is its low cell; at 64-bit cells it is v3's value exactly. */
|
|
for (unsigned i = 0; i < nq + 20000u; i++) {
|
|
uint64_t q;
|
|
v4_cell ql, qh;
|
|
if (i < nq) q = qv[i];
|
|
else {
|
|
x ^= x << 13; x ^= x >> 7; x ^= x << 17; q = x;
|
|
if (i & 1u) q = asr64(q, (unsigned)(x >> 58));
|
|
}
|
|
qcells(q, &ql, &qh);
|
|
CHECK(call(w_qtoint, 2, ql, qh, 0) && left1((v4_cell)(v4_ucell)asr64(q, 16)),
|
|
"Q.TO-INT v3 [%u]", i);
|
|
}
|
|
/* and on any double, not only sign-extended ones */
|
|
for (unsigned i = 0; i < 20000; i++) {
|
|
v4_ucell lo, hi;
|
|
x ^= x << 13; x ^= x >> 7; x ^= x << 17; lo = (v4_ucell)x;
|
|
x ^= x << 13; x ^= x >> 7; x ^= x << 17; hi = (v4_ucell)x;
|
|
CHECK(call(w_qtoint, 2, (v4_cell)lo, (v4_cell)hi, 0)
|
|
&& left1((v4_cell)((lo >> 16) | (hi << (V4_CELL_BITS - 16)))),
|
|
"Q.TO-INT double [%u]", i);
|
|
}
|
|
|
|
/* Q.ABS and Q.NEG against v3's q48_abs and 0 - q. */
|
|
for (unsigned i = 0; i < nq; i++) {
|
|
uint64_t q = qv[i];
|
|
CHECK(q1_matches_v3(w_dabs, q, (q < ((uint64_t)1 << 63)) ? q : (uint64_t)0 - q),
|
|
"Q.ABS [%u]", i);
|
|
CHECK(q1_matches_v3(w_dnegate, q, (uint64_t)0 - q), "Q.NEG [%u]", i);
|
|
}
|
|
for (unsigned i = 0; i < 20000; i++) {
|
|
uint64_t q;
|
|
x ^= x << 13; x ^= x >> 7; x ^= x << 17; q = x;
|
|
if (i & 1u) q >>= (unsigned)(x & 63u);
|
|
if (i & 2u) q = (uint64_t)0 - q;
|
|
CHECK(q1_matches_v3(w_dabs, q, (q < ((uint64_t)1 << 63)) ? q : (uint64_t)0 - q),
|
|
"Q.ABS random [%u]", i);
|
|
CHECK(q1_matches_v3(w_dnegate, q, (uint64_t)0 - q), "Q.NEG 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);
|
|
static const v4_cell mplus_args[][4] = {
|
|
{ -1, 0, 1, 0 }, { 5, 7, -9, 0 }, { 0, 0, -1, 0 }, { (v4_cell)V4_MSB, 0, (v4_cell)V4_MSB, 0 }
|
|
};
|
|
static const v4_cell dsub_args[][4] = {
|
|
{ 0, 0, 1, 0 }, { 5, 7, 9, 11 }, { -1, -1, -1, -1 }, { 0, 1, 0, 1 },
|
|
{ (v4_cell)V4_MSB, 0, (v4_cell)V4_MSB, 0 }, { 1, 0, 2, 0 }
|
|
};
|
|
headroom("M+", w_mplus, 3, mplus_args, 4, 2, &dh, &rh);
|
|
headroom("D-", w_dminus, 4, dsub_args, 6, 2, &dh, &rh);
|
|
headroom("D0=", w_d0equal, 2, two_args, 5, 1, &dh, &rh);
|
|
headroom("D=", w_dequal, 4, dsub_args, 6, 1, &dh, &rh);
|
|
CHECK(dh >= 0 && rh >= 0, "D= runs at all");
|
|
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;
|
|
}
|