feat(v4.0.0): BASE, DECIMAL, HEX, OCTAL and HLD
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
co-authored by
Claude Opus 5.5
Claude Opus 5.5
parent
030ca63639
commit
e50cc1f73a
@@ -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! 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! 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`:
|
||||
`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.
|
||||
@@ -453,15 +453,15 @@ 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 4 data cells and 3 return entries; the signed picture `dup push ABS 0 <# #S pop SIGN #>` leaves 2 return entries. `#`, `#S`, `HOLD` and `SIGN` clobber `A` and `B`. |
|
||||
| `HLD` | CAP | Variable: byte address of the first held character. |
|
||||
| `HLD` | CAP | Variable: byte address of the first held character. `HLD ( -- addr )` is the variable's word address, a literal. Not a v3 word. Executed on the golden model (2026-10-03): after `<#` and each `HOLD` or `#`, `HLD @` is the address `#>` returns. |
|
||||
| `.` `.R` `U.` `U.R` `D.` `D.R` | CAP | Built on pictured output and `TYPE`; definitions below. As v3: the number in the current base, then one space; the `.R` words right-justify it in `width` columns first, print a wider number whole, and pad nothing for `width <= 0`. (The space after the `.R` words is not FORTH-79; it is what v3 prints.) Where v4 parts from v3: a double is `( lo hi )`, where v3's `D.` took the low cell on top; `D.` prints the whole double, where v3 printed `DOUBLE-OVERFLOW` unless it fitted one signed cell (they agree whenever it does); printing honours the `BASE` variable, where v3 printed in a host copy that only `DECIMAL`, `HEX` and `OCTAL` set, so `n BASE !` changed v3's input base but not its output; and the number is built in the 63-character hold buffer, so a longer one — a 64-bit cell in base 2, a large double in a small base — loses its leading characters and sets `NODE-ERROR` (D-13), where v3 printed from a private 80-character buffer. Executed on the golden model (2026-10-03) against a C reference in the ten bases of the pictured-output test and eleven field widths, and against five transcripts of the v3 binary (a sixth, the extreme cells, at 64-bit cells). Each leaves its caller 4 data cells and 2 return entries. All clobber `A` and `B`. |
|
||||
| `(W)` | CAP | Variable: the field width of the `.R` words. Like `BASE` and `HLD`, it lives in node memory, so the width is on neither stack while the picture runs. |
|
||||
| `.S` | RET | No visible stack pointer (D-2). |
|
||||
| `?` | CAP | `( addr -- )`: `a! @ jump .` — the cell at word address `addr` (D-1), printed as `.` prints it. Executed on the golden model (2026-10-03), including a transcript of the v3 binary. Leaves its caller 4 data cells and 2 return entries. Clobbers `A` and `B`. |
|
||||
| `DUMP` | CAP | `( baddr u -- )`: `u` bytes from byte address `baddr`, sixteen to a line, in v3's format: the address in hex, `": "`, each byte as two hex digits and a space (three spaces where the line runs out), `" \|"`, the bytes as characters with `.` for anything outside 32–126, `"\|"` and a new line. Always hex, whatever `BASE` is, and `BASE` is put back. The address is two hex digits per byte of a cell — 8 at 32-bit cells, 16 at 64, which is v3's width. Nothing for `u = 0`; for `u < 0` nothing is printed and `NODE-ERROR` is set, as `TYPE` does, where v3 raised its error flag. Addresses are not range-checked (open, `node.h`). Definition below. Executed on the golden model (2026-10-03) against a C reference at six alignments and every length 0–50, and at 64-bit cells against a transcript of the v3 binary, byte for byte. Leaves its caller 4 data cells and 2 return entries. Clobbers `A` and `B`. |
|
||||
| `(DP)` | CAP | Variable, 4 cells: `DUMP`'s saved `BASE`, address, count and column. |
|
||||
| `BASE` | CAP | Variable. |
|
||||
| `DECIMAL` `HEX` `OCTAL` | CAP | `10 BASE !` and so on. |
|
||||
| `BASE` | CAP | Variable. `BASE ( -- addr )` is its word address (D-1), a literal. Executed on the golden model (2026-10-03). Storing to it changes what is printed, which it did not in v3 (see `.`). |
|
||||
| `DECIMAL` `HEX` `OCTAL` | CAP | `10 BASE !`, `16 BASE !`, `8 BASE !`, with `!` in line as `a! !`. Executed on the golden model (2026-10-03), including a transcript of the v3 binary. Each leaves its caller 8 data cells and 8 return entries. Clobber `A`. |
|
||||
|
||||
```forth
|
||||
\ pictured output. HEND is the byte address just past the hold buffer.
|
||||
|
||||
+122
-4
@@ -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");
|
||||
|
||||
Reference in New Issue
Block a user