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

feat(v4.0.0): call-free C!

Browse Source 
C! as written in 5.3 called RSHIFT and LSHIFT (which call SWAP) and OR.
It is now one straight-line case per byte position: the byte is shifted
up with a `2* unext` loop, that byte of the cell cleared with a constant
mask, and the two added. The word address is `2/ 2/` of the byte
address. The upper half of a 64-bit cell is still preserved.

Headroom (data cells under args / return entries): 5/4 -> 7/7.

Same checks as before (every byte of two adjacent words, eight values,
neighbours and the upper half untouched) at 32- and 64-bit cells,
optimised and ASan+UBSan (`make test`, `make sanitize`). Four mutations
fail, one of them only at 64-bit cells, where it differs.

test_pictured.c carries the same C!. The pictured words did not gain
return-stack room from this: <# #S #> still leaves 2 entries and the
signed picture 1. With C! shallow, the deepest point is now inside `#`,
which holds the high quotient on the return stack across its second
UM/MOD. Recorded in 5.8; `#` is unchanged.

Test results on the amd64 host only. This is a development check, not
acceptance (JUSTIFICATION.md section 16).

Co-Authored-By: Claude Opus 5.5 <noreply@anthropic.com>
This commit is contained in:
rajames
2026-10-03 11:45:52 -04:00
co-authored by Claude Opus 5.5
parent 6a019b8968
commit 638aeb6636
3 changed files with 82 additions and 26 deletions
Download Patch File Download Diff File Expand all files Collapse all files
v4/tests/test_foundation.c
+35 -10
View File
@@ -1354,25 +1354,50 @@ static void build(void)
O(DROP); O(DROP); O(SEMI);
}
/* Byte access on a word-addressed node (D-1), as written in 5.3: four
/* Byte access on a word-addressed node (D-1), 5.3 (C@ as written): 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! ( c baddr -- )
* dup 2 RSHIFT a! 3 and 3 LSHIFT SWAP 255 and over LSHIFT
* SWAP 255 SWAP LSHIFT inv @ and OR ! ; */
* : 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
* drop 23 FOR 2* UNEXT @ 4278190080 inv and + ! ; byte 3
* K2: drop 15 FOR 2* UNEXT @ -16711681 and + ! ; byte 2
* K1: drop 7 FOR 2* UNEXT @ -65281 and + ! ; byte 1
* K0: drop @ -256 and + ! ; byte 0
* 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);
w_cstore = v4_asm_label(&as);
O(DUP); LIT(2); CALL(w_rshift); O(BANG_A);
LIT(3); O(AND); LIT(3); CALL(w_lshift);
CALL(w_swap); LIT(255); O(AND); O(OVER); CALL(w_lshift);
CALL(w_swap); LIT(255); CALL(w_swap); CALL(w_lshift); O(INV);
O(FETCH_A); O(AND); CALL(w_or); O(STORE_A); O(SEMI);
{
v4_asm_ref k0, k1, k2;
w_cstore = v4_asm_label(&as);
O(DUP); O(TWO_SLASH); O(TWO_SLASH); O(BANG_A);
LIT(3); O(AND); O(PUSH); LIT(255); O(AND); O(RPOP);
k0 = v4_asm_branch_fwd(&as, V4_OP_IF);
LIT(-1); O(ADD); k1 = v4_asm_branch_fwd(&as, V4_OP_IF);
LIT(-1); O(ADD); k2 = v4_asm_branch_fwd(&as, V4_OP_IF);
O(DROP); LIT(23); O(PUSH);
(void)v4_asm_label(&as);
O(TWO_STAR); O(UNEXT);
O(FETCH_A); LIT((v4_cell)(v4_ucell)0xFF000000u); O(INV); O(AND); O(ADD); O(STORE_A); O(SEMI);
v4_asm_resolve(&as, k2, v4_asm_label(&as));
O(DROP); LIT(15); O(PUSH);
(void)v4_asm_label(&as);
O(TWO_STAR); O(UNEXT);
O(FETCH_A); LIT(-16711681); O(AND); O(ADD); O(STORE_A); O(SEMI);
v4_asm_resolve(&as, k1, v4_asm_label(&as));
O(DROP); LIT(7); O(PUSH);
(void)v4_asm_label(&as);
O(TWO_STAR); O(UNEXT);
O(FETCH_A); LIT(-65281); O(AND); O(ADD); O(STORE_A); O(SEMI);
v4_asm_resolve(&as, k0, v4_asm_label(&as));
O(DROP); O(FETCH_A); LIT(-256); O(AND); O(ADD); O(STORE_A); O(SEMI);
}
CHECK(v4_asm_ok(&as), "foundation words assemble");
}
v4/tests/test_pictured.c
+35 -9
View File
@@ -150,15 +150,41 @@ static void build_dependencies(void)
O(DROP); O(DROP); O(SEMI);
}
/* : C! ( c baddr -- )
* dup 2 RSHIFT a! 3 and 3 LSHIFT SWAP 255 and over LSHIFT
* SWAP 255 SWAP LSHIFT inv @ and OR ! ; */
w_cstore = v4_asm_label(&as);
O(DUP); LIT(2); CALL(w_rshift); O(BANG_A);
LIT(3); O(AND); LIT(3); CALL(w_lshift);
CALL(w_swap); LIT(255); O(AND); O(OVER); CALL(w_lshift);
CALL(w_swap); LIT(255); CALL(w_swap); CALL(w_lshift); O(INV);
O(FETCH_A); O(AND); CALL(w_or); O(STORE_A); O(SEMI);
/* C!, call-free, as in test_foundation.c.
* : 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
* drop 23 FOR 2* UNEXT @ 4278190080 inv and + ! ; byte 3
* K2: drop 15 FOR 2* UNEXT @ -16711681 and + ! ; byte 2
* K1: drop 7 FOR 2* UNEXT @ -65281 and + ! ; byte 1
* K0: drop @ -256 and + ! ; byte 0
* One case per byte position: the byte is shifted up, that byte of the
* cell cleared with a constant mask, and the two added. */
{
v4_asm_ref k0, k1, k2;
w_cstore = v4_asm_label(&as);
O(DUP); O(TWO_SLASH); O(TWO_SLASH); O(BANG_A);
LIT(3); O(AND); O(PUSH); LIT(255); O(AND); O(RPOP);
k0 = v4_asm_branch_fwd(&as, V4_OP_IF);
LIT(-1); O(ADD); k1 = v4_asm_branch_fwd(&as, V4_OP_IF);
LIT(-1); O(ADD); k2 = v4_asm_branch_fwd(&as, V4_OP_IF);
O(DROP); LIT(23); O(PUSH);
(void)v4_asm_label(&as);
O(TWO_STAR); O(UNEXT);
O(FETCH_A); LIT((v4_cell)(v4_ucell)0xFF000000u); O(INV); O(AND); O(ADD); O(STORE_A); O(SEMI);
v4_asm_resolve(&as, k2, v4_asm_label(&as));
O(DROP); LIT(15); O(PUSH);
(void)v4_asm_label(&as);
O(TWO_STAR); O(UNEXT);
O(FETCH_A); LIT(-16711681); O(AND); O(ADD); O(STORE_A); O(SEMI);
v4_asm_resolve(&as, k1, v4_asm_label(&as));
O(DROP); LIT(7); O(PUSH);
(void)v4_asm_label(&as);
O(TWO_STAR); O(UNEXT);
O(FETCH_A); LIT(-65281); O(AND); O(ADD); O(STORE_A); O(SEMI);
v4_asm_resolve(&as, k0, v4_asm_label(&as));
O(DROP); O(FETCH_A); LIT(-256); O(AND); O(ADD); O(STORE_A); O(SEMI);
}
}
/* Pictured output, 5.8. */