From 644bfc0a25bfe7795b09e844881299ab38bb0a07 Mon Sep 17 00:00:00 2001 From: rajames Date: Sun, 4 Oct 2026 18:50:12 -0400 Subject: [PATCH] feat(v4.0.0): number output in the capsule, and .S - capsule/numout.v4: <# # #S HOLD SIGN #>, . .R U. U.R D. D.R, ?, SPACES, DECIMAL HEX OCTAL -- the definitions DECOMPOSITION.md 5.8 gives and the mesh-node tests execute, now words of the host node's vocabulary. - .S, which D-16 makes possible again: as v3, the depth, then every value from the deepest, then a new line. It needs six cells of the stack free. - tests/test_host_quit.c: printed from the prompt, with 14 more sessions that are transcripts of the v3 binary, and the ends of the number range at each cell width. Co-Authored-By: Claude Opus 5.5 --- docs/v4.0.0/DECOMPOSITION.md | 4 +- v4/capsule/numout.v4 | 118 +++++++++++++++++++++++++++++++++++ v4/tests/host_map.h | 8 +++ v4/tests/test_host_quit.c | 63 ++++++++++++++++++- 4 files changed, 190 insertions(+), 3 deletions(-) create mode 100644 v4/capsule/numout.v4 diff --git a/docs/v4.0.0/DECOMPOSITION.md b/docs/v4.0.0/DECOMPOSITION.md index 7ff47011..1429ff48 100644 --- a/docs/v4.0.0/DECOMPOSITION.md +++ b/docs/v4.0.0/DECOMPOSITION.md @@ -472,7 +472,7 @@ All output reaches the console through `EMIT` (DEV). | `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. `.`, `U.` and `D.` print the number in the current base, then one space. The `.R` words right-justify it in `width` columns, print a wider number whole, pad nothing for `width <= 0`, and print no space after it: that is FORTH-79's reference word (ruled 2026-10-04); v3 printed a space after these too. 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; `U.` and `U.R` leave 3 return entries, the signed words 2, their sign waiting on the return stack. All clobber `A` and `B`. | | `(W)` | CAP | Variable, 2 cells: the field width of the `.R` words, and whether a blank follows the number. Like `BASE` and `HLD`, it lives in node memory, so the width is on neither stack while the picture runs. | -| `.S` | CC | Possible again under D-16 (`DEPTH` and `PICK`); not written until number output is in the capsule. | +| `.S` | CC | As v3: ` `, then every value on the stack, the deepest first, each followed by a blank, then a new line; the stack is left as it was. Built on `DEPTH`, `PICK` and `.` (D-16). It works on the stack it is printing, so it needs six cells of it free: on the host node's 32 it prints a stack of up to 26 values, and a fuller one is a stack overflow. Source in `v4/capsule/numout.v4`; executed on the golden model's host node (2026-10-04), including transcripts of the v3 binary. | | `?` | 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 4 return entries. Clobbers `A` and `B`. | | `(DP)` | CAP | Variable, 4 cells: `DUMP`'s saved `BASE`, address, count and column. | @@ -556,6 +556,8 @@ Everything `DUMP` keeps between words — the address, the count, the column and in the variable `(DP)`, so the stacks carry only what each picture and `TYPE` need, and no loop count sits on the return stack across a call. +**In the capsule.** `v4/capsule/numout.v4` holds these words for the host node — `<# # #S HOLD SIGN #>`, `. .R U. U.R D. D.R`, `?`, `SPACES`, `DECIMAL HEX OCTAL` — each the definition above, with the shared body and tail of the number words as words of their own (`(.BODY)`, `(U.BODY)`, `(D.BODY)`, `(.TAIL)`), since a jump cannot land inside another word. Executed from the prompt on the golden model's host node (2026-10-04), including transcripts of the v3 binary (`tests/test_host_quit.c`). At 64-bit cells a 64-digit binary number is one digit more than the hold buffer's 63 (D-13): 63 digits are printed and the line ends with ` ERROR`. + There is one picture for signed singles, one for unsigned and one for doubles; each plain word is its `.R` word with a width of 0 and the blank flag set, entered by a jump past where `.R` clears that flag, and all six share one tail, which prints the blank only when the flag is set. The width is tested for sign before `width - u`, which could wrap for a very negative diff --git a/v4/capsule/numout.v4 b/v4/capsule/numout.v4 new file mode 100644 index 00000000..a5329832 --- /dev/null +++ b/v4/capsule/numout.v4 @@ -0,0 +1,118 @@ +\ numout.v4 -- printing numbers: pictured output, the . words, and .S +\ +\ DECOMPOSITION.md 5.8: <# # #S HOLD SIGN #> . .R U. U.R D. D.R ? SPACES +\ DECIMAL HEX OCTAL, each the definition given there and executed on the mesh +\ node by test_pictured.c, test_numout.c and test_printing.c; and .S, which +\ D-16 makes possible again. Part of the compiler capsule. Rests on core.v4 +\ and forth.v4. +\ +\ Constants the loader supplies: +\ HEND byte address just past the hold buffer, which is 64 bytes +\ -HFLOOR minus the lowest address HOLD may store at: -(HEND - 62) +\ HLD word address of the variable: where the picture has got to +\ (W) word address of three cells of scratch for this file: +\ (W)+0 the width a number is to be printed in +\ (W)+1 whether a blank follows it (W)+2 .S's count + +macro (-ROT) SWAP push SWAP pop endmacro + +\ ---- unsigned division (section 4) ---- +\ One step a bit, the divisor in A. Exact for uhi < ud. +: UM/MOD ( ulo uhi ud -- urem uquot ) + a! N-1 FOR + -if L0 + 2* over -if L1 drop 1 + jump L2 + L1: drop L2: push 2* pop + jump SUB + L0: + 2* over -if L3 drop 1 + jump L4 + L3: drop L4: push 2* pop + dup a xor -if L5 + drop -if NOSUB jump SUB + L5: drop dup inv a + inv -if L6 + drop jump NOSUB + L6: push drop pop jump SETBIT + SUB: inv a + inv + SETBIT: push 1 + pop + NOSUB: + NEXT + over push push drop pop pop ; + +\ ---- pictured output ---- +header <# +: <# ( -- ) HEND HLD b! !b ; +header HOLD +: HOLD ( c -- ) + dup -256 and if OKC drop jump ERR + OKC: drop HLD b! @b -HFLOOR + -if ROOM drop + ERR: drop NODE-ERROR b! -1 !b ; + ROOM: drop HLD b! @b -1 + dup !b jump C! +header SIGN +: SIGN ( n -- ) -if L1 drop 45 jump HOLD L1: drop ; +header # +: # ( ud1 -- ud2 ) + 0 (BASE) UM/MOD (-ROT) \ qhi lo rem1 + (BASE) UM/MOD (-ROT) \ qlo qhi rem + dup -10 + -if L1 drop 48 + jump L2 L1: drop 55 + L2: jump HOLD +header #S +: #S ( ud -- 0 0 ) L: # over over OR if L1 drop jump L L1: drop ; +header #> +: #> ( ud -- baddr u ) drop drop HLD b! @b HEND over push inv pop + inv ; + +\ ---- spaces and the number base ---- +header SPACES +: SPACES ( n -- ) -if L drop ; L: if DONE SPACE -1 + jump L DONE: drop ; +header DECIMAL +: DECIMAL 10 BASE a! ! ; +header HEX +: HEX 16 BASE a! ! ; +header OCTAL +: OCTAL 8 BASE a! ! ; + +\ ---- numbers ---- +\ One picture for signed singles, one for unsigned, one for doubles. Each +\ plain word is its .R word with a width of 0 and the blank flag set, and all +\ six share one tail, which prints the blank only when the flag is set. + +\ ( baddr u -- ) right-justified in the width, then the blank if wanted +: (.TAIL) + (W) b! @b -if POS drop jump OUT \ width < 0 + POS: over - SPACES \ width - u spaces + OUT: TYPE (W)+1 b! @b if DONE drop jump SPACE + DONE: drop ; +: (.BODY) ( n width -- ) + (W) b! !b dup push -if A inv 1 + A: 0 <# #S pop SIGN #> jump (.TAIL) +: (U.BODY) ( u width -- ) + (W) b! !b 0 <# #S #> jump (.TAIL) +: (D.BODY) ( d width -- ) + (W) b! !b dup push -if A DNEGATE A: <# #S pop SIGN #> jump (.TAIL) + +header .R +: DOT-R ( n width -- ) 0 (W)+1 b! !b jump (.BODY) +header . +: DOT ( n -- ) -1 (W)+1 b! !b 0 jump (.BODY) +header U.R +: U-DOT-R ( u width -- ) 0 (W)+1 b! !b jump (U.BODY) +header U. +: U-DOT ( u -- ) -1 (W)+1 b! !b 0 jump (U.BODY) +header D.R +: D-DOT-R ( d width -- ) 0 (W)+1 b! !b jump (D.BODY) +header D. +: D-DOT ( d -- ) -1 (W)+1 b! !b 0 jump (D.BODY) + +\ ( addr -- ) print what the cell holds +header ? +: QUESTION a! @ jump DOT + +\ ( -- ) as v3: the depth between < and >, then every value on the stack, +\ the deepest first, each followed by a blank; then a new line. The stack is +\ left as it was. It reads each value with PICK, so it needs a few cells of +\ the stack free to work in. +header .S +: DOT-S + 60 EMIT DEPTH 0 U-DOT-R 62 EMIT SPACE + DEPTH (W)+2 b! !b + L: (W)+2 b! @b if DONE + PICK DOT + (W)+2 b! @b -1 + !b jump L + DONE: drop jump CR diff --git a/v4/tests/host_map.h b/v4/tests/host_map.h index 198def0b..a848c086 100644 --- a/v4/tests/host_map.h +++ b/v4/tests/host_map.h @@ -39,6 +39,8 @@ #define CVARS (TOP - 62) /* (C): compile.v4, 10 cells */ #define FVARS (TOP - 105) /* (F): forth.v4, 7 cells */ #define SVARS (TOP - 540 - (v4_cell)V4_DATA_DEPTH) /* (S): where PICK and ROLL set stack values aside, one cell for each cell of the stack */ +#define WVARS (TOP - 99) /* (W): numout.v4, 3 cells */ +#define HLD (TOP - 25) /* where the pictured number has got to */ #define QVARS (TOP - 52) /* (Q): quit.v4, 2 cells */ /* buffers (word addresses; a byte address is four times this) */ @@ -49,6 +51,8 @@ #define TIB_W (TOP - 440) /* the text input buffer: 260 cells = 1040 bytes */ #define PAD_W (TOP - 470) /* PAD: 21 cells = 84 bytes */ #define SBUF_W (TOP - 540) /* 64 cells for the tests' own strings */ +#define HBUF_W (SVARS - 16) /* the hold buffer: 16 cells = 64 bytes */ +#define HEND ((HBUF_W + 16) * 4) #define WBUF (WBUF_W * 4) #define TIB (TIB_W * 4) #define PAD (PAD_W * 4) @@ -107,6 +111,10 @@ static int host_load(v4_text *tx, v4_node *n, const char *const *files, unsigned v4_text_constant(tx, "(Q)", QVARS); v4_text_constant(tx, "(F)", FVARS); v4_text_constant(tx, "(S)", SVARS); + v4_text_constant(tx, "(W)", WVARS); + v4_text_constant(tx, "HLD", HLD); + v4_text_constant(tx, "HEND", HEND); + v4_text_constant(tx, "-HFLOOR", -(HEND - 62)); v4_text_constant(tx, "DSTACK-DEPTH", DSTACK_REG); v4_text_constant(tx, "RSTACK-DEPTH", RSTACK_REG); v4_node_stack_regs_attach(n, DSTACK_REG, RSTACK_REG); diff --git a/v4/tests/test_host_quit.c b/v4/tests/test_host_quit.c index 6f2de5f1..b8550e71 100644 --- a/v4/tests/test_host_quit.c +++ b/v4/tests/test_host_quit.c @@ -167,7 +167,31 @@ static const transcript script[] = { { "5 6 7 1 0 MOD\nDEPTH 48 + EMIT\n", "MOD: Division by zero\n ERROR\nok> 3 ok\nok> ", 1 }, { "5 6 7 1 1 0 */MOD\nDEPTH 48 + EMIT\n", "*/MOD: Division by zero\n ERROR\nok> 3 ok\nok> ", 1 }, { "1 2 3 ABORT\nDEPTH 48 + EMIT\n", " ok\nok> 0 ok\nok> ", 1 }, + { "1 2 3 . . .\n", "3 2 1 ok\nok> ", 1 }, + { "-5 . 0 . 2147483647 .\n", "-5 0 2147483647 ok\nok> ", 1 }, + { "1 2 3 .S\n", "<3> 1 2 3 \n ok\nok> ", 1 }, + { ".S\n", "<0> \n ok\nok> ", 1 }, + { "1 2 3 .S . . .\n", "<3> 1 2 3 \n3 2 1 ok\nok> ", 1 }, + { "7 5 U.R 124 EMIT\n", " 7| ok\nok> ", 0 }, + { "HEX FF . DECIMAL 255 .\n", "FF 255 ok\nok> ", 1 }, + { "255 HEX . DECIMAL\n", "FF ok\nok> ", 1 }, + { "255 OCTAL . DECIMAL\n", "377 ok\nok> ", 1 }, + { "VARIABLE X 42 X ! X ?\n", "42 ok\nok> ", 1 }, + { "3 SPACES 65 EMIT 0 SPACES 66 EMIT -2 SPACES 67 EMIT\n", " ABC ok\nok> ", 1 }, + { "2 BASE ! 5 . DECIMAL\n", "UNKNOWN WORD: '5'\n ERROR\nok> ", 1 }, + { ": T 10 0 DO I . LOOP ; T\n", "0 1 2 3 4 5 6 7 8 9 ok\nok> ", 1 }, + { "DEPTH . 1 2 DEPTH . . .\n", "0 2 2 1 ok\nok> ", 1 }, /* v4's own */ + { "5 3 .R 124 EMIT -5 6 .R 124 EMIT 12345 2 .R 124 EMIT\n", " 5| -5|12345| ok\nok> ", 0 }, + { "1234 0 <# # # #S #> TYPE\n", "1234 ok\nok> ", 0 }, + { "-7 DUP 0< IF NEGATE THEN 0 <# #S ROT SIGN #> TYPE\n", "IF: compile-only\n ERROR\nok> ", 0 }, + { ": SN DUP DUP 0< IF NEGATE THEN 0 <# #S ROT SIGN #> TYPE ; -7 SN 7 SN\n", "-77 ok\nok> ", 0 }, + { "65 0 <# 42 HOLD #S 36 HOLD #> TYPE\n", "$65* ok\nok> ", 0 }, + { "2 BASE ! 101 1010 + . DECIMAL\n", "1111 ok\nok> ", 0 }, + { "5 0 D. -1 -1 D. 7 0 4 D.R 124 EMIT\n", "5 -1 7| ok\nok> ", 0 }, + { "36 BASE ! ZZ DECIMAL . 1295 36 BASE ! . DECIMAL\n", "1295 ZZ ok\nok> ", 0 }, + { ": S5 1 2 3 4 5 .S 2DROP 2DROP DROP .S ; S5\n", "<5> 1 2 3 4 5 \n<0> \n ok\nok> ", 0 }, + { "-1 -2 -3 .S\n", "<3> -1 -2 -3 \n ok\nok> ", 0 }, { "1 2 3 QUIT\nDEPTH 48 + EMIT\n", "\nok> 3 ok\nok> ", 0 }, { "65 EMIT DROP 66 EMIT\n67 EMIT\n", "AStack underflow\n ERROR\nok> C ok\nok> ", 0 }, { "+\n1 +\nDUP\nOVER\n1 OVER\n", "Stack underflow\n ERROR\nok> Stack underflow\n ERROR\nok> Stack underflow\n ERROR\nok> " @@ -222,8 +246,8 @@ int main(void) printf("v4 host prompt tests: V4_CELL_BITS=%d, V4_NODE_WORDS=%u\n", V4_CELL_BITS, (unsigned)V4_NODE_WORDS); { - static const char *const files[] = { "core.v4", "input.v4", "dict.v4", "codegen.v4", "compile.v4", "quit.v4", "forth.v4" }; - CHECK(host_load(&tx, &n, files, 7), "the capsule assembles"); + static const char *const files[] = { "core.v4", "input.v4", "dict.v4", "codegen.v4", "compile.v4", "quit.v4", "forth.v4", "numout.v4" }; + CHECK(host_load(&tx, &n, files, 8), "the capsule assembles"); } CHECK(v4_text_finish(&tx), "everything is defined: %s", v4_text_error(&tx)); CHECK(v4_text_here(&tx) < DICT_W, "code stays below the dictionary space"); @@ -494,6 +518,41 @@ int main(void) CHECK(d >= 3, "the prompt leaves room on the data stack"); } + /* ---- numbers at the ends of the range, which depend on the cell width ---- */ + boot_bare(); +#if V4_CELL_BITS == 32 + CHECK(is(say("-1 U. -2147483648 . 2147483647 .\n"), "4294967295 -2147483648 2147483647 ok\nok> "), "the largest and smallest numbers"); + CHECK(is(say("HEX -1 U. DECIMAL\n"), "FFFFFFFF ok\nok> ") && is(say("2 BASE ! -1 U. DECIMAL\n"), "11111111111111111111111111111111 ok\nok> "), "in hex and in binary"); +#else + CHECK(is(say("-1 U.\n"), "18446744073709551615 ok\nok> "), "the largest number (as v3)"); + CHECK(is(say("-9223372036854775808 . 9223372036854775807 .\n"), "-9223372036854775808 9223372036854775807 ok\nok> "), "the smallest and largest signed"); + CHECK(is(say("HEX -1 U. DECIMAL\n"), "FFFFFFFFFFFFFFFF ok\nok> "), "in hex"); + /* 64 binary digits are one more than the hold buffer's 63 (D-13): the last is dropped and the line is an error */ + CHECK(is(say("2 BASE ! -1 U. DECIMAL\n"), "111111111111111111111111111111111111111111111111111111111111111 ERROR\nok> "), "in binary, 63 of its 64 digits and ERROR"); + CHECK(is(say("9223372036854775807 2 BASE ! U. DECIMAL\n"), "111111111111111111111111111111111111111111111111111111111111111 ok\nok> "), "a 63-digit number prints whole"); +#endif + /* .S works on the stack it is printing, so it needs some of it free */ + { + char line[4 * V4_DATA_DEPTH + 16], want[8 * V4_DATA_DEPTH + 32]; + unsigned k, m, most = 0; + for (k = 1; k < V4_DATA_DEPTH; k++) { + size_t at = 0, wt; + boot_bare(); + for (m = 0; m < k; m++) at += (size_t)snprintf(line + at, sizeof line - at, "7 "); + snprintf(line + at, sizeof line - at, "\n"); + if (strlen(line) > 80 || strcmp(say(line), " ok\nok> ") != 0) break; + wt = (size_t)snprintf(want, sizeof want, "<%u> ", k); + for (m = 0; m < k; m++) wt += (size_t)snprintf(want + wt, sizeof want - wt, "7 "); + snprintf(want + wt, sizeof want - wt, "\n ok\nok> "); + if (strcmp(say(".S\n"), want) != 0) break; + snprintf(want, sizeof want, "%u ok\nok> ", k); + CHECK(is(say("DEPTH .\n"), want), "after .S the %u values are still there", k); + most = k; + } + printf(" .S prints a stack of up to %u values; it needs %u cells free\n", most, (unsigned)V4_DATA_DEPTH - most); + CHECK(most + 8u >= V4_DATA_DEPTH, ".S works with all but eight cells of the stack in use"); + } + /* ---- the fault table: five words, each a jump to its handler ---- */ { static const char *const handler[] = { "(FAULT)", "(D-OVER)", "(D-UNDER)", "(R-OVER)", "(R-UNDER)" };