From 84c771176396a0cbbdae7a2b84125c266416bc73 Mon Sep 17 00:00:00 2001 From: rajames Date: Sat, 3 Oct 2026 17:49:30 -0400 Subject: [PATCH] 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 --- docs/v4.0.0/DECOMPOSITION.md | 68 +++--- v4/tests/test_cells.c | 427 +++++++++++++++++++++++++++++++++++ v4/tests/test_foundation.c | 19 +- 3 files changed, 479 insertions(+), 35 deletions(-) create mode 100644 v4/tests/test_cells.c diff --git a/docs/v4.0.0/DECOMPOSITION.md b/docs/v4.0.0/DECOMPOSITION.md index a9063159..47a3aafb 100644 --- a/docs/v4.0.0/DECOMPOSITION.md +++ b/docs/v4.0.0/DECOMPOSITION.md @@ -305,10 +305,10 @@ Section numbers match the v3 primitive reference. | `DROP` | OP | `drop` | | `DUP` | OP | `dup` | | `OVER` | OP | `over` | -| `SWAP` | CAP | §4 | -| `?DUP` | CAP | `dup IF dup THEN` | -| `ROT` | CAP | §4 | -| `-ROT` | CAP | `ROT ROT` | +| `SWAP` | CAP | §4. Executed on the golden model (2026-10-03), including a transcript of the v3 binary. Leaves its caller 7 data cells and 6 return entries. | +| `?DUP` | CAP | `if Z dup ; Z: ;` (`dup IF dup THEN` without the extra copy). Executed on the golden model (2026-10-03), including a transcript of the v3 binary. | +| `ROT` | CAP | §4. Executed on the golden model (2026-10-03), including a transcript of the v3 binary. Leaves its caller 6 data cells and 4 return entries; in line, with `SWAP` in line, it calls nothing. | +| `-ROT` | CAP | `SWAP push SWAP pop`, `SWAP` in line (`ROT ROT` in one pass). Executed on the golden model (2026-10-03), including a transcript of the v3 binary. Leaves its caller 6 data cells and 5 return entries. | | `DEPTH` | RET | No visible stack pointer (D-2). | | `PICK` | RET | No visible stack pointer (D-2). | | `ROLL` | RET | No visible stack pointer (D-2); D-7 is moot. | @@ -317,26 +317,26 @@ Section numbers match the v3 primitive reference. | Word | Fate | v4 definition | | --- | --- | --- | -| `>R` | IN | `push` | -| `R>` | IN | `pop` | -| `R@` | IN | `pop dup push` | +| `>R` | IN | `push` — executed on the golden model (2026-10-03) with `R@` and `R>`, including a transcript of the v3 binary. | +| `R>` | IN | `pop` — executed on the golden model (2026-10-03), see `>R`. | +| `R@` | IN | `pop dup push` — executed on the golden model (2026-10-03), see `>R`. | ### 5.3 Memory | Word | Fate | v4 definition / notes | | --- | --- | --- | -| `@` | IN | `a! @` | -| `!` | IN | `a! !` | -| `+!` | CAP | `a! @ + !` | -| `-!` | CAP | `a! NEGATE @ + !` | -| `2@` | CAP | `a! @+ @` (low cell at `addr`, high at `addr+1`, as in v3) | -| `2!` | CAP | `a! SWAP !+ !` | +| `@` | IN | `a! @` — executed on the golden model (2026-10-03), including a transcript of the v3 binary. | +| `!` | IN | `a! !` — executed on the golden model (2026-10-03), including a transcript of the v3 binary. | +| `+!` | CAP | `a! @ + !` — executed on the golden model (2026-10-03), including a transcript of the v3 binary. | +| `-!` | CAP | `a! NEGATE @ + !`, `NEGATE` in line — executed on the golden model (2026-10-03), including a transcript of the v3 binary. | +| `2@` | CAP | `a! @+ @` (low cell at `addr`, high at `addr+1`, as in v3) — executed on the golden model (2026-10-03), including a transcript of the v3 binary. | +| `2!` | CAP | `a! SWAP !+ !`, `SWAP` in line — executed on the golden model (2026-10-03), including a transcript of the v3 binary. Leaves its caller 7 data cells and 6 return entries. | | `C@` | CAP | See below (D-1). Call-free. Executed on the golden model (2026-10-03). Leaves its caller 8 data cells and 7 return entries. | | `C!` | CAP | See below (D-1). Call-free. Executed on the golden model (2026-10-03). | | `FILL` | CAP | `( baddr u c -- )`: the low byte of `c`. See below. Nothing for `u = 0`; for `u < 0` nothing is written and `NODE-ERROR` is set (v3 read a negative count as a huge unsigned one). Executed on the golden model (2026-10-03), including a transcript of the v3 binary. Leaves its caller 5 data cells and 5 return entries. Clobbers `A` and, on error, `B`. | | `MOVE` | CAP | `( src dst u -- )`, bytes: `push over over - -if UP drop pop jump CMOVE> UP: drop pop jump CMOVE` — `CMOVE>` when `src < dst`, else `CMOVE`, so overlapping bytes are read before they are overwritten, as v3's `memmove`. The test is the sign of `src - dst`, in line. Executed on the golden model (2026-10-03), including a transcript of the v3 binary. Leaves its caller 4 data cells and 5 return entries. | | `ERASE` | CAP | `0 FILL`, as `0 jump FILL`. Executed on the golden model (2026-10-03), including a transcript of the v3 binary. | -| `CELLS` | IN | Empty (word-addressed). Becomes `2* 2*` if D-1 chooses bytes. | +| `CELLS` | IN | Empty (word-addressed, D-1); v3 answers 24 for `3 CELLS`. Executed on the golden model (2026-10-03). | ```forth \ byte access on a word-addressed node, little-endian: four bytes to a cell at @@ -377,17 +377,17 @@ Section numbers match the v3 primitive reference. | Word | Fate | v4 definition / notes | | --- | --- | --- | | `+` | OP | `+` | -| `-` | CAP | `NEGATE +` | -| `*` | CAP | `UM* drop` | -| `/` | CAP | `/MOD NIP` | +| `-` | CAP | `NEGATE +`, `NEGATE` in line — executed on the golden model (2026-10-03), including a transcript of the v3 binary. | +| `*` | CAP | `UM* drop` — executed on the golden model (2026-10-03) against C's wrapping product. Leaves its caller 6 data cells and 5 return entries. | +| `/` | CAP | `/MOD NIP`, as `push S>D pop SM/REM push drop pop` (`/MOD`'s body and `NIP` in line, so it runs no deeper than `/MOD`). Truncates toward zero, as v3. Executed on the golden model (2026-10-03) against C wherever the quotient fits a cell. Leaves its caller 5 data cells and 2 return entries. Division by zero is unspecified, as for `UM/MOD` (§4); v3 reported an error and stopped the line. | | `MOD` `/MOD` `*/` `*/MOD` (§4 versions) | RET | Shadowed duplicates. Only the §6 versions survive. | -| `1+` `1-` `2+` `2-` | IN | `1 +`, `-1 +`, `2 +`, `-2 +` | +| `1+` `1-` `2+` `2-` | IN | `1 +`, `-1 +`, `2 +`, `-2 +` — executed on the golden model (2026-10-03), including a transcript of the v3 binary. | | `2*` | OP | `2*` | | `2/` | OP | `2/` | | `ABS` | CAP | `dup 0< IF NEGATE THEN` — executed on the golden model (2026-10-02). | -| `NEGATE` | CAP | §4 | -| `MIN` | CAP | `2DUP > IF SWAP THEN drop` | -| `MAX` | CAP | `2DUP < IF SWAP THEN drop` | +| `NEGATE` | CAP | §4. Executed on the golden model (2026-10-03), including a transcript of the v3 binary. | +| `MIN` | CAP | `over over < if B drop drop ; B: drop push drop pop ;` — the smaller, signed. Executed on the golden model (2026-10-03), including a transcript of the v3 binary. Leaves its caller 4 data cells and 6 return entries. | +| `MAX` | CAP | `over over < if A drop push drop pop ; A: drop drop ;` — the larger, signed. Executed on the golden model (2026-10-03), including a transcript of the v3 binary. Leaves its caller 4 data cells and 6 return entries. | ### 5.5 Logic and comparison @@ -395,25 +395,25 @@ Section numbers match the v3 primitive reference. | --- | --- | --- | | `AND` | OP | `and` | | `XOR` | OP | `xor` | -| `OR` | CAP | §4 | +| `OR` | CAP | §4. Executed on the golden model (2026-10-03), including a transcript of the v3 binary. | | `INVERT` | OP | `inv` | -| `NOT` | CAP | `0=` (FORTH-79 logical not, as in v3) | +| `NOT` | CAP | `0=` (FORTH-79 logical not, as in v3), as `jump 0=`. Executed on the golden model (2026-10-03), including a transcript of the v3 binary. | | `LSHIFT` | CAP | `BEGIN dup WHILE 1- SWAP 2* SWAP REPEAT drop` — executed on the golden model (2026-10-03). | | `RSHIFT` | CAP | `BEGIN dup WHILE 1- SWAP 2/ MSB inv and SWAP REPEAT drop` (clears the sign bit each step; `MSB` is the cell-width top-bit constant) — executed on the golden model (2026-10-03). | -| `0=` `0<` | CAP | §4 | -| `0<>` | CAP | `0= 0=` | -| `0>` | CAP | `dup 0< SWAP 0= OR 0=` (correct for the most negative number) | +| `0=` `0<` | CAP | §4. Executed on the golden model (2026-10-03), including a transcript of the v3 binary. | +| `0<>` | CAP | `if Z drop -1 ; Z: ;` (`0= 0=` without calls). Executed on the golden model (2026-10-03), including a transcript of the v3 binary. | +| `0>` | CAP | `-if NN drop 0 ; NN: if Z drop -1 ; Z: ;` — two native sign tests in place of `dup 0< SWAP 0= OR 0=`; correct for the most negative number. Executed on the golden model (2026-10-03), including a transcript of the v3 binary. | | `=` | CAP | `xor 0=` — executed on the golden model (2026-10-02). | -| `<>` | CAP | `xor 0<>` | +| `<>` | CAP | `xor 0<>`, as `xor jump 0<>`. Executed on the golden model (2026-10-03), including a transcript of the v3 binary. | | `<` | CAP | `2DUP xor 0< IF drop 0< ELSE - 0< THEN` (overflow-safe) — executed on the golden model (2026-10-02). | -| `>` | CAP | `SWAP <` | -| `<=` | CAP | `> 0=` | -| `>=` | CAP | `< 0=` | -| `U<` | CAP | §4 | +| `>` | CAP | `SWAP <`, as `SWAP jump <` with `SWAP` in line. Executed on the golden model (2026-10-03), including a transcript of the v3 binary. Leaves its caller 6 data cells and 6 return entries. | +| `<=` | CAP | `> 0=`, as `SWAP < jump 0=`. Executed on the golden model (2026-10-03), including a transcript of the v3 binary. Leaves its caller 6 data cells and 6 return entries. | +| `>=` | CAP | `< 0=`, as `< jump 0=`. Executed on the golden model (2026-10-03), including a transcript of the v3 binary. Leaves its caller 6 data cells and 6 return entries. | +| `U<` | CAP | §4. Executed on the golden model (2026-10-03), including a transcript of the v3 binary. Leaves its caller 6 data cells and 7 return entries. | | `U>` | CAP | `SWAP U<` — executed on the golden model (2026-10-02). | -| `WITHIN` | CAP | `over - push - pop U<` | -| `TRUE` | IN | `-1` | -| `FALSE` | IN | `0` | +| `WITHIN` | CAP | `( n low high -- flag )`: `push over pop < push < inv pop and` — `low <= n < high`, both comparisons signed, which is what v3 computes. It replaces `over - push - pop U<`, the circular form, which answers differently when `low > high` (`5 10 0 WITHIN` is false in v3 and here, true in that form). Executed on the golden model (2026-10-03), including a transcript of the v3 binary. Leaves its caller 4 data cells and 5 return entries. | +| `TRUE` | IN | `-1` — executed on the golden model (2026-10-03), including a transcript of the v3 binary. | +| `FALSE` | IN | `0` — executed on the golden model (2026-10-03), including a transcript of the v3 binary. | ### 5.6 Mixed-precision arithmetic diff --git a/v4/tests/test_cells.c b/v4/tests/test_cells.c new file mode 100644 index 00000000..f052fcab --- /dev/null +++ b/v4/tests/test_cells.c @@ -0,0 +1,427 @@ +/* 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 +#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_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; +} diff --git a/v4/tests/test_foundation.c b/v4/tests/test_foundation.c index 40431c28..82373090 100644 --- a/v4/tests/test_foundation.c +++ b/v4/tests/test_foundation.c @@ -79,7 +79,7 @@ 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_slashmod, w_star, w_slash, w_mplus, w_dminus, w_d0equal, w_dequal, w_qfromint, w_qtoint, w_less, w_equal, w_dless, w_2swap, w_2over, w_dmax, w_dmin, w_qgt_doc, w_qgt, w_dltkeep, w_qstar, w_d2starc, w_uqdiv, w_qslash, w_qexp, w_qsqrt, w_qlog, w_qreduce, w_qsin, l_trig, w_qcos, @@ -394,6 +394,16 @@ static void build(void) w_slashmod = v4_asm_label(&as); O(PUSH); CALL(w_s2d); O(RPOP); CALL(w_smrem); O(SEMI); + /* : * UM* drop ; 5.4 */ + w_star = v4_asm_label(&as); + CALL(w_umstar); O(DROP); O(SEMI); + + /* : / /MOD NIP ; 5.4 + * with /MOD's body and NIP in line (push S>D pop SM/REM push drop pop), + * so it runs no deeper than /MOD. */ + w_slash = v4_asm_label(&as); + O(PUSH); CALL(w_s2d); O(RPOP); CALL(w_smrem); O(PUSH); O(DROP); O(RPOP); O(SEMI); + /* : M+ S>D D+ ; 5.6 */ w_mplus = v4_asm_label(&as); CALL(w_s2d); CALL(w_dplus); O(SEMI); @@ -2082,6 +2092,9 @@ int main(void) } 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); + if (b != 0 && !(a == (v4_cell)V4_MSB && b == -1)) + CHECK(call(w_slash, 2, a, b, 0) && left1(a / b), "/ [%u,%u]", i, j); + CHECK(call(w_star, 2, a, b, 0) && left1((v4_cell)(ua * ub)), "* [%u,%u]", i, j); } } @@ -2860,6 +2873,10 @@ int main(void) 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); + headroom("/", w_slash, 2, slashmod_args, 4, 1, &dh, &rh); + CHECK(dh >= 3 && rh >= 2, "/ runs no deeper than /MOD"); + headroom("*", w_star, 2, slashmod_args, 4, 1, &dh, &rh); + CHECK(dh >= 4 && rh >= 5, "* leaves room"); CHECK(dh >= 0 && rh >= 0, "/MOD runs at all"); } }