admin/LithosAnanake
1
1
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity
Files
a041b401ea34fbf528a2ce9925ccbc4f89a8dc49
LithosAnanake/v4/tests/test_cells.c
T
rajamesandClaude Opus 5.5 84c7711763 feat(v4.0.0): the small single-cell words 
NIP SWAP ROT -ROT ?DUP 2DUP, >R R@ R>, @ ! +! -! 2@ 2! CELLS,
- NEGATE 1+ 1- 2+ 2- MIN MAX, OR NOT 0= 0< 0<> 0> = <> < > <= >= U<
WITHIN TRUE FALSE in a new test, and * and / beside UM* and /MOD in
test_foundation.c.  Executed on the golden model at both cell widths
against C on every combination of the edge values and against recorded
transcripts of the v3 binary.

WITHIN is low <= n < high with signed comparisons, which is what v3
computes; the document's circular form differed for low > high.

Co-Authored-By: Claude Opus 5.5 <noreply@anthropic.com>
2026-10-03 17:49:30 -04:00

428 lines
21 KiB
C
Raw Blame History

/* test_cells.c -- the small single-cell words, executed.
*
* DECOMPOSITION.md 4 and 5.1 - 5.5: the stack, return-stack, memory,
* arithmetic and comparison words that take and leave single cells. Each is
* assembled as the document gives it, on a node of its own, and run against
* C on every combination of a set of edge values.
*
* stack NIP SWAP ROT -ROT ?DUP 2DUP
* return >R R@ R> (in line)
* memory @ ! +! -! 2@ 2! CELLS (@ ! CELLS in line)
* arithmetic - NEGATE 1+ 1- 2+ 2- MIN MAX (1+ .. 2- in line)
* logic OR NOT 0= 0< 0<> 0> = <> < > <= >= U< WITHIN TRUE FALSE
* `*` and `/` rest on UM* and SM/REM and are in test_foundation.c.
*
* v3 (v3/src/word_source/{stack,memory,arithmetic,logical}_words.c): flags
* are -1 and 0; NOT is 0=; comparisons are signed except U<; 2@ and 2! keep
* the first cell at addr and the second, which is on top of the stack, at
* the next cell; WITHIN ( n low high ) is low <= n < high, both signed.
*
* Where v4 parts from v3: CELLS is empty, because v4 addresses words (D-1);
* v3 answers 24 for 3 CELLS.
*
* The expected values marked "v3:" are transcripts of the real v3 binary,
* taken on 2026-10-03 as in test_numout.c.
*/
#include "v4/asm.h"
#include "v4/testcode.h"
#include <stdio.h>
#include <string.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_cell)-1 : (v4_cell)0)
/* The memory map is open (D-4); the test chooses the addresses. */
#define MEMV ((v4_cell)(V4_NODE_WORDS - 8u)) /* four cells for the memory words */
static v4_node n;
static v4_exec_state es;
static v4_heat h;
static v4_asm as;
enum { W_NIP, W_SWAP, W_ROT, W_NROT, W_QDUP, W_2DUP, W_RSTACK,
W_FETCH, W_STORE, W_PSTORE, W_MSTORE, W_2FETCH, W_2STORE, W_CELLS,
W_MINUS, W_NEGATE, W_1P, W_1M, W_2P, W_2M, W_MIN, W_MAX,
W_OR, W_NOT, W_ZEQ, W_ZLT, W_ZNE, W_ZGT, W_EQ, W_NE, W_LT, W_GT, W_LE, W_GE,
W_ULT, W_WITHIN, W_TRUE, W_FALSE, W_COUNT };
static v4_cell w[W_COUNT];
static const char *const wname[W_COUNT] = {
"NIP", "SWAP", "ROT", "-ROT", "?DUP", "2DUP", ">R R@ R>",
"@", "!", "+!", "-!", "2@", "2!", "CELLS",
"-", "NEGATE", "1+", "1-", "2+", "2-", "MIN", "MAX",
"OR", "NOT", "0=", "0<", "0<>", "0>", "=", "<>", "<", ">", "<=", ">=",
"U<", "WITHIN", "TRUE", "FALSE" };
#define O(name) v4_asm_op(&as, V4_OP_##name)
#define LIT(v) v4_asm_lit(&as, (v4_cell)(v))
#define CALL(x) v4_asm_branch(&as, V4_OP_CALL, (x))
#define JUMP(x) v4_asm_branch(&as, V4_OP_JUMP, (x))
#define FWD(op) v4_asm_branch_fwd(&as, V4_OP_##op)
#define HERE_(r) v4_asm_resolve(&as, (r), v4_asm_label(&as))
#define DEF(id) (w[id] = v4_asm_label(&as))
#define SWAP_INLINE() do { O(OVER); O(PUSH); O(PUSH); O(DROP); O(RPOP); O(RPOP); } while (0)
static void build(void)
{
v4_asm_ref a, b;
/* ---- stack: 4 and 5.1 ---- */
DEF(W_NIP); O(PUSH); O(DROP); O(RPOP); O(SEMI); /* : NIP push drop pop ; */
DEF(W_SWAP); SWAP_INLINE(); O(SEMI); /* : SWAP over push push drop pop pop ; */
DEF(W_ROT); O(PUSH); CALL(w[W_SWAP]); O(RPOP); CALL(w[W_SWAP]); O(SEMI); /* : ROT push SWAP pop SWAP ; */
DEF(W_NROT); SWAP_INLINE(); O(PUSH); SWAP_INLINE(); O(RPOP); O(SEMI); /* : -ROT SWAP push SWAP pop ; SWAP in line */
DEF(W_QDUP); a = FWD(IF); O(DUP); O(SEMI); HERE_(a); O(SEMI); /* : ?DUP if Z dup ; Z: ; */
DEF(W_2DUP); O(OVER); O(OVER); O(SEMI); /* : 2DUP over over ; */
/* ---- return stack, in line: 5.2. ( x -- x x ) >R R@ R> */
DEF(W_RSTACK);
O(PUSH); /* >R is push */
O(RPOP); O(DUP); O(PUSH); /* R@ is pop dup push */
O(RPOP); /* R> is pop */
O(SEMI);
/* ---- memory: 5.3 ---- */
DEF(W_FETCH); O(BANG_A); O(FETCH_A); O(SEMI); /* @ is a! @ */
DEF(W_STORE); O(BANG_A); O(STORE_A); O(SEMI); /* ! is a! ! */
DEF(W_PSTORE); O(BANG_A); O(FETCH_A); O(ADD); O(STORE_A); O(SEMI); /* : +! a! @ + ! ; */
DEF(W_MSTORE); O(BANG_A); O(INV); LIT(1); O(ADD); O(FETCH_A); O(ADD); O(STORE_A); O(SEMI);
/* : -! a! NEGATE @ + ! ; NEGATE in line */
DEF(W_2FETCH); O(BANG_A); O(FETCH_INC); O(FETCH_A); O(SEMI); /* : 2@ a! @+ @ ; */
DEF(W_2STORE); O(BANG_A); SWAP_INLINE(); O(STORE_INC); O(STORE_A); O(SEMI); /* : 2! a! SWAP !+ ! ; SWAP in line */
DEF(W_CELLS); O(SEMI); /* CELLS is empty (D-1) */
/* ---- arithmetic: 4 and 5.4 ---- */
DEF(W_NEGATE); O(INV); LIT(1); O(ADD); O(SEMI); /* : NEGATE inv 1 + ; */
DEF(W_MINUS); O(INV); LIT(1); O(ADD); O(ADD); O(SEMI); /* : - NEGATE + ; NEGATE in line */
DEF(W_1P); LIT(1); O(ADD); O(SEMI); /* 1+ is 1 + */
DEF(W_1M); LIT(-1); O(ADD); O(SEMI); /* 1- is -1 + */
DEF(W_2P); LIT(2); O(ADD); O(SEMI); /* 2+ is 2 + */
DEF(W_2M); LIT(-2); O(ADD); O(SEMI); /* 2- is -2 + */
/* ---- logic and comparison: 4 and 5.5 ---- */
DEF(W_OR); O(OVER); O(INV); O(AND); O(XOR); O(SEMI); /* : OR over inv and xor ; */
/* : 0< -if L1 drop -1 ; L1: drop 0 ; */
DEF(W_ZLT); a = FWD(MINUS_IF); O(DROP); LIT(-1); O(SEMI); HERE_(a); O(DROP); LIT(0); O(SEMI);
/* : 0= if L1 drop 0 ; L1: drop -1 ; */
DEF(W_ZEQ); a = FWD(IF); O(DROP); LIT(0); O(SEMI); HERE_(a); O(DROP); LIT(-1); O(SEMI);
/* : NOT jump 0= */
DEF(W_NOT); JUMP(w[W_ZEQ]);
/* : 0<> if Z drop -1 ; Z: ; */
DEF(W_ZNE); a = FWD(IF); O(DROP); LIT(-1); O(SEMI); HERE_(a); O(SEMI);
/* : 0> -if NN drop 0 ; NN: if Z drop -1 ; Z: ; */
DEF(W_ZGT); a = FWD(MINUS_IF); O(DROP); LIT(0); O(SEMI);
HERE_(a); b = FWD(IF); O(DROP); LIT(-1); O(SEMI); HERE_(b); O(SEMI);
/* : = xor jump 0= : <> xor jump 0<> */
DEF(W_EQ); O(XOR); JUMP(w[W_ZEQ]);
DEF(W_NE); O(XOR); JUMP(w[W_ZNE]);
/* : < 2DUP xor 0< IF drop 0< ELSE - 0< THEN ; as in test_foundation.c */
DEF(W_LT);
O(OVER); O(OVER); O(XOR); CALL(w[W_ZLT]);
a = FWD(IF);
O(DROP); O(DROP); CALL(w[W_ZLT]); O(SEMI);
HERE_(a);
O(DROP); CALL(w[W_MINUS]); CALL(w[W_ZLT]); O(SEMI);
/* : U< 2DUP xor 0< IF NIP 0< ELSE - 0< THEN ; as in test_foundation.c */
DEF(W_ULT);
CALL(w[W_2DUP]); O(XOR); CALL(w[W_ZLT]);
a = FWD(IF);
O(DROP); CALL(w[W_NIP]); CALL(w[W_ZLT]); O(SEMI);
HERE_(a);
O(DROP); CALL(w[W_MINUS]); CALL(w[W_ZLT]); O(SEMI);
/* : > SWAP jump < : <= SWAP < jump 0= : >= < jump 0=
* SWAP in line. <= is "> 0=" and >= is "< 0=". */
DEF(W_GT); SWAP_INLINE(); JUMP(w[W_LT]);
DEF(W_LE); SWAP_INLINE(); CALL(w[W_LT]); JUMP(w[W_ZEQ]);
DEF(W_GE); CALL(w[W_LT]); JUMP(w[W_ZEQ]);
/* : MIN over over < if B drop drop ; B: drop push drop pop ;
* : MAX over over < if A drop push drop pop ; A: drop drop ; */
DEF(W_MIN);
O(OVER); O(OVER); CALL(w[W_LT]); a = FWD(IF);
O(DROP); O(DROP); O(SEMI);
HERE_(a);
O(DROP); O(PUSH); O(DROP); O(RPOP); O(SEMI);
DEF(W_MAX);
O(OVER); O(OVER); CALL(w[W_LT]); a = FWD(IF);
O(DROP); O(PUSH); O(DROP); O(RPOP); O(SEMI);
HERE_(a);
O(DROP); O(DROP); O(SEMI);
/* : WITHIN ( n low high -- flag ) low <= n < high, signed, as v3
* push over pop < push n low R: n < high
* < inv pop and ; */
DEF(W_WITHIN);
O(PUSH); O(OVER); O(RPOP); CALL(w[W_LT]); O(PUSH);
CALL(w[W_LT]); O(INV); O(RPOP); O(AND); O(SEMI);
DEF(W_TRUE); LIT(-1); O(SEMI); /* TRUE is -1 */
DEF(W_FALSE); LIT(0); O(SEMI); /* FALSE is 0 */
}
/* ---- running ---------------------------------------------------------- */
static int call(int id, 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, w[id], 100000) > 0;
}
/* The stack holds exactly these under nothing but the canary; r[0] is deepest. */
static int left(unsigned nres, v4_cell r0, v4_cell r1, v4_cell r2)
{
v4_cell r[3];
unsigned i;
r[0] = r0; r[1] = r1; r[2] = r2;
for (i = nres; i-- > 0; ) if (v4_dstack_pop(&n.ds) != r[i]) return 0;
return v4_dstack_pop(&n.ds) == CANARY;
}
/* Stack headroom, as in test_foundation.c. */
static int fits(int id, unsigned argc, const v4_cell *args, unsigned nres, const v4_cell *want,
const v4_cell *mem0, const v4_cell *mem1, unsigned dfill, unsigned rfill)
{
unsigned i;
for (i = 0; i < 4; i++) n.mem[MEMV + (v4_cell)i] = mem0[i];
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, (v4_cell)(0x5A000000 + i));
v4_dstack_push(&n.ds, CANARY);
for (i = 0; i < argc; i++) v4_dstack_push(&n.ds, args[i]);
for (i = 0; i < rfill; i++) v4_rstack_push(&n.rs, (v4_cell)(0x6B000000 + i));
if (v4_test_call(&n, &es, &h, w[id], 100000) <= 0) return 0;
for (i = nres; i-- > 0; ) 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) != (v4_cell)(0x5A000000 + i)) return 0;
for (i = rfill; i-- > 0; ) if (v4_rstack_pop(&n.rs) != (v4_cell)(0x6B000000 + i)) return 0;
for (i = 0; i < 4; i++) if (n.mem[MEMV + (v4_cell)i] != mem1[i]) return 0;
return 1;
}
static void headroom(int id, unsigned argc, v4_cell a, v4_cell b, v4_cell c, unsigned nres, int min_d, int min_r)
{
v4_cell args[3], want[3], mem0[4], mem1[4];
unsigned i;
int dh, rh;
args[0] = a; args[1] = b; args[2] = c;
for (i = 0; i < 4; i++) mem0[i] = n.mem[MEMV + (v4_cell)i] = (v4_cell)(1000 + i);
CHECK(call(id, argc, a, b, c), "%s runs", wname[id]);
for (i = nres; i-- > 0; ) want[i] = v4_dstack_pop(&n.ds);
for (i = 0; i < 4; i++) mem1[i] = n.mem[MEMV + (v4_cell)i];
for (dh = 0; dh < V4_DATA_DEPTH; dh++) if (!fits(id, argc, args, nres, want, mem0, mem1, (unsigned)dh + 1u, 0)) break;
for (rh = 0; rh < V4_RET_DEPTH; rh++) if (!fits(id, argc, args, nres, want, mem0, mem1, 0, (unsigned)rh + 1u)) break;
printf(" %-8s headroom: data %d below canary, return %d below its return address\n", wname[id], dh, rh);
CHECK(dh >= min_d && rh >= min_r, "%s leaves room", wname[id]);
}
static const v4_cell vec[] = {
0, 1, 2, 3, -1, -2, 9, 10, 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])
/* One-result words: the same check with a name. */
#define ONE1(id, x, want) CHECK(call(id, 1, x, 0, 0) && left(1, want, 0, 0), "%s [%u]", wname[id], i)
#define ONE2(id, x, y, want) CHECK(call(id, 2, x, y, 0) && left(1, want, 0, 0), "%s [%u,%u]", wname[id], i, j)
#define V3(cond, what) CHECK(cond, "v3: %s", what)
int main(void)
{
unsigned i, j, k;
printf("v4 single-cell word tests: V4_CELL_BITS=%d\n", V4_CELL_BITS);
v4_node_reset(&n);
v4_asm_begin(&as, &n, 16);
build();
CHECK(v4_asm_ok(&as), "single-cell words assemble");
CHECK(v4_asm_label(&as) < MEMV, "code stays below the variables");
printf(" code: %ld of %u words\n", (long)v4_asm_label(&as) - 16, (unsigned)V4_NODE_WORDS);
/* ---- the v3 transcripts ---- */
/* 7 ?DUP . . 0 ?DUP . 1 2 3 ROT . . . 1 2 3 -ROT . . . 1 2 SWAP . .
* -> 7 7 0 1 3 2 2 1 3 1 2 */
V3(call(W_QDUP, 1, 7, 0, 0) && left(2, 7, 7, 0), "7 ?DUP");
V3(call(W_QDUP, 1, 0, 0, 0) && left(1, 0, 0, 0), "0 ?DUP");
V3(call(W_ROT, 3, 1, 2, 3) && left(3, 2, 3, 1), "1 2 3 ROT");
V3(call(W_NROT, 3, 1, 2, 3) && left(3, 3, 1, 2), "1 2 3 -ROT");
V3(call(W_SWAP, 2, 1, 2, 0) && left(2, 2, 1, 0), "1 2 SWAP");
/* VARIABLE X 10 X ! 5 X +! X @ . 3 X -! X @ . -> 15 12
* CREATE D 2 CELLS ALLOT 111 222 D 2! D @ . D 1 CELLS + @ . D 2@ . . -> 111 222 222 111 */
V3(call(W_STORE, 2, 10, MEMV, 0) && left(0, 0, 0, 0) && n.mem[MEMV] == 10, "10 X !");
V3(call(W_PSTORE, 2, 5, MEMV, 0) && left(0, 0, 0, 0) && call(W_FETCH, 1, MEMV, 0, 0) && left(1, 15, 0, 0), "5 X +! X @");
V3(call(W_MSTORE, 2, 3, MEMV, 0) && left(0, 0, 0, 0) && call(W_FETCH, 1, MEMV, 0, 0) && left(1, 12, 0, 0), "3 X -! X @");
V3(call(W_2STORE, 3, 111, 222, MEMV + 1) && left(0, 0, 0, 0)
&& n.mem[MEMV + 1] == 111 && n.mem[MEMV + 2] == 222, "111 222 D 2!");
V3(call(W_2FETCH, 1, MEMV + 1, 0, 0) && left(2, 111, 222, 0), "D 2@");
/* 7 3 - . 3 7 - . 5 1+ . 5 1- . 5 2+ . 5 2- . 5 NEGATE .
* 3 9 MIN . 3 9 MAX . -3 -9 MIN . -3 -9 MAX . -> 4 -4 6 4 7 3 -5 3 9 -9 -3
* (6 7 * . -6 7 * . 7 2 / . -7 2 / . 7 -2 / . -> 42 -42 3 -3 -3, in test_foundation.c) */
V3(call(W_MINUS, 2, 7, 3, 0) && left(1, 4, 0, 0), "7 3 -");
V3(call(W_MINUS, 2, 3, 7, 0) && left(1, -4, 0, 0), "3 7 -");
V3(call(W_1P, 1, 5, 0, 0) && left(1, 6, 0, 0), "5 1+");
V3(call(W_1M, 1, 5, 0, 0) && left(1, 4, 0, 0), "5 1-");
V3(call(W_2P, 1, 5, 0, 0) && left(1, 7, 0, 0), "5 2+");
V3(call(W_2M, 1, 5, 0, 0) && left(1, 3, 0, 0), "5 2-");
V3(call(W_NEGATE, 1, 5, 0, 0) && left(1, -5, 0, 0), "5 NEGATE");
V3(call(W_MIN, 2, 3, 9, 0) && left(1, 3, 0, 0), "3 9 MIN");
V3(call(W_MAX, 2, 3, 9, 0) && left(1, 9, 0, 0), "3 9 MAX");
V3(call(W_MIN, 2, -3, -9, 0) && left(1, -9, 0, 0), "-3 -9 MIN");
V3(call(W_MAX, 2, -3, -9, 0) && left(1, -3, 0, 0), "-3 -9 MAX");
/* 12 10 OR . 0 NOT . 5 NOT . 0 0= . 5 0= . -5 0< . 5 0< . 0 0<> . 5 0<> .
* 5 0> . 0 0> . -5 0> . 3 4 <> . 4 4 <> . -> 14 -1 0 -1 0 -1 0 0 -1 -1 0 0 -1 0 */
V3(call(W_OR, 2, 12, 10, 0) && left(1, 14, 0, 0), "12 10 OR");
V3(call(W_NOT, 1, 0, 0, 0) && left(1, -1, 0, 0), "0 NOT");
V3(call(W_NOT, 1, 5, 0, 0) && left(1, 0, 0, 0), "5 NOT");
V3(call(W_ZEQ, 1, 0, 0, 0) && left(1, -1, 0, 0), "0 0=");
V3(call(W_ZEQ, 1, 5, 0, 0) && left(1, 0, 0, 0), "5 0=");
V3(call(W_ZLT, 1, -5, 0, 0) && left(1, -1, 0, 0), "-5 0<");
V3(call(W_ZLT, 1, 5, 0, 0) && left(1, 0, 0, 0), "5 0<");
V3(call(W_ZNE, 1, 0, 0, 0) && left(1, 0, 0, 0), "0 0<>");
V3(call(W_ZNE, 1, 5, 0, 0) && left(1, -1, 0, 0), "5 0<>");
V3(call(W_ZGT, 1, 5, 0, 0) && left(1, -1, 0, 0), "5 0>");
V3(call(W_ZGT, 1, 0, 0, 0) && left(1, 0, 0, 0), "0 0>");
V3(call(W_ZGT, 1, -5, 0, 0) && left(1, 0, 0, 0), "-5 0>");
V3(call(W_NE, 2, 3, 4, 0) && left(1, -1, 0, 0), "3 4 <>");
V3(call(W_NE, 2, 4, 4, 0) && left(1, 0, 0, 0), "4 4 <>");
/* 3 4 > . 4 3 > . 4 4 > . 3 4 <= . 4 4 <= . 5 4 <= . 3 4 >= . 4 4 >= . 5 4 >= .
* 3 4 U< . -1 4 U< . 4 -1 U< . -> 0 -1 0 -1 -1 0 0 -1 -1 -1 0 -1 */
V3(call(W_GT, 2, 3, 4, 0) && left(1, 0, 0, 0), "3 4 >");
V3(call(W_GT, 2, 4, 3, 0) && left(1, -1, 0, 0), "4 3 >");
V3(call(W_GT, 2, 4, 4, 0) && left(1, 0, 0, 0), "4 4 >");
V3(call(W_LE, 2, 3, 4, 0) && left(1, -1, 0, 0), "3 4 <=");
V3(call(W_LE, 2, 4, 4, 0) && left(1, -1, 0, 0), "4 4 <=");
V3(call(W_LE, 2, 5, 4, 0) && left(1, 0, 0, 0), "5 4 <=");
V3(call(W_GE, 2, 3, 4, 0) && left(1, 0, 0, 0), "3 4 >=");
V3(call(W_GE, 2, 4, 4, 0) && left(1, -1, 0, 0), "4 4 >=");
V3(call(W_GE, 2, 5, 4, 0) && left(1, -1, 0, 0), "5 4 >=");
V3(call(W_ULT, 2, 3, 4, 0) && left(1, -1, 0, 0), "3 4 U<");
V3(call(W_ULT, 2, -1, 4, 0) && left(1, 0, 0, 0), "-1 4 U<");
V3(call(W_ULT, 2, 4, -1, 0) && left(1, -1, 0, 0), "4 -1 U<");
/* 5 0 10 WITHIN . 10 0 10 WITHIN . 0 0 10 WITHIN . -1 0 10 WITHIN . 5 10 0 WITHIN .
* TRUE . FALSE . : T 3 >R R@ . R> . ; T -> -1 0 -1 0 0 -1 0 3 3 */
V3(call(W_WITHIN, 3, 5, 0, 10) && left(1, -1, 0, 0), "5 0 10 WITHIN");
V3(call(W_WITHIN, 3, 10, 0, 10) && left(1, 0, 0, 0), "10 0 10 WITHIN");
V3(call(W_WITHIN, 3, 0, 0, 10) && left(1, -1, 0, 0), "0 0 10 WITHIN");
V3(call(W_WITHIN, 3, -1, 0, 10) && left(1, 0, 0, 0), "-1 0 10 WITHIN");
V3(call(W_WITHIN, 3, 5, 10, 0) && left(1, 0, 0, 0), "5 10 0 WITHIN");
V3(call(W_TRUE, 0, 0, 0, 0) && left(1, -1, 0, 0), "TRUE");
V3(call(W_FALSE, 0, 0, 0, 0) && left(1, 0, 0, 0), "FALSE");
V3(call(W_RSTACK, 1, 3, 0, 0) && left(2, 3, 3, 0), "3 >R R@ R>");
/* ---- against C, on every combination of the edge values ---- */
for (i = 0; i < NVEC; i++) {
v4_cell x = vec[i];
v4_ucell ux = (v4_ucell)x;
ONE1(W_NEGATE, x, (v4_cell)((v4_ucell)0 - ux));
ONE1(W_1P, x, (v4_cell)(ux + 1u));
ONE1(W_1M, x, (v4_cell)(ux - 1u));
ONE1(W_2P, x, (v4_cell)(ux + 2u));
ONE1(W_2M, x, (v4_cell)(ux - 2u));
ONE1(W_NOT, x, FLAG(x == 0));
ONE1(W_ZEQ, x, FLAG(x == 0));
ONE1(W_ZLT, x, FLAG(x < 0));
ONE1(W_ZNE, x, FLAG(x != 0));
ONE1(W_ZGT, x, FLAG(x > 0));
ONE1(W_CELLS, x, x);
CHECK(call(W_QDUP, 1, x, 0, 0) && (x ? left(2, x, x, 0) : left(1, 0, 0, 0)), "?DUP [%u]", i);
CHECK(call(W_RSTACK, 1, x, 0, 0) && left(2, x, x, 0), ">R R@ R> [%u]", i);
for (j = 0; j < NVEC; j++) {
v4_cell y = vec[j];
v4_ucell uy = (v4_ucell)y;
CHECK(call(W_NIP, 2, x, y, 0) && left(1, y, 0, 0), "NIP [%u,%u]", i, j);
CHECK(call(W_SWAP, 2, x, y, 0) && left(2, y, x, 0), "SWAP [%u,%u]", i, j);
CHECK(call(W_2DUP, 2, x, y, 0) && v4_dstack_pop(&n.ds) == y && v4_dstack_pop(&n.ds) == x
&& left(2, x, y, 0), "2DUP [%u,%u]", i, j);
ONE2(W_MINUS, x, y, (v4_cell)(ux - uy));
ONE2(W_MIN, x, y, x < y ? x : y);
ONE2(W_MAX, x, y, x > y ? x : y);
ONE2(W_OR, x, y, (v4_cell)(ux | uy));
ONE2(W_EQ, x, y, FLAG(x == y));
ONE2(W_NE, x, y, FLAG(x != y));
ONE2(W_LT, x, y, FLAG(x < y));
ONE2(W_GT, x, y, FLAG(x > y));
ONE2(W_LE, x, y, FLAG(x <= y));
ONE2(W_GE, x, y, FLAG(x >= y));
ONE2(W_ULT, x, y, FLAG(ux < uy));
/* memory: x is what is there, y what arrives */
n.mem[MEMV] = 0x1111; n.mem[MEMV + 1] = x; n.mem[MEMV + 2] = 0x2222; n.mem[MEMV + 3] = 0x3333;
CHECK(call(W_FETCH, 1, MEMV + 1, 0, 0) && left(1, x, 0, 0), "@ [%u]", i);
CHECK(call(W_PSTORE, 2, y, MEMV + 1, 0) && left(0, 0, 0, 0)
&& n.mem[MEMV + 1] == (v4_cell)(ux + uy), "+! [%u,%u]", i, j);
n.mem[MEMV + 1] = x;
CHECK(call(W_MSTORE, 2, y, MEMV + 1, 0) && left(0, 0, 0, 0)
&& n.mem[MEMV + 1] == (v4_cell)(ux - uy), "-! [%u,%u]", i, j);
CHECK(call(W_STORE, 2, y, MEMV + 1, 0) && left(0, 0, 0, 0) && n.mem[MEMV + 1] == y, "! [%u,%u]", i, j);
CHECK(n.mem[MEMV] == 0x1111 && n.mem[MEMV + 2] == 0x2222 && n.mem[MEMV + 3] == 0x3333,
"@ ! +! -! leave the neighbours [%u,%u]", i, j);
CHECK(call(W_2STORE, 3, x, y, MEMV + 1) && left(0, 0, 0, 0)
&& n.mem[MEMV + 1] == x && n.mem[MEMV + 2] == y, "2! [%u,%u]", i, j);
CHECK(call(W_2FETCH, 1, MEMV + 1, 0, 0) && left(2, x, y, 0), "2@ [%u,%u]", i, j);
CHECK(n.mem[MEMV] == 0x1111 && n.mem[MEMV + 3] == 0x3333, "2! 2@ leave the neighbours [%u,%u]", i, j);
for (k = 0; k < NVEC; k++) {
v4_cell z = vec[k];
CHECK(call(W_ROT, 3, x, y, z) && left(3, y, z, x), "ROT [%u,%u,%u]", i, j, k);
CHECK(call(W_NROT, 3, x, y, z) && left(3, z, x, y), "-ROT [%u,%u,%u]", i, j, k);
CHECK(call(W_WITHIN, 3, x, y, z) && left(1, FLAG(x >= y && x < z), 0, 0), "WITHIN [%u,%u,%u]", i, j, k);
}
}
}
CHECK(call(W_TRUE, 0, 0, 0, 0) && left(1, -1, 0, 0), "TRUE");
CHECK(call(W_FALSE, 0, 0, 0, 0) && left(1, 0, 0, 0), "FALSE");
/* What they leave their caller (D-2). */
headroom(W_NIP, 2, 1, 2, 0, 1, 7, 7);
headroom(W_SWAP, 2, 1, 2, 0, 2, 6, 6);
headroom(W_ROT, 3, 1, 2, 3, 3, 5, 4);
headroom(W_NROT, 3, 1, 2, 3, 3, 5, 5);
headroom(W_QDUP, 1, 5, 0, 0, 2, 7, 8);
headroom(W_PSTORE, 2, 5, MEMV + 1, 0, 0, 7, 8);
headroom(W_MSTORE, 2, 5, MEMV + 1, 0, 0, 7, 8);
headroom(W_2FETCH, 1, MEMV + 1, 0, 0, 2, 7, 8);
headroom(W_2STORE, 3, 5, 6, MEMV + 1, 0, 6, 6);
headroom(W_MINUS, 2, 7, 3, 0, 1, 6, 8);
headroom(W_MIN, 2, 7, 3, 0, 1, 3, 6);
headroom(W_MAX, 2, 7, 3, 0, 1, 3, 6);
headroom(W_OR, 2, 12, 10, 0, 1, 6, 8);
headroom(W_ZGT, 1, 5, 0, 0, 1, 8, 8);
headroom(W_NE, 2, 3, 4, 0, 1, 7, 8);
headroom(W_LT, 2, -3, 4, 0, 1, 5, 7);
headroom(W_GT, 2, 3, 4, 0, 1, 5, 6);
headroom(W_LE, 2, 3, 4, 0, 1, 5, 6);
headroom(W_GE, 2, 3, 4, 0, 1, 5, 6);
headroom(W_ULT, 2, 3, 4, 0, 1, 5, 7);
headroom(W_WITHIN, 3, 5, 0, 10, 1, 3, 5);
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