feat(v4.0.0): the mixed and double leftovers
M- M* M/MOD MOD */ */MOD, D0< D2* D2/ 2ROT, 2DROP and 2>R 2R@ 2R>, beside UM* and SM/REM in test_foundation.c. Executed on the golden model at both cell widths against C and results recorded from the v3 binary. M- widens n before negating it, so the most negative n is right. */MOD goes through a full double product. D2/ is one +* step. M- and M/MOD take the double in the standard order ( lo hi ), as M+ does; v3 took its low cell on top. The foundation test's node is now full: 958 of the 960 words below its variables. Co-Authored-By: Claude Opus 5.5 <noreply@anthropic.com>
This commit is contained in:
rajames
co-authored by
Claude Opus 5.5
Claude Opus 5.5
parent
84c7711763
commit
481d484e93
@@ -147,7 +147,7 @@ IF body1 ELSE body2 THEN → if L1 drop body1 jump L2
|
||||
times, as on the F18. `FOR ... UNEXT` is the same but the body must fit in one instruction word.
|
||||
|
||||
**Register conventions.** `A` and `B` are caller-saved. A word that uses them says so. Words in this
|
||||
document that clobber `A`: `@ ! +! -! 2@ 2! C@ C! FILL ERASE MOVE COUNT CMOVE CMOVE> BLANK -TRAILING COMPARE SEARCH SCAN SKIP DECIMAL HEX OCTAL UM* * UM/MOD Q.FROM-INT Q.TO-INT Q.* Q./ Q.EXP Q.SQRT Q.LOG Q.SIN Q.COS HOLD SIGN # #S . .R U. U.R D. D.R ? DUMP Q.PRINT TYPE SEND RECV`. Words that clobber `B`:
|
||||
document that clobber `A`: `@ ! +! -! 2@ 2! C@ C! D2/ M* FILL ERASE MOVE COUNT CMOVE CMOVE> BLANK -TRAILING COMPARE SEARCH SCAN SKIP DECIMAL HEX OCTAL UM* * UM/MOD Q.FROM-INT Q.TO-INT Q.* Q./ Q.EXP Q.SQRT Q.LOG Q.SIN Q.COS HOLD SIGN # #S . .R U. U.R D. D.R ? DUMP Q.PRINT TYPE SEND RECV`. Words that clobber `B`:
|
||||
`COMPARE SEARCH Q./ Q.EXP Q.SQRT Q.LOG Q.SIN Q.COS <# HOLD SIGN # #S #> . .R U. U.R D. D.R ? DUMP Q.PRINT EMIT CR SPACE SPACES TYPE SEND RECV`.
|
||||
|
||||
**Return-stack words** (`>R R> R@ 2>R 2R> 2R@ I J UNLOOP` and the loop runtimes) are always IN.
|
||||
@@ -422,13 +422,13 @@ A double is two 32-bit cells on a mesh node.
|
||||
| Word | Fate | v4 definition |
|
||||
| --- | --- | --- |
|
||||
| `M+` | CAP | `S>D D+` — executed on the golden model (2026-10-02). |
|
||||
| `M-` | CAP | `NEGATE M+` |
|
||||
| `M*` | CAP | `2DUP xor push ABS SWAP ABS UM* pop 0< IF DNEGATE THEN` |
|
||||
| `M/MOD` | CAP | `SM/REM` |
|
||||
| `MOD` | CAP | `/MOD drop` |
|
||||
| `M-` | CAP | `( d n -- d )`: `S>D DNEGATE jump D+`, `S>D` by a sign test in line. `n` is widened before it is negated, so the most negative `n` is subtracted correctly; `NEGATE M+` would add it. Executed on the golden model (2026-10-03) against C and results recorded from the v3 binary (v3 took the double with its low cell on top; the standard order is kept here, as for `M+`). Leaves its caller 5 data cells and 5 return entries. |
|
||||
| `M*` | CAP | `( n1 n2 -- d )`: `over over xor push -if A inv 1 + A: push -if B inv 1 + B: pop UM* pop -if P drop jump DNEGATE P: drop ;` — the unsigned product of the magnitudes, negated when the signs differ; the sign tests are native. Executed on the golden model (2026-10-03) against C and results recorded from the v3 binary. Leaves its caller 6 data cells and 4 return entries. Clobbers `A`. |
|
||||
| `M/MOD` | CAP | `( d n -- rem quot )`: `jump SM/REM`. Truncating, the remainder with the dividend's sign, as v3. v3 took the double with its low cell on top (`dhigh dlow n`), the reverse of what its own `M*` leaves; the standard order is kept here, so `M* ... M/MOD` composes. Executed on the golden model (2026-10-03), including results recorded from the v3 binary with the double's cells exchanged. Leaves its caller 5 data cells and 3 return entries. |
|
||||
| `MOD` | CAP | `/MOD drop`, with `/MOD`'s body in line: `push S>D pop SM/REM drop`. The remainder has the dividend's sign, as v3. Executed on the golden model (2026-10-03) against C and results recorded from the v3 binary. Leaves its caller 5 data cells and 2 return entries. Division by zero is unspecified, as for `/`. |
|
||||
| `/MOD` | CAP | `push S>D pop SM/REM` — executed on the golden model (2026-10-02). |
|
||||
| `*/` | CAP | `*/MOD NIP` |
|
||||
| `*/MOD` | CAP | `push M* pop SM/REM` |
|
||||
| `*/` | CAP | `*/MOD NIP`, as `push M* pop SM/REM push drop pop`. Executed on the golden model (2026-10-03). Leaves its caller 5 data cells and 2 return entries. |
|
||||
| `*/MOD` | CAP | `( n1 n2 n3 -- rem quot )`: `push M* pop jump SM/REM` — the product is a full double, so the answer is exact whenever the quotient fits a cell. v3 multiplied in one cell at 64-bit cells and so was right only while `n1 * n2` fitted one; the two agree there. Executed on the golden model (2026-10-03) against the identity `quot * n3 + rem = n1 * n2` on every combination of the edge values, and results recorded from the v3 binary. Leaves its caller 5 data cells and 2 return entries. |
|
||||
|
||||
### 5.7 Double-cell numbers
|
||||
|
||||
@@ -440,22 +440,22 @@ A double is two 32-bit cells on a mesh node.
|
||||
| `D-` | CAP | `DNEGATE D+` — executed on the golden model (2026-10-02). |
|
||||
| `DABS` | CAP | `dup 0< IF DNEGATE THEN` — executed on the golden model (2026-10-02). |
|
||||
| `D0=` | CAP | `OR 0=` — executed on the golden model (2026-10-02). |
|
||||
| `D0<` | CAP | `NIP 0<` |
|
||||
| `D0<` | CAP | `NIP 0<`, as `push drop pop jump 0<`. Executed on the golden model (2026-10-03), including results recorded from the v3 binary. |
|
||||
| `D=` | CAP | `D- D0=` — executed on the golden model (2026-10-02). |
|
||||
| `D<` | CAP | `ROT 2DUP = IF 2DROP U< ELSE SWAP < NIP NIP THEN` — executed on the golden model (2026-10-02). |
|
||||
| `(D<)` | CAP | `( d1 d2 -- d1 d2 flag )`, call-free; internal to `DMAX` and `DMIN`. Copies of the high cells go on top; if they differ the flag comes from them, else from the low cells unsigned. The value tested always has its top bit set exactly when `d1 < d2`: `ah` (high signs differ), `ah - bh` (agree), `bl` (low top bits differ), `al - bl` (agree); `x - y` with `y` on top is `push inv pop + inv`. `dup push push over pop over over xor if TIE drop over over xor -if HS drop drop jump S1 HS: drop push inv pop + inv S1: -if N1 drop -1 jump D1 N1: drop 0 D1: pop SWAP ; TIE: drop drop drop dup push push over pop over over xor -if LS drop NIP jump S2 LS: drop push inv pop + inv S2: -if N2 drop -1 jump D2 N2: drop 0 D2: pop pop ROT ;` with `SWAP`, `NIP` and `ROT` in line. Executed on the golden model (2026-10-02). |
|
||||
| `DMAX` | CAP | `(D<) if L drop push push drop drop pop pop ; L: drop drop drop ;` Executed on the golden model (2026-10-02). Replaces `2OVER 2OVER D< IF 2SWAP THEN 2DROP`, which needs 8 data cells plus `D<`'s 2: the whole 10-deep data stack, so it failed whenever the caller held anything at all (D-2). |
|
||||
| `DMIN` | CAP | `(D<) if L drop drop drop ; L: drop push push drop drop pop pop ;` Executed on the golden model (2026-10-02); replaces `2OVER 2OVER D< 0= IF 2SWAP THEN 2DROP` for the same reason as `DMAX`. |
|
||||
| `D2*` | CAP | `2* over 0< NEGATE OR SWAP 2* SWAP` |
|
||||
| `D2/` | CAP | `dup 1 and push 2/ SWAP 1 RSHIFT pop IF MSB OR THEN SWAP` |
|
||||
| `2DROP` | IN | `drop drop` |
|
||||
| `2DUP` | IN | `over over` |
|
||||
| `D2*` | CAP | `2* over -if P drop 1 + jump J P: drop J: push 2* pop` — the low cell's top bit enters the high cell; a native sign test in place of `over 0< NEGATE OR`. Executed on the golden model (2026-10-03), including results recorded from the v3 binary. |
|
||||
| `D2/` | CAP | `push a! 0 pop +* push drop a pop` — one `+*` with `S = 0` is an exact arithmetic right shift of `T:A`, as in `Q.FROM-INT`. It replaces `dup 1 and push 2/ SWAP 1 RSHIFT pop IF MSB OR THEN SWAP`. Executed on the golden model (2026-10-03), including results recorded from the v3 binary. Clobbers `A`. |
|
||||
| `2DROP` | IN | `drop drop` — executed on the golden model (2026-10-03). |
|
||||
| `2DUP` | IN | `over over` — executed on the golden model (2026-10-03). |
|
||||
| `2SWAP` | CAP | `ROT push ROT pop`, with `ROT` and `SWAP` in line so it makes no calls. Executed on the golden model (2026-10-02). Called, `ROT` and `SWAP` left its caller 2 return entries; in line, 4. |
|
||||
| `2OVER` | CAP | `push push 2DUP pop pop 2SWAP` — executed on the golden model (2026-10-02). |
|
||||
| `2ROT` | CAP | `2>R 2SWAP 2R> 2SWAP` |
|
||||
| `2>R` | IN | `SWAP push push` |
|
||||
| `2R>` | IN | `pop pop SWAP` |
|
||||
| `2R@` | IN | `pop pop 2DUP push push SWAP` |
|
||||
| `2ROT` | CAP | `push push 2SWAP pop pop jump 2SWAP`. Executed on the golden model (2026-10-03), including a result recorded from the v3 binary. With six cells of its own it leaves its caller 3 data cells and 1 return entry. |
|
||||
| `2>R` | IN | `SWAP push push` — executed on the golden model (2026-10-03) with `2R@` and `2R>`; the high cell is on top of the return stack, as in v3. |
|
||||
| `2R>` | IN | `pop pop SWAP` — see `2>R`. |
|
||||
| `2R@` | IN | `pop pop 2DUP push push SWAP` — see `2>R`. |
|
||||
|
||||
### 5.8 Number formatting and output
|
||||
|
||||
|
||||
+247
-1
@@ -79,7 +79,8 @@ 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_star, w_slash, w_mplus, w_dminus, w_d0equal, w_dequal,
|
||||
w_slashmod, w_star, w_slash, w_mminus, w_mstar, w_mslashmod, w_mod, w_starslashmod,
|
||||
w_starslash, w_d0less, w_d2star, w_d2slash, w_2rot, w_2drop, t_2r, t_2rorder, 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,
|
||||
@@ -1434,7 +1435,101 @@ static void build(void)
|
||||
O(DROP); O(FETCH_A); LIT(-256); O(AND); O(ADD); O(STORE_A); O(SEMI);
|
||||
}
|
||||
|
||||
/* ---- the rest of 5.6 and 5.7 ---- */
|
||||
#define FWD(op) v4_asm_branch_fwd(&as, V4_OP_##op)
|
||||
#define HERE_(r) v4_asm_resolve(&as, (r), v4_asm_label(&as))
|
||||
#define SWAP_INLINE() do { O(OVER); O(PUSH); O(PUSH); O(DROP); O(RPOP); O(RPOP); } while (0)
|
||||
{
|
||||
v4_asm_ref a, b;
|
||||
|
||||
/* : M- ( d n -- d ) S>D DNEGATE jump D+
|
||||
* S>D in line: dup -if P drop -1 jump J P: drop 0 J:
|
||||
* d - n as d + (-n) with n widened first, so the most negative n is
|
||||
* subtracted correctly (NEGATE M+ would add it). */
|
||||
w_mminus = v4_asm_label(&as);
|
||||
O(DUP); a = FWD(MINUS_IF); O(DROP); LIT(-1); b = FWD(JUMP);
|
||||
HERE_(a); O(DROP); LIT(0);
|
||||
HERE_(b);
|
||||
CALL(w_dnegate); v4_asm_branch(&as, V4_OP_JUMP, w_dplus);
|
||||
|
||||
/* : M* ( n1 n2 -- d )
|
||||
* over over xor push R: sign of the product
|
||||
* -if A inv 1 + A: push -if B inv 1 + B: pop |n1| |n2|
|
||||
* UM* pop -if P drop jump DNEGATE P: drop ; */
|
||||
w_mstar = v4_asm_label(&as);
|
||||
O(OVER); O(OVER); O(XOR); O(PUSH);
|
||||
a = FWD(MINUS_IF); O(INV); LIT(1); O(ADD); HERE_(a);
|
||||
O(PUSH);
|
||||
a = FWD(MINUS_IF); O(INV); LIT(1); O(ADD); HERE_(a);
|
||||
O(RPOP);
|
||||
CALL(w_umstar); O(RPOP); a = FWD(MINUS_IF);
|
||||
O(DROP); v4_asm_branch(&as, V4_OP_JUMP, w_dnegate);
|
||||
HERE_(a); O(DROP); O(SEMI);
|
||||
|
||||
/* : M/MOD ( d n -- rem quot ) jump SM/REM */
|
||||
w_mslashmod = v4_asm_label(&as);
|
||||
v4_asm_branch(&as, V4_OP_JUMP, w_smrem);
|
||||
|
||||
/* : MOD ( n1 n2 -- rem ) /MOD drop, /MOD's body in line */
|
||||
w_mod = v4_asm_label(&as);
|
||||
O(PUSH); CALL(w_s2d); O(RPOP); CALL(w_smrem); O(DROP); O(SEMI);
|
||||
|
||||
// : */MOD ( n1 n2 n3 -- rem quot ) push M* pop jump SM/REM
|
||||
w_starslashmod = v4_asm_label(&as);
|
||||
O(PUSH); CALL(w_mstar); O(RPOP); v4_asm_branch(&as, V4_OP_JUMP, w_smrem);
|
||||
|
||||
// : */ ( n1 n2 n3 -- quot ) push M* pop SM/REM push drop pop ; that is, */MOD NIP
|
||||
w_starslash = v4_asm_label(&as);
|
||||
O(PUSH); CALL(w_mstar); O(RPOP); CALL(w_smrem); O(PUSH); O(DROP); O(RPOP); O(SEMI);
|
||||
|
||||
/* : D0< ( d -- flag ) push drop pop jump 0< NIP 0< */
|
||||
w_d0less = v4_asm_label(&as);
|
||||
O(PUSH); O(DROP); O(RPOP); v4_asm_branch(&as, V4_OP_JUMP, w_zless);
|
||||
|
||||
/* : D2* ( d -- 2d )
|
||||
* 2* over -if P drop 1 + jump J P: drop J: push 2* pop ;
|
||||
* the low cell's top bit enters the high cell. */
|
||||
w_d2star = v4_asm_label(&as);
|
||||
O(TWO_STAR); O(OVER); a = FWD(MINUS_IF); O(DROP); LIT(1); O(ADD); b = FWD(JUMP);
|
||||
HERE_(a); O(DROP);
|
||||
HERE_(b);
|
||||
O(PUSH); O(TWO_STAR); O(RPOP); O(SEMI);
|
||||
|
||||
/* : D2/ ( d -- d/2 ) push a! 0 pop +* push drop a pop ;
|
||||
* one +* with S = 0 is an exact arithmetic right shift of T:A (as in
|
||||
* Q.FROM-INT). Clobbers A. */
|
||||
w_d2slash = v4_asm_label(&as);
|
||||
O(PUSH); O(BANG_A); LIT(0); O(RPOP); O(MUL_STEP); O(PUSH); O(DROP); O(PUSH_A); O(RPOP); O(SEMI);
|
||||
|
||||
/* : 2ROT ( d1 d2 d3 -- d2 d3 d1 ) push push 2SWAP pop pop jump 2SWAP */
|
||||
w_2rot = v4_asm_label(&as);
|
||||
O(PUSH); O(PUSH); CALL(w_2swap); O(RPOP); O(RPOP); v4_asm_branch(&as, V4_OP_JUMP, w_2swap);
|
||||
|
||||
/* 2DROP is drop drop */
|
||||
w_2drop = v4_asm_label(&as);
|
||||
O(DROP); O(DROP); O(SEMI);
|
||||
|
||||
/* ( d -- d d ) 2>R 2R@ 2R> in line:
|
||||
* 2>R is SWAP push push
|
||||
* 2R@ is pop pop 2DUP push push SWAP
|
||||
* 2R> is pop pop SWAP */
|
||||
t_2r = v4_asm_label(&as);
|
||||
SWAP_INLINE(); O(PUSH); O(PUSH);
|
||||
O(RPOP); O(RPOP); O(OVER); O(OVER); O(PUSH); O(PUSH); SWAP_INLINE();
|
||||
O(RPOP); O(RPOP); SWAP_INLINE();
|
||||
O(SEMI);
|
||||
|
||||
/* ( lo hi -- hi lo ) 2>R R> R> the high cell is on top of R, as in v3 */
|
||||
t_2rorder = v4_asm_label(&as);
|
||||
SWAP_INLINE(); O(PUSH); O(PUSH); O(RPOP); O(RPOP); O(SEMI);
|
||||
}
|
||||
#undef SWAP_INLINE
|
||||
#undef HERE_
|
||||
#undef FWD
|
||||
|
||||
CHECK(v4_asm_ok(&as), "foundation words assemble");
|
||||
CHECK(v4_asm_label(&as) <= BYTES, "code stays below the variables");
|
||||
printf(" code: %ld of %u words\n", (long)v4_asm_label(&as) - 16, (unsigned)V4_NODE_WORDS);
|
||||
}
|
||||
|
||||
/* Call `word` with a canary and up to three arguments on fresh stacks. */
|
||||
@@ -1547,6 +1642,51 @@ static int smrem_exact(v4_cell q, v4_cell nn, v4_cell r)
|
||||
return call(w_smrem, 3, (v4_cell)dl, (v4_cell)dh, nn) && left2(r, q);
|
||||
}
|
||||
|
||||
/* Six arguments, for 2ROT. */
|
||||
static int call6(v4_cell word, const v4_cell *a, unsigned dfill, unsigned rfill)
|
||||
{
|
||||
unsigned 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 < 6; i++) v4_dstack_push(&n.ds, a[i]);
|
||||
for (i = 0; i < rfill; i++) v4_rstack_push(&n.rs, (v4_cell)(0x6B000000 + i));
|
||||
return v4_test_call(&n, &es, &h, word, 4000000) > 0;
|
||||
}
|
||||
static int rot6_ok(const v4_cell *a, unsigned dfill, unsigned rfill)
|
||||
{
|
||||
static const unsigned from[6] = { 2, 3, 4, 5, 0, 1 }; /* d2 d3 d1 */
|
||||
unsigned i;
|
||||
if (!call6(w_2rot, a, dfill, rfill)) return 0;
|
||||
for (i = 6; i-- > 0; ) if (v4_dstack_pop(&n.ds) != a[from[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;
|
||||
return 1;
|
||||
}
|
||||
|
||||
/* n1 * n2 / n3 through a double product. Returns 1 when the truncated
|
||||
* quotient fits a cell and (r, q) is it: q*n3 + r = n1*n2, |r| < |n3|, r zero
|
||||
* or of the product's sign; 0 when it fits and (r, q) is wrong; -1 when it
|
||||
* does not fit (unspecified, as for SM/REM). */
|
||||
static int starslash_ref(v4_cell n1, v4_cell n2, v4_cell n3, v4_cell r, v4_cell q)
|
||||
{
|
||||
v4_ucell pl, ph, al, ah, ql, qh, sl, sh, un3 = n3 < 0 ? 0u - (v4_ucell)n3 : (v4_ucell)n3, ur;
|
||||
int pneg;
|
||||
smul(n1, n2, &pl, &ph);
|
||||
pneg = (ph & V4_MSB) != 0;
|
||||
al = pl; ah = ph;
|
||||
if (pneg) dneg(pl, ph, &al, &ah);
|
||||
if (ah >= (V4_MSB >> 1)) return -1;
|
||||
if (((ah << 1) | (al >> (V4_CELL_BITS - 1))) >= un3) return -1; /* |p| >= |n3| * 2^(N-1) */
|
||||
smul(q, n3, &ql, &qh);
|
||||
dadd(ql, qh, (v4_ucell)r, r < 0 ? MAXU : 0u, &sl, &sh);
|
||||
ur = r < 0 ? 0u - (v4_ucell)r : (v4_ucell)r;
|
||||
return sl == pl && sh == ph && ur < un3 && (r == 0 || (r < 0) == pneg);
|
||||
}
|
||||
|
||||
/* 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). */
|
||||
@@ -2098,6 +2238,79 @@ int main(void)
|
||||
}
|
||||
}
|
||||
|
||||
/* The rest of 5.6 and 5.7. "v3:" marks results recorded from the v3
|
||||
* binary on 2026-10-03; v3's M- and M/MOD took the double with its low
|
||||
* cell on top, so their arguments are in v4's order here. */
|
||||
CHECK(call(w_mstar, 2, 6, 7, 0) && left2(42, 0), "v3: 6 7 M*");
|
||||
CHECK(call(w_mstar, 2, -6, 7, 0) && left2(-42, -1), "v3: -6 7 M*");
|
||||
CHECK(call(w_mod, 2, 17, 5, 0) && left1(2), "v3: 17 5 MOD");
|
||||
CHECK(call(w_mod, 2, -17, 5, 0) && left1(-2), "v3: -17 5 MOD");
|
||||
CHECK(call(w_mod, 2, 17, -5, 0) && left1(2), "v3: 17 -5 MOD");
|
||||
CHECK(call(w_starslash, 3, 7, 3, 2) && left1(10), "v3: 7 3 2 */");
|
||||
CHECK(call(w_starslash, 3, -7, 3, 2) && left1(-10), "v3: -7 3 2 */");
|
||||
CHECK(call(w_starslashmod, 3, 7, 3, 2) && left2(1, 10), "v3: 7 3 2 */MOD");
|
||||
CHECK(call(w_starslashmod, 3, -7, 3, 2) && left2(-1, -10), "v3: -7 3 2 */MOD");
|
||||
CHECK(call(w_d0less, 2, 5, 0, 0) && left1(0), "v3: 5 0 D0<");
|
||||
CHECK(call(w_d0less, 2, 5, -1, 0) && left1(-1), "v3: 5 -1 D0<");
|
||||
CHECK(call(w_d2star, 2, 3, 0, 0) && left2(6, 0), "v3: 3 0 D2*");
|
||||
CHECK(call(w_d2star, 2, -1, 0, 0) && left2(-2, 1), "v3: -1 0 D2*");
|
||||
CHECK(call(w_d2slash, 2, 6, 0, 0) && left2(3, 0), "v3: 6 0 D2/");
|
||||
CHECK(call(w_d2slash, 2, 1, 1, 0) && left2((v4_cell)V4_MSB, 0), "v3: 1 1 D2/");
|
||||
CHECK(call(w_d2slash, 2, -4, -1, 0) && left2(-2, -1), "v3: -4 -1 D2/");
|
||||
CHECK(call(w_mslashmod, 3, 100, 0, 7) && left2(2, 14), "v3: 100 7 M/MOD");
|
||||
CHECK(call(w_mslashmod, 3, -100, -1, 7) && left2(-2, -14), "v3: -100 7 M/MOD");
|
||||
CHECK(call(w_mminus, 3, 100, 0, 7) && left2(93, 0), "v3: 100 7 M-");
|
||||
CHECK(call(w_mminus, 3, 100, 0, -7) && left2(107, 0), "v3: 100 -7 M-");
|
||||
CHECK(call(w_2drop, 3, 1, 2, 3) && left1(1), "v3: 1 2 3 2DROP");
|
||||
CHECK(call(t_2r, 2, 1, 2, 0) && v4_dstack_pop(&n.ds) == 2 && v4_dstack_pop(&n.ds) == 1 && left2(1, 2),
|
||||
"v3: 1 2 2>R 2R@ 2R>");
|
||||
CHECK(call(t_2rorder, 2, 1, 2, 0) && left2(2, 1), "2>R leaves the high cell on top of R");
|
||||
{
|
||||
static const v4_cell six[6] = { 1, 2, 3, 4, 5, 6 };
|
||||
CHECK(rot6_ok(six, 0, 0), "v3: 1 2 3 4 5 6 2ROT");
|
||||
}
|
||||
for (unsigned i = 0; i < NVEC; i++)
|
||||
for (unsigned j = 0; j < NVEC; j++) {
|
||||
v4_cell a = vec[i], b = vec[j];
|
||||
v4_ucell ua = (v4_ucell)a, ub = (v4_ucell)b, pl, ph;
|
||||
smul(a, b, &pl, &ph);
|
||||
CHECK(call(w_mstar, 2, a, b, 0) && left2((v4_cell)pl, (v4_cell)ph), "M* [%u,%u]", i, j);
|
||||
CHECK(call(w_d0less, 2, a, b, 0) && left1(FLAG(b < 0)), "D0< [%u,%u]", i, j);
|
||||
CHECK(call(w_d2star, 2, a, b, 0)
|
||||
&& left2((v4_cell)(ua << 1), (v4_cell)((ub << 1) | (ua >> (V4_CELL_BITS - 1)))), "D2* [%u,%u]", i, j);
|
||||
CHECK(call(w_d2slash, 2, a, b, 0)
|
||||
&& left2((v4_cell)((ua >> 1) | (ub << (V4_CELL_BITS - 1))), (v4_cell)((ub >> 1) | (ub & V4_MSB))),
|
||||
"D2/ [%u,%u]", i, j);
|
||||
CHECK(call(w_2drop, 3, 77, a, b) && left1(77), "2DROP [%u,%u]", i, j);
|
||||
CHECK(call(t_2r, 2, a, b, 0) && v4_dstack_pop(&n.ds) == b && v4_dstack_pop(&n.ds) == a && left2(a, b),
|
||||
"2>R 2R@ 2R> [%u,%u]", i, j);
|
||||
if (b != 0 && !(a == (v4_cell)V4_MSB && b == -1)) {
|
||||
CHECK(call(w_mod, 2, a, b, 0) && left1(a % b), "MOD [%u,%u]", i, j);
|
||||
CHECK(call(w_mslashmod, 3, a, a < 0 ? -1 : 0, b) && left2(a % b, a / b), "M/MOD [%u,%u]", i, j);
|
||||
}
|
||||
for (unsigned k = 0; k < NVEC; k++) {
|
||||
v4_cell c = vec[k], r, q;
|
||||
int ok;
|
||||
{
|
||||
v4_cell six[6];
|
||||
six[0] = a; six[1] = b; six[2] = c; six[3] = vec[(i + 5) % NVEC]; six[4] = vec[(j + 7) % NVEC]; six[5] = vec[(k + 3) % NVEC];
|
||||
CHECK(rot6_ok(six, 0, 0), "2ROT [%u,%u,%u]", i, j, k);
|
||||
}
|
||||
if (c == 0) continue;
|
||||
if (!call(w_starslashmod, 3, a, b, c)) { CHECK(0, "*/MOD returns [%u,%u,%u]", i, j, k); continue; }
|
||||
q = n.ds.t; r = n.ds.s;
|
||||
ok = starslash_ref(a, b, c, r, q);
|
||||
CHECK(ok != 0, "*/MOD [%u,%u,%u]", i, j, k);
|
||||
if (ok == 1) {
|
||||
CHECK(left2(r, q), "*/MOD leaves two cells [%u,%u,%u]", i, j, k);
|
||||
CHECK(call(w_starslash, 3, a, b, c) && left1(q), "*/ [%u,%u,%u]", i, j, k);
|
||||
}
|
||||
}
|
||||
}
|
||||
/* M/MOD is SM/REM: a double that does not fit a cell */
|
||||
CHECK(call(w_mslashmod, 3, 0, 5, 10) && n.ds.s == 0
|
||||
&& (v4_ucell)n.ds.t == (v4_ucell)1 << (V4_CELL_BITS - 1), "M/MOD of 5 * 2^N by 10");
|
||||
|
||||
/* 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++)
|
||||
@@ -2163,6 +2376,13 @@ int main(void)
|
||||
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);
|
||||
{
|
||||
v4_ucell nl, nh, dl, dh;
|
||||
dneg((v4_ucell)c, c < 0 ? MAXU : 0u, &nl, &nh);
|
||||
dadd(ua, ub, nl, nh, &dl, &dh);
|
||||
CHECK(call(w_mminus, 3, vec[i], vec[j], c) && left2((v4_cell)dl, (v4_cell)dh),
|
||||
"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);
|
||||
@@ -2803,6 +3023,32 @@ int main(void)
|
||||
{ (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("M-", w_mminus, 3, mplus_args, 4, 2, &dh, &rh);
|
||||
CHECK(dh >= 4 && rh >= 4, "M- leaves room");
|
||||
{
|
||||
static const v4_cell six[6] = { 1, 2, 3, 4, 5, 6 };
|
||||
static const v4_cell d1_args[][4] = { { 5, -1, 0, 0 }, { -1, 0, 0, 0 }, { 1, 1, 0, 0 } };
|
||||
static const v4_cell ms_args[][4] = { { 7, 3, 0, 0 }, { -7, 3, 0, 0 }, { -7, -3, 0, 0 } };
|
||||
static const v4_cell ss_args[][4] = { { 7, 3, 2, 0 }, { -7, 3, 2, 0 }, { 7, -3, -2, 0 } };
|
||||
int d, r;
|
||||
headroom("M*", w_mstar, 2, ms_args, 3, 2, &dh, &rh);
|
||||
CHECK(dh >= 4 && rh >= 4, "M* leaves room");
|
||||
headroom("M/MOD", w_mslashmod, 3, smrem_args, 5, 2, &dh, &rh);
|
||||
headroom("MOD", w_mod, 2, slashmod_args, 4, 1, &dh, &rh);
|
||||
CHECK(dh >= 3 && rh >= 2, "MOD leaves room");
|
||||
headroom("*/MOD", w_starslashmod, 3, ss_args, 3, 2, &dh, &rh);
|
||||
CHECK(dh >= 3 && rh >= 2, "*/MOD leaves room");
|
||||
headroom("*/", w_starslash, 3, ss_args, 3, 1, &dh, &rh);
|
||||
CHECK(dh >= 3 && rh >= 2, "*/ leaves room");
|
||||
headroom("D0<", w_d0less, 2, d1_args, 3, 1, &dh, &rh);
|
||||
headroom("D2*", w_d2star, 2, d1_args, 3, 2, &dh, &rh);
|
||||
headroom("D2/", w_d2slash, 2, d1_args, 3, 2, &dh, &rh);
|
||||
CHECK(dh >= 5 && rh >= 6, "D2/ leaves room");
|
||||
for (d = 0; d < V4_DATA_DEPTH; d++) if (!rot6_ok(six, (unsigned)d + 1u, 0)) break;
|
||||
for (r = 0; r < V4_RET_DEPTH; r++) if (!rot6_ok(six, 0, (unsigned)r + 1u)) break;
|
||||
printf(" 2ROT headroom: data %d below canary, return %d below its return address\n", d, r);
|
||||
CHECK(d >= 2 && r >= 1, "2ROT leaves room");
|
||||
}
|
||||
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);
|
||||
|
||||
Reference in New Issue
Block a user