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

feat(v4.0.0): BASE, DECIMAL, HEX, OCTAL and HLD

Browse Source 
BASE and HLD leave their variable's word address; DECIMAL, HEX and
OCTAL store 10, 16 and 8.  Executed on the golden model at both cell
widths, including a recorded transcript of the v3 binary.

Co-Authored-By: Claude Opus 5.5 <noreply@anthropic.com>
This commit is contained in:
rajames
2026-10-03 16:46:38 -04:00
co-authored by Claude Opus 5.5
parent 030ca63639
commit e50cc1f73a
2 changed files with 126 additions and 8 deletions
Download Patch File Download Diff File Expand all files Collapse all files
v4/tests/test_printing.c
+122 -4
View File
@@ -1,4 +1,4 @@
/* test_printing.c -- `?`, Q.PRINT and DUMP, executed.
/* test_printing.c -- `?`, Q.PRINT, DUMP, and BASE DECIMAL HEX OCTAL HLD, executed.
*
* DECOMPOSITION.md 5.8 and 5.26. These are built on the number-output
* words of test_numout.c, so that file's words are assembled again here,
@@ -16,15 +16,21 @@
* " |", the bytes as characters with '.' for
* anything outside 32..126, "|" and a new line;
* always hex; nothing for u = 0
* BASE ( -- addr ) the address of the number base
* DECIMAL HEX OCTAL set it to 10, 16, 8
* HLD ( -- addr ) is not a v3 word; it is the address of the pointer the
* pictured-output words keep (5.8).
*
* Where v4 parts from v3:
* - `?` takes a word address (D-1); DUMP takes a byte address, as C@ does;
* - Q.PRINT is signed (D-8): a negative value prints "-" and its
* magnitude; v3 printed it as a large unsigned number;
* - `n BASE !` changes what v4 prints; in v3 it changed only the input
* base, because v3 printed in a host copy that DECIMAL, HEX and OCTAL set;
* - DUMP with u < 0 prints nothing and sets NODE-ERROR, as TYPE does; v3
* raised its error flag. Addresses are not range-checked (open, node.h).
*
* Three transcripts of the real v3 binary are recorded below as expected
* Four transcripts of the real v3 binary are recorded below as expected
* output, taken on 2026-10-03 as in test_numout.c. v3's DUMP address is 16
* digits because its cell is 64 bits, so the DUMP transcript is compared at
* 64-bit cells only; the test data sits at byte address 0xD0 as it did in v3.
@@ -68,7 +74,8 @@ static v4_cell w_swap, w_or, w_ummod, w_lshift, w_rshift, w_cstore, w_cfetch,
w_dnegate, w_base, w_begin, w_hold, w_sign, w_hash, w_hashs, w_end,
w_emit, w_space, w_type,
w_spaces, w_dot, w_dotr, w_udot, w_udotr, w_ddot, w_ddotr,
w_cr, w_query, w_qprint, w_dbyte, w_dump, t_v3q, t_v3p, l_out;
w_cr, w_query, w_qprint, w_dbyte, w_dump, t_v3q, t_v3p, l_out,
w_basevar, w_hldvar, w_decimal, w_hex, w_octal, t_v3b, t_hld1, t_hld2, t_base2;
#define O(name) v4_asm_op(&as, V4_OP_##name)
#define LIT(v) v4_asm_lit(&as, (v4_cell)(v))
@@ -538,6 +545,53 @@ static void build_output(void)
HERE_(done1); HERE_(done2);
O(DROP); VGET(DP); VSET(BASE); O(SEMI);
/* : BASE ( -- addr ) the word address of the variable, a literal
* : HLD ( -- addr ) likewise
* A variable compiles in line as its address; they are words here so
* that they can be called on their own. */
w_basevar = v4_asm_label(&as);
LIT(BASE); O(SEMI);
w_hldvar = v4_asm_label(&as);
LIT(HLD); O(SEMI);
/* : DECIMAL 10 BASE ! ; : HEX 16 BASE ! ; : OCTAL 8 BASE ! ;
* with `!` in line as a! ! (5.3). */
w_decimal = v4_asm_label(&as);
LIT(10); LIT(BASE); O(BANG_A); O(STORE_A); O(SEMI);
w_hex = v4_asm_label(&as);
LIT(16); LIT(BASE); O(BANG_A); O(STORE_A); O(SEMI);
w_octal = v4_asm_label(&as);
LIT(8); LIT(BASE); O(BANG_A); O(STORE_A); O(SEMI);
/* v3, where a number is read in the current base:
* BASE @ . HEX BASE @ DECIMAL . OCTAL BASE @ DECIMAL . 255 HEX . 255 OCTAL .
* 255 DECIMAL . 7 BASE ! BASE @ DECIMAL . 91 EMIT
* The second 255 was read in hex (597) and the third in octal (173). */
#define BASE_FETCH() do { CALL(w_basevar); O(BANG_A); O(FETCH_A); } while (0)
t_v3b = v4_asm_label(&as);
BASE_FETCH(); CALL(w_dot);
CALL(w_hex); BASE_FETCH(); CALL(w_decimal); CALL(w_dot);
CALL(w_octal); BASE_FETCH(); CALL(w_decimal); CALL(w_dot);
LIT(255); CALL(w_hex); CALL(w_dot);
LIT(597); CALL(w_octal); CALL(w_dot);
LIT(173); CALL(w_decimal); CALL(w_dot);
LIT(7); CALL(w_basevar); O(BANG_A); O(STORE_A); BASE_FETCH(); CALL(w_decimal); CALL(w_dot);
LIT(91); CALL(w_emit); O(SEMI);
/* ( -- hld baddr u ) <# 65 HOLD 66 HOLD HLD @ 0 0 #> */
t_hld1 = v4_asm_label(&as);
CALL(w_begin); LIT(65); CALL(w_hold); LIT(66); CALL(w_hold);
CALL(w_hldvar); O(BANG_A); O(FETCH_A); LIT(0); LIT(0); CALL(w_end); O(SEMI);
/* ( u -- baddr u' hld ) 0 <# #S #> HLD @ */
t_hld2 = v4_asm_label(&as);
LIT(0); CALL(w_begin); CALL(w_hashs); CALL(w_end);
CALL(w_hldvar); O(BANG_A); O(FETCH_A); O(SEMI);
/* ( n -- ) 2 BASE ! . */
t_base2 = v4_asm_label(&as);
LIT(2); CALL(w_basevar); O(BANG_A); O(STORE_A); JUMP(w_dot);
/* ---- the v3 transcripts ---- */
#define EM(ch) do { LIT(ch); CALL(w_emit); } while (0)
#define QPR(lo) do { LIT(lo); LIT(0); CALL(w_qprint); } while (0)
@@ -706,7 +760,7 @@ int main(void)
unsigned char bytes[128];
unsigned i, j;
printf("v4 printing tests (? Q.PRINT DUMP): V4_CELL_BITS=%d\n", V4_CELL_BITS);
printf("v4 printing tests (? Q.PRINT DUMP BASE HLD): V4_CELL_BITS=%d\n", V4_CELL_BITS);
v4_node_reset(&n);
v4_asm_begin(&as, &n, CODE0);
@@ -809,9 +863,73 @@ int main(void)
if (node_byte(DATA_BADDR + (v4_cell)i) != bytes[i]) break;
CHECK(i == sizeof bytes, "the dumped bytes are untouched");
/* ---- BASE DECIMAL HEX OCTAL HLD ---- */
{
static const struct { v4_cell *w; v4_cell val; const char *name; } setter[] = {
{ &w_decimal, 10, "DECIMAL" }, { &w_hex, 16, "HEX" }, { &w_octal, 8, "OCTAL" }
};
static const v4_cell before[] = { 10, 16, 8, 2, 36, 0, -1, 12345 };
v4_cell hld, baddr, u;
prepare(10);
v4_dstack_push(&n.ds, CANARY);
CHECK(v4_test_call(&n, &es, &h, t_v3b, 4000000) > 0 && n.ds.t == CANARY
&& printed("10 16 8 FF 1125 173 7 ["), "v3: BASE, HEX, OCTAL, DECIMAL");
CHECK(v4_node_load(&n, BASE) == 10, "the transcript ends in decimal");
prepare(10);
v4_dstack_push(&n.ds, CANARY);
CHECK(v4_test_call(&n, &es, &h, w_basevar, 1000) > 0 && v4_dstack_pop(&n.ds) == BASE
&& v4_dstack_pop(&n.ds) == CANARY, "BASE leaves the variable's address");
prepare(10);
v4_dstack_push(&n.ds, CANARY);
CHECK(v4_test_call(&n, &es, &h, w_hldvar, 1000) > 0 && v4_dstack_pop(&n.ds) == HLD
&& v4_dstack_pop(&n.ds) == CANARY, "HLD leaves the variable's address");
for (i = 0; i < 3; i++)
for (j = 0; j < sizeof before / sizeof before[0]; j++) {
v4_cell below = v4_node_load(&n, BASE - 1), above = v4_node_load(&n, BASE + 1);
prepare(before[j]);
v4_dstack_push(&n.ds, CANARY);
CHECK(v4_test_call(&n, &es, &h, *setter[i].w, 1000) > 0 && n.ds.t == CANARY,
"%s returns with the stack as it was", setter[i].name);
CHECK(v4_node_load(&n, BASE) == setter[i].val, "%s from %ld", setter[i].name, (long)before[j]);
CHECK(v4_node_load(&n, BASE - 1) == below && v4_node_load(&n, BASE + 1) == above
&& n.console_len == 0 && v4_node_load(&n, NODE_ERROR) == 0,
"%s touches nothing else", setter[i].name);
}
/* n BASE ! changes what is printed (v3 printed 5 here). */
prepare(10);
v4_dstack_push(&n.ds, CANARY);
v4_dstack_push(&n.ds, 5);
CHECK(v4_test_call(&n, &es, &h, t_base2, 4000000) > 0 && n.ds.t == CANARY && printed("101 "),
"2 BASE ! 5 . prints 101");
/* HLD holds the byte address of the first held character. */
prepare(10);
v4_dstack_push(&n.ds, CANARY);
CHECK(v4_test_call(&n, &es, &h, t_hld1, 4000000) > 0, "<# 65 HOLD 66 HOLD HLD @ 0 0 #> returns");
u = v4_dstack_pop(&n.ds); baddr = v4_dstack_pop(&n.ds); hld = v4_dstack_pop(&n.ds);
CHECK(v4_dstack_pop(&n.ds) == CANARY && u == 2 && baddr == HEND - 2 && hld == baddr,
"after two HOLDs HLD @ is HEND - 2, and #> returns it");
CHECK(node_byte(hld) == 66 && node_byte(hld + 1) == 65, "the held characters are at HLD @");
for (i = 0; i < NVEC; i++) {
prepare(10);
v4_dstack_push(&n.ds, CANARY);
v4_dstack_push(&n.ds, vec[i]);
CHECK(v4_test_call(&n, &es, &h, t_hld2, 4000000) > 0, "0 <# #S #> HLD @ returns [%u]", i);
hld = v4_dstack_pop(&n.ds); u = v4_dstack_pop(&n.ds); baddr = v4_dstack_pop(&n.ds);
CHECK(v4_dstack_pop(&n.ds) == CANARY && hld == baddr && baddr + u == HEND,
"HLD @ is the address #> returns [%u]", i);
}
}
/* What they leave their caller (D-2). */
{
int dh, rh;
headroom("DECIMAL", w_decimal, 0, 0, 0, "", &dh, &rh);
CHECK(dh >= 6 && rh >= 7, "DECIMAL leaves room");
v4_node_store(&n, XVAR, -12345);
headroom("?", w_query, 1, XVAR, 0, "-12345 ", &dh, &rh);
CHECK(dh >= 2 && rh >= 2, "? leaves room");