admin/LithosAnanake
1
1
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

feat(v4.0.0): C@ is call-free

Browse Source 
One case per byte position, like C!: the cell is shifted down with a
2/ loop and masked.  It replaces the version built on LSHIFT, RSHIFT
and SWAP calls.  C@ now leaves its caller 7 return entries (was 4), and
the words above it gain with it: TYPE 6 (was 3), DUMP 4, Q.PRINT, U.
and U.R 3 (were 2).  The signed number words stay at 2: their sign
waits on the return stack.

Co-Authored-By: Claude Opus 5.5 <noreply@anthropic.com>
This commit is contained in:
rajames
2026-10-03 17:15:57 -04:00
co-authored by Claude Opus 5.5
parent e50cc1f73a
commit 7c5be22799
5 changed files with 142 additions and 32 deletions
Download Patch File Download Diff File Expand all files Collapse all files
v4/tests/test_foundation.c
+33 -7
View File
@@ -1354,11 +1354,16 @@ static void build(void)
O(DROP); O(DROP); O(SEMI);
}
/* Byte access on a word-addressed node (D-1), 5.3 (C@ as written): four
/* Byte access on a word-addressed node (D-1), 5.3: four
* bytes to a cell, little-endian; a byte address is 4 * word address +
* byte index. `@` and `!` here are the opcodes, addressing through A.
* : C@ ( baddr -- c )
* dup 3 and 3 LSHIFT SWAP 2 RSHIFT a! @ SWAP RSHIFT 255 and ;
* : C@ ( baddr -- c ) call-free
* dup 2/ 2/ a! 3 and k A: word address
* if K0 -1 + if K1 -1 + if K2
* drop @ 23 FOR 2/ UNEXT 255 and ; byte 3
* K2: drop @ 15 FOR 2/ UNEXT 255 and ; byte 2
* K1: drop @ 7 FOR 2/ UNEXT 255 and ; byte 1
* K0: drop @ 255 and ; byte 0
* : C! ( c baddr -- ) call-free
* dup 2/ 2/ a! 3 and push 255 and pop c' k A: word address
* if K0 -1 + if K1 -1 + if K2
@@ -1369,9 +1374,29 @@ static void build(void)
* One case per byte position: the byte is shifted up, that byte of the
* cell cleared with a constant mask, and the two added. */
w_cfetch = v4_asm_label(&as);
O(DUP); LIT(3); O(AND); LIT(3); CALL(w_lshift);
CALL(w_swap); LIT(2); CALL(w_rshift); O(BANG_A); O(FETCH_A);
CALL(w_swap); CALL(w_rshift); LIT(255); O(AND); O(SEMI);
{
v4_asm_ref f0, f1, f2;
O(DUP); O(TWO_SLASH); O(TWO_SLASH); O(BANG_A); LIT(3); O(AND);
f0 = v4_asm_branch_fwd(&as, V4_OP_IF);
LIT(-1); O(ADD); f1 = v4_asm_branch_fwd(&as, V4_OP_IF);
LIT(-1); O(ADD); f2 = v4_asm_branch_fwd(&as, V4_OP_IF);
O(DROP); O(FETCH_A); LIT(23); O(PUSH);
(void)v4_asm_label(&as);
O(TWO_SLASH); O(UNEXT);
LIT(255); O(AND); O(SEMI);
v4_asm_resolve(&as, f2, v4_asm_label(&as));
O(DROP); O(FETCH_A); LIT(15); O(PUSH);
(void)v4_asm_label(&as);
O(TWO_SLASH); O(UNEXT);
LIT(255); O(AND); O(SEMI);
v4_asm_resolve(&as, f1, v4_asm_label(&as));
O(DROP); O(FETCH_A); LIT(7); O(PUSH);
(void)v4_asm_label(&as);
O(TWO_SLASH); O(UNEXT);
LIT(255); O(AND); O(SEMI);
v4_asm_resolve(&as, f0, v4_asm_label(&as));
O(DROP); O(FETCH_A); LIT(255); O(AND); O(SEMI);
}
{
v4_asm_ref k0, k1, k2;
@@ -2674,7 +2699,7 @@ int main(void)
CHECK(call(w_rshift, 2, vec[i], (v4_cell)c, 0) && left1((v4_cell)r), "RSHIFT [%u,%u]", i, c);
}
/* C@ and C! as written: every byte of two adjacent words, several
/* C@ and C!: every byte of two adjacent words, several
* values, the other bytes and the neighbouring words left alone. */
{
static const v4_ucell cv[] = { 0, 1, 0x41, 0x7F, 0x80, 0xFF, 0x1FF, 0xABCD };
@@ -2830,6 +2855,7 @@ int main(void)
static const v4_cell cf_args[][4] = { { (V4_NODE_WORDS - 47) * 4 + 3, 0, 0, 0 }, { (V4_NODE_WORDS - 47) * 4, 0, 0, 0 } };
static const v4_cell cs_args[][4] = { { 0x41, (V4_NODE_WORDS - 47) * 4 + 3, 0, 0 }, { 0xFF, (V4_NODE_WORDS - 47) * 4, 0, 0 } };
headroom("C@", w_cfetch, 1, cf_args, 2, 1, &dh, &rh);
CHECK(dh >= 7 && rh >= 7, "C@ is call-free");
headroom("C!", w_cstore, 2, cs_args, 2, 0, &dh, &rh);
headroom("SM/REM", w_smrem, 3, smrem_args, 5, 2, &dh, &rh);
CHECK(rh >= 1, "SM/REM leaves room for /MOD's return address");
v4/tests/test_numout.c
+31 -6
View File
@@ -289,12 +289,37 @@ static void build_output(void)
v4_asm_ref a, b;
v4_cell l, l_tail;
/* : C@ ( baddr -- c ) as written in 5.3
* dup 3 and 3 LSHIFT SWAP 2 RSHIFT a! @ SWAP RSHIFT 255 and ; */
/* : C@ ( baddr -- c ) call-free, 5.3
* dup 2/ 2/ a! 3 and k A: word address
* if K0 -1 + if K1 -1 + if K2
* drop @ 23 FOR 2/ UNEXT 255 and ; byte 3
* K2: drop @ 15 FOR 2/ UNEXT 255 and ; byte 2
* K1: drop @ 7 FOR 2/ UNEXT 255 and ; byte 1
* K0: drop @ 255 and ; byte 0 */
w_cfetch = v4_asm_label(&as);
O(DUP); LIT(3); O(AND); LIT(3); CALL(w_lshift);
CALL(w_swap); LIT(2); CALL(w_rshift); O(BANG_A); O(FETCH_A);
CALL(w_swap); CALL(w_rshift); LIT(255); O(AND); O(SEMI);
{
v4_asm_ref f0, f1, f2;
O(DUP); O(TWO_SLASH); O(TWO_SLASH); O(BANG_A); LIT(3); O(AND);
f0 = v4_asm_branch_fwd(&as, V4_OP_IF);
LIT(-1); O(ADD); f1 = v4_asm_branch_fwd(&as, V4_OP_IF);
LIT(-1); O(ADD); f2 = v4_asm_branch_fwd(&as, V4_OP_IF);
O(DROP); O(FETCH_A); LIT(23); O(PUSH);
(void)v4_asm_label(&as);
O(TWO_SLASH); O(UNEXT);
LIT(255); O(AND); O(SEMI);
v4_asm_resolve(&as, f2, v4_asm_label(&as));
O(DROP); O(FETCH_A); LIT(15); O(PUSH);
(void)v4_asm_label(&as);
O(TWO_SLASH); O(UNEXT);
LIT(255); O(AND); O(SEMI);
v4_asm_resolve(&as, f1, v4_asm_label(&as));
O(DROP); O(FETCH_A); LIT(7); O(PUSH);
(void)v4_asm_label(&as);
O(TWO_SLASH); O(UNEXT);
LIT(255); O(AND); O(SEMI);
v4_asm_resolve(&as, f0, v4_asm_label(&as));
O(DROP); O(FETCH_A); LIT(255); O(AND); O(SEMI);
}
/* : DNEGATE ( d -- -d ) inv over if L1 drop push inv 1 + pop ; L1: drop 1 + ; */
w_dnegate = v4_asm_label(&as);
@@ -677,7 +702,7 @@ int main(void)
headroom(".R", w_dotr, 2, -12345, 9, 0, " -12345 ", &dh, &rh);
CHECK(dh >= 2 && rh >= 2, ".R leaves room");
headroom("U.", w_udot, 1, 12345, 0, 0, "12345 ", &dh, &rh);
CHECK(dh >= 2 && rh >= 2, "U. leaves room");
CHECK(dh >= 3 && rh >= 3, "U. leaves room");
headroom("U.R", w_udotr, 2, 12345, 9, 0, " 12345 ", &dh, &rh);
headroom("D.", w_ddot, 2, -12345, -1, 0, "-12345 ", &dh, &rh);
CHECK(dh >= 2 && rh >= 2, "D. leaves room");
v4/tests/test_printing.c
+32 -7
View File
@@ -303,12 +303,37 @@ static void build_output(void)
v4_asm_ref a, b, c, d, done1, done2;
v4_cell l, l_tail, l_line;
/* : C@ ( baddr -- c ) as written in 5.3
* dup 3 and 3 LSHIFT SWAP 2 RSHIFT a! @ SWAP RSHIFT 255 and ; */
/* : C@ ( baddr -- c ) call-free, 5.3
* dup 2/ 2/ a! 3 and k A: word address
* if K0 -1 + if K1 -1 + if K2
* drop @ 23 FOR 2/ UNEXT 255 and ; byte 3
* K2: drop @ 15 FOR 2/ UNEXT 255 and ; byte 2
* K1: drop @ 7 FOR 2/ UNEXT 255 and ; byte 1
* K0: drop @ 255 and ; byte 0 */
w_cfetch = v4_asm_label(&as);
O(DUP); LIT(3); O(AND); LIT(3); CALL(w_lshift);
CALL(w_swap); LIT(2); CALL(w_rshift); O(BANG_A); O(FETCH_A);
CALL(w_swap); CALL(w_rshift); LIT(255); O(AND); O(SEMI);
{
v4_asm_ref f0, f1, f2;
O(DUP); O(TWO_SLASH); O(TWO_SLASH); O(BANG_A); LIT(3); O(AND);
f0 = v4_asm_branch_fwd(&as, V4_OP_IF);
LIT(-1); O(ADD); f1 = v4_asm_branch_fwd(&as, V4_OP_IF);
LIT(-1); O(ADD); f2 = v4_asm_branch_fwd(&as, V4_OP_IF);
O(DROP); O(FETCH_A); LIT(23); O(PUSH);
(void)v4_asm_label(&as);
O(TWO_SLASH); O(UNEXT);
LIT(255); O(AND); O(SEMI);
v4_asm_resolve(&as, f2, v4_asm_label(&as));
O(DROP); O(FETCH_A); LIT(15); O(PUSH);
(void)v4_asm_label(&as);
O(TWO_SLASH); O(UNEXT);
LIT(255); O(AND); O(SEMI);
v4_asm_resolve(&as, f1, v4_asm_label(&as));
O(DROP); O(FETCH_A); LIT(7); O(PUSH);
(void)v4_asm_label(&as);
O(TWO_SLASH); O(UNEXT);
LIT(255); O(AND); O(SEMI);
v4_asm_resolve(&as, f0, v4_asm_label(&as));
O(DROP); O(FETCH_A); LIT(255); O(AND); O(SEMI);
}
/* : DNEGATE ( d -- -d ) inv over if L1 drop push inv 1 + pop ; L1: drop 1 + ; */
w_dnegate = v4_asm_label(&as);
@@ -934,10 +959,10 @@ int main(void)
headroom("?", w_query, 1, XVAR, 0, "-12345 ", &dh, &rh);
CHECK(dh >= 2 && rh >= 2, "? leaves room");
headroom("Q.PRINT", w_qprint, 2, -98304, -1, "-1.50000 ", &dh, &rh);
CHECK(dh >= 2 && rh >= 2, "Q.PRINT leaves room");
CHECK(dh >= 3 && rh >= 3, "Q.PRINT leaves room");
ref_dump(DATA_BADDR + 3, 21, want);
headroom("DUMP", w_dump, 2, DATA_BADDR + 3, 21, want, &dh, &rh);
CHECK(dh >= 2 && rh >= 2, "DUMP leaves room");
CHECK(dh >= 3 && rh >= 4, "DUMP leaves room");
}
CHECK(v4_node_guards_intact(&n), "guards intact");
v4/tests/test_terminal.c
+32 -6
View File
@@ -15,6 +15,7 @@
* as the text between "System initialization complete." and "Goodbye!".
*
* On a node of its own, like test_pictured.c. SWAP, LSHIFT, RSHIFT and C@
* (call-free, so it no longer uses the other three)
* are assembled again here as they are in test_foundation.c.
*/
#include "v4/asm.h"
@@ -91,12 +92,37 @@ static void build(void)
HERE_(a);
O(DROP); O(DROP); O(SEMI);
/* : C@ ( baddr -- c )
* dup 3 and 3 LSHIFT SWAP 2 RSHIFT a! @ SWAP RSHIFT 255 and ; */
/* : C@ ( baddr -- c ) call-free, 5.3
* dup 2/ 2/ a! 3 and k A: word address
* if K0 -1 + if K1 -1 + if K2
* drop @ 23 FOR 2/ UNEXT 255 and ; byte 3
* K2: drop @ 15 FOR 2/ UNEXT 255 and ; byte 2
* K1: drop @ 7 FOR 2/ UNEXT 255 and ; byte 1
* K0: drop @ 255 and ; byte 0 */
w_cfetch = v4_asm_label(&as);
O(DUP); LIT(3); O(AND); LIT(3); CALL(w_lshift);
CALL(w_swap); LIT(2); CALL(w_rshift); O(BANG_A); O(FETCH_A);
CALL(w_swap); CALL(w_rshift); LIT(255); O(AND); O(SEMI);
{
v4_asm_ref f0, f1, f2;
O(DUP); O(TWO_SLASH); O(TWO_SLASH); O(BANG_A); LIT(3); O(AND);
f0 = v4_asm_branch_fwd(&as, V4_OP_IF);
LIT(-1); O(ADD); f1 = v4_asm_branch_fwd(&as, V4_OP_IF);
LIT(-1); O(ADD); f2 = v4_asm_branch_fwd(&as, V4_OP_IF);
O(DROP); O(FETCH_A); LIT(23); O(PUSH);
(void)v4_asm_label(&as);
O(TWO_SLASH); O(UNEXT);
LIT(255); O(AND); O(SEMI);
v4_asm_resolve(&as, f2, v4_asm_label(&as));
O(DROP); O(FETCH_A); LIT(15); O(PUSH);
(void)v4_asm_label(&as);
O(TWO_SLASH); O(UNEXT);
LIT(255); O(AND); O(SEMI);
v4_asm_resolve(&as, f1, v4_asm_label(&as));
O(DROP); O(FETCH_A); LIT(7); O(PUSH);
(void)v4_asm_label(&as);
O(TWO_SLASH); O(UNEXT);
LIT(255); O(AND); O(SEMI);
v4_asm_resolve(&as, f0, v4_asm_label(&as));
O(DROP); O(FETCH_A); LIT(255); O(AND); O(SEMI);
}
/* ---- terminal output, 5.10 ---- */
@@ -272,7 +298,7 @@ int main(void)
CHECK(dh >= 7 && rh >= 7, "EMIT leaves room");
headroom("CR", w_cr, 0, 0, 0, "\n", 1, &dh, &rh);
headroom("TYPE", w_type, 2, STR_BADDR + 17, 9, text + 17, 9, &dh, &rh);
CHECK(dh >= 2 && rh >= 2, "TYPE leaves room");
CHECK(dh >= 5 && rh >= 6, "TYPE leaves room");
}
CHECK(v4_node_guards_intact(&n), "guards intact");