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
docs/v4.0.0/DECOMPOSITION.md
+12 -7
View File
@@ -332,7 +332,7 @@ Section numbers match the v3 primitive reference.
| `2@` | CAP | `a! @+ @` (low cell at `addr`, high at `addr+1`, as in v3) |
| `2!` | CAP | `a! SWAP !+ !` |
| `C@` | CAP | See below (D-1). Executed on the golden model (2026-10-03). |
| `C!` | CAP | See below (D-1). Executed on the golden model (2026-10-03). |
| `C!` | CAP | See below (D-1). Call-free. Executed on the golden model (2026-10-03). |
| `FILL` | CAP | See below. |
| `MOVE` | CAP | `push 2DUP U< IF pop CMOVE> ELSE pop CMOVE THEN` |
| `ERASE` | CAP | `0 FILL` |
@@ -345,12 +345,17 @@ Section numbers match the v3 primitive reference.
: C@ ( baddr -- c )
dup 3 and 3 LSHIFT SWAP 2 RSHIFT a! @ SWAP RSHIFT 255 and ;
\ C! is call-free: one case per byte position. The byte is shifted up with a
\ 2* loop, that byte of the cell cleared with a constant mask, and the two added.
\ It replaces a version built on LSHIFT, RSHIFT, SWAP and OR calls, which was
\ correct but left its caller 4 return-stack entries; this leaves 7.
: C! ( c baddr -- )
dup 2 RSHIFT a! \ A = word address
3 and 3 LSHIFT \ c bits
SWAP 255 and over LSHIFT \ bits c'
SWAP 255 SWAP LSHIFT inv \ c' ~mask
@ and OR ! ;
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
: FILL ( baddr u c -- )
SWAP BEGIN dup WHILE 1- push 2DUP SWAP C! SWAP 1+ SWAP pop REPEAT 2DROP drop ;
@@ -447,7 +452,7 @@ All output reaches the console through `EMIT` (DEV).
| Word | Fate | Notes |
| --- | --- | --- |
| `<#` `#` `#S` `HOLD` `SIGN` `#>` | CAP | Pictured output over `UM/MOD` and a 64-byte hold buffer, filled backwards from its end `HEND` through the pointer `HLD`. Standard stack effects (v3 took its double low cell on top, and its tolerant `#>` popped `ud` only if present; neither is kept). Otherwise v3's behaviour: digits `0`–`9` then `A`–`Z`; `BASE` outside 2–36 reads as 10; 63 characters; `HOLD` of a value outside 0–255 or into a full buffer stores nothing and sets `NODE-ERROR` (D-13). Definitions below. Executed on the golden model (2026-10-03) against a C reference in bases 2, 3, 8, 10, 16, 36 and four invalid ones. `<# #S #>` leaves its caller 3 data cells and 2 return entries; the signed picture `dup push ABS 0 <# #S pop SIGN #>` leaves 1 return entry, the depth being `C!`'s as written (`C!` → `LSHIFT` → `SWAP`). `#`, `#S`, `HOLD` and `SIGN` clobber `A` and `B`. |
| `<#` `#` `#S` `HOLD` `SIGN` `#>` | CAP | Pictured output over `UM/MOD` and a 64-byte hold buffer, filled backwards from its end `HEND` through the pointer `HLD`. Standard stack effects (v3 took its double low cell on top, and its tolerant `#>` popped `ud` only if present; neither is kept). Otherwise v3's behaviour: digits `0`–`9` then `A`–`Z`; `BASE` outside 2–36 reads as 10; 63 characters; `HOLD` of a value outside 0–255 or into a full buffer stores nothing and sets `NODE-ERROR` (D-13). Definitions below. Executed on the golden model (2026-10-03) against a C reference in bases 2, 3, 8, 10, 16, 36 and four invalid ones. `<# #S #>` leaves its caller 3 data cells and 2 return entries; the signed picture `dup push ABS 0 <# #S pop SIGN #>` leaves 1 return entry. The deepest point is inside `#`, which holds the high quotient on the return stack across its second `UM/MOD`. `#`, `#S`, `HOLD` and `SIGN` clobber `A` and `B`. |
| `HLD` | CAP | Variable: byte address of the first held character. |
| `.` `.R` `U.` `U.R` `D.` `D.R` | CAP | Built on pictured output and `TYPE`. |
| `.S` | RET | No visible stack pointer (D-2). |
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. */