diff --git a/docs/v4.0.0/DECOMPOSITION.md b/docs/v4.0.0/DECOMPOSITION.md index b542dcce..4aee96d2 100644 --- a/docs/v4.0.0/DECOMPOSITION.md +++ b/docs/v4.0.0/DECOMPOSITION.md @@ -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. diff --git a/v4/tests/test_printing.c b/v4/tests/test_printing.c index 9ab4365d..f51499de 100644 --- a/v4/tests/test_printing.c +++ b/v4/tests/test_printing.c @@ -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");