From 01b5bbb23f500091081c0cbab91422add17a3b4f Mon Sep 17 00:00:00 2001 From: rajames Date: Sun, 4 Oct 2026 08:47:29 -0400 Subject: [PATCH] fix(v4.0.0): .R U.R and D.R print no trailing space FORTH-79's reference .R right-justifies the number in its field and prints nothing after it; v3 printed a space. . U. and D. still print their one space. Co-Authored-By: Claude Opus 5.5 --- docs/v4.0.0/DECOMPOSITION.md | 29 +++++++------ v4/tests/test_numout.c | 84 +++++++++++++++++++++--------------- v4/tests/test_printing.c | 48 +++++++++++++-------- 3 files changed, 96 insertions(+), 65 deletions(-) diff --git a/docs/v4.0.0/DECOMPOSITION.md b/docs/v4.0.0/DECOMPOSITION.md index 05cc53ee..409f9cc1 100644 --- a/docs/v4.0.0/DECOMPOSITION.md +++ b/docs/v4.0.0/DECOMPOSITION.md @@ -465,8 +465,8 @@ All output reaches the console through `EMIT` (DEV). | --- | --- | --- | | `<#` `#` `#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 ( -- 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; `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: 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. | +| `.` `.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` | 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 4 return entries. Clobbers `A` and `B`. | @@ -501,15 +501,18 @@ return stack. `-ROT` is in line (`SWAP push SWAP pop`). ```forth \ number output. ABS is in line: -if A inv 1 + A: : .R ( n width -- ) - (W) b! !b dup push ABS 0 <# #S pop SIGN #> \ baddr u - TAIL: (W) b! @b -if POS drop jump OUT \ width < 0 - POS: over - SPACES \ width - u spaces - OUT: TYPE jump SPACE -: . ( n -- ) 0 jump .R -: U.R ( u width -- ) (W) b! !b 0 <# #S #> jump TAIL -: U. ( u -- ) 0 jump U.R -: D.R ( d width -- ) (W) b! !b dup push -if A DNEGATE A: <# #S pop SIGN #> jump TAIL -: D. ( d -- ) 0 jump D.R + 0 (W) 1 + b! !b \ no blank after it + BODY: (W) b! !b dup push ABS 0 <# #S pop SIGN #> \ baddr u + 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 ; +: . ( n -- ) -1 (W) 1 + b! !b 0 jump BODY \ a blank after it +: U.R ( u width -- ) 0 (W) 1 + b! !b UBODY: (W) b! !b 0 <# #S #> jump TAIL +: U. ( u -- ) -1 (W) 1 + b! !b 0 jump UBODY +: D.R ( d width -- ) 0 (W) 1 + b! !b + DBODY: (W) b! !b dup push -if A DNEGATE A: <# #S pop SIGN #> jump TAIL +: D. ( d -- ) -1 (W) 1 + b! !b 0 jump DBODY ``` ```forth @@ -549,8 +552,8 @@ in the variable `(DP)`, so the stacks carry only what each picture and `TYPE` ne sits on the return stack across a call. 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, entered by a jump, and all six share one tail, which ends in a jump -to `SPACE`. The width is tested for sign before `width - u`, which could wrap for a very negative +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 width and print a flood of spaces. ### 5.9 Strings, parsing, and input diff --git a/v4/tests/test_numout.c b/v4/tests/test_numout.c index 3eacabf1..f6cd0cd9 100644 --- a/v4/tests/test_numout.c +++ b/v4/tests/test_numout.c @@ -8,12 +8,11 @@ * v3 (v3/src/word_source/format_words.c, io_words.c): * . U. the number in the current base, then one space * .R U.R ( n width -- ) the number right-justified in `width` - * columns, then one space; a number wider than the field is - * printed whole; width <= 0 pads nothing + * columns; a number wider than the field is printed whole; + * width <= 0 pads nothing. No space after it: that is the + * FORTH-79 reference word (ruled 2026-10-04); v3 printed one. * D. D.R the same for a double * SPACES ( n -- ) n spaces, none for n <= 0 - * v3's trailing space after the .R words is not FORTH-79 but is what v3 - * prints, so it is kept. * * Where v4 parts from v3, as 5.8 already rules for pictured output: * - a double is ( lo hi ), high cell on top; v3's D. took the low cell on @@ -50,6 +49,7 @@ static int failures = 0, checks = 0; #define HLD ((v4_cell)(V4_NODE_WORDS - 35u)) #define BASE ((v4_cell)(V4_NODE_WORDS - 34u)) #define FIELD ((v4_cell)(V4_NODE_WORDS - 36u)) /* (W): the field width of the .R words */ +#define TRAIL ((v4_cell)(V4_NODE_WORDS - 37u)) /* (W)+1 in the document: whether a blank follows the number */ #define HCAP 63 static v4_node n; @@ -287,7 +287,7 @@ static void build_pictured(void) static void build_output(void) { v4_asm_ref a, b; - v4_cell l, l_tail; + v4_cell l, l_tail, l_rbody, l_ubody, l_dbody; /* : C@ ( baddr -- c ) call-free, 5.3 * dup 2/ 2/ a! 3 and k A: word address @@ -366,16 +366,21 @@ static void build_output(void) HERE_(b); O(DROP); O(SEMI); - /* : .R ( n width -- ) - * (W) b! !b dup push -if A inv 1 + A: 0 <# #S pop SIGN #> baddr u + /* : .R ( n width -- ) FORTH-79: no blank after it + * 0 (W) 1 + b! !b + * BODY: (W) b! !b dup push -if A inv 1 + A: 0 <# #S pop SIGN #> baddr u * TAIL: (W) b! @b -if POS drop jump OUT width < 0 * POS: over - SPACES - * OUT: TYPE jump SPACE + * OUT: TYPE (W) 1 + b! @b if DONE drop jump SPACE + * DONE: drop ; * The width waits in the variable (W), on neither stack, so the picture * runs as deep as it does on its own. A negative width is dropped before - * the subtraction, which could otherwise wrap. U.R and D.R jump to TAIL, - * and SPACE returns to the caller. */ + * the subtraction, which could otherwise wrap. (W)+1 says whether a blank + * follows the number: `.` sets it and enters at BODY with a width of 0; + * `.R` clears it. U.R and D.R jump to TAIL. */ w_dotr = v4_asm_label(&as); + LIT(0); VSET(TRAIL); + l_rbody = v4_asm_label(&as); VSET(FIELD); O(DUP); O(PUSH); a = FWD(MINUS_IF); O(INV); LIT(1); O(ADD); HERE_(a); LIT(0); CALL(w_begin); CALL(w_hashs); O(RPOP); CALL(w_sign); CALL(w_end); @@ -385,30 +390,37 @@ static void build_output(void) HERE_(a); O(OVER); SUB_INLINE(); CALL(w_spaces); HERE_(b); - CALL(w_type); JUMP(w_space); + CALL(w_type); VGET(TRAIL); a = FWD(IF); + O(DROP); JUMP(w_space); + HERE_(a); + O(DROP); O(SEMI); - /* : . ( n -- ) 0 jump .R */ + /* : . ( n -- ) -1 (W) 1 + b! !b 0 jump BODY a blank after it */ w_dot = v4_asm_label(&as); - LIT(0); JUMP(w_dotr); + LIT(-1); VSET(TRAIL); LIT(0); JUMP(l_rbody); - /* : U.R ( u width -- ) (W) b! !b 0 <# #S #> jump TAIL */ + /* : U.R ( u width -- ) 0 (W) 1 + b! !b UBODY: (W) b! !b 0 <# #S #> jump TAIL */ w_udotr = v4_asm_label(&as); + LIT(0); VSET(TRAIL); + l_ubody = v4_asm_label(&as); VSET(FIELD); LIT(0); CALL(w_begin); CALL(w_hashs); CALL(w_end); JUMP(l_tail); - /* : U. ( u -- ) 0 jump U.R */ + /* : U. ( u -- ) -1 (W) 1 + b! !b 0 jump UBODY */ w_udot = v4_asm_label(&as); - LIT(0); JUMP(w_udotr); + LIT(-1); VSET(TRAIL); LIT(0); JUMP(l_ubody); /* : D.R ( d width -- ) - * (W) b! !b dup push -if A DNEGATE A: <# #S pop SIGN #> jump TAIL */ + * 0 (W) 1 + b! !b DBODY: (W) b! !b dup push -if A DNEGATE A: <# #S pop SIGN #> jump TAIL */ w_ddotr = v4_asm_label(&as); + LIT(0); VSET(TRAIL); + l_dbody = v4_asm_label(&as); VSET(FIELD); O(DUP); O(PUSH); a = FWD(MINUS_IF); CALL(w_dnegate); HERE_(a); CALL(w_begin); CALL(w_hashs); O(RPOP); CALL(w_sign); CALL(w_end); JUMP(l_tail); - /* : D. ( d -- ) 0 jump D.R */ + /* : D. ( d -- ) -1 (W) 1 + b! !b 0 jump DBODY */ w_ddot = v4_asm_label(&as); - LIT(0); JUMP(w_ddotr); + LIT(-1); VSET(TRAIL); LIT(0); JUMP(l_dbody); /* ---- the v3 transcripts ---- */ #define DOT(v) do { LIT(v); CALL(w_dot); } while (0) @@ -549,7 +561,7 @@ static void ref_digits(v4_ucell lo, v4_ucell hi, unsigned base, char *out) /* What is printed for the number text `num` in a field of `width`: the last * HCAP characters of it (D-13), padded on the left, then one space. Returns * whether the hold buffer overflowed. */ -static int ref_line(const char *num, v4_cell width, char *out) +static int ref_line(const char *num, v4_cell width, int blank, char *out) { size_t len = strlen(num), pad, i; int over = len > HCAP; @@ -557,8 +569,8 @@ static int ref_line(const char *num, v4_cell width, char *out) pad = (width > 0 && (v4_ucell)width > len) ? (size_t)width - len : 0; for (i = 0; i < pad; i++) out[i] = ' '; memcpy(out + pad, num, len); - out[pad + len] = ' '; - out[pad + len + 1] = 0; + if (blank) out[pad + len++] = ' '; + out[pad + len] = 0; return over; } @@ -600,15 +612,17 @@ int main(void) build_pictured(); build_output(); CHECK(v4_asm_ok(&as), "number-output words assemble"); - CHECK(v4_asm_label(&as) < FIELD, "code stays below the variables"); + CHECK(v4_asm_label(&as) < TRAIL, "code stays below the variables"); printf(" code: %ld of %u words\n", (long)v4_asm_label(&as), (unsigned)V4_NODE_WORDS); /* The v3 transcripts. */ CHECK(call(t_v3a, 10, 0, 0, 0, 0) && printed("5 -5 0 123456789 [42 0 ]"), "v3: . and U."); - CHECK(call(t_v3b, 10, 0, 0, 0, 0) && printed("[ 42 ] -42 ]123456 ]7 ]7 ] 42 ]"), - "v3: .R and U.R"); + /* v3 printed "[ 42 ] -42 ]123456 ]7 ]7 ] 42 ]": a space after each */ + CHECK(call(t_v3b, 10, 0, 0, 0, 0) && printed("[ 42] -42]123456]7]7] 42]"), + ".R and U.R, as v3 but for the space after"); CHECK(call(t_v3c, 10, 0, 0, 0, 0) && printed("FF -FF BEEF 100 -17 ["), "v3: HEX and OCTAL"); - CHECK(call(t_v3d, 10, 0, 0, 0, 0) && printed("[5 -5 0 77 ] -77 ]"), "v3: D. and D.R"); + /* v3 printed "[5 -5 0 77 ] -77 ]" */ + CHECK(call(t_v3d, 10, 0, 0, 0, 0) && printed("[5 -5 0 77] -77]"), "D. as v3; D.R as v3 but for the space after"); CHECK(call(t_v3e, 10, 0, 0, 0, 0) && printed("[ ]]] ]"), "v3: SPACES"); #if V4_CELL_BITS == 64 CHECK(call(t_v3f, 10, 0, 0, 0, 0) @@ -629,12 +643,12 @@ int main(void) /* . and .R */ ref_signed((v4_ucell)v, v < 0 ? MAXU : 0, base, num); - over = ref_line(num, 0, want); + over = ref_line(num, 0, 1, want); CHECK(call(w_dot, bases[bi], 1, v, 0, 0) && printed(want), ". base %ld [%u]: want \"%s\"", (long)bases[bi], i, want); CHECK(v4_node_load(&n, NODE_ERROR) == (over ? -1 : 0), ". NODE-ERROR base %ld [%u]", (long)bases[bi], i); for (wi = 0; wi < NWIDTH; wi++) { - over = ref_line(num, widths[wi], want); + over = ref_line(num, widths[wi], 0, want); CHECK(call(w_dotr, bases[bi], 2, v, widths[wi], 0) && printed(want), ".R base %ld [%u] width %ld: want \"%s\"", (long)bases[bi], i, (long)widths[wi], want); CHECK(v4_node_load(&n, NODE_ERROR) == (over ? -1 : 0), ".R NODE-ERROR"); @@ -642,12 +656,12 @@ int main(void) /* U. and U.R */ ref_digits((v4_ucell)v, 0, base, num); - over = ref_line(num, 0, want); + over = ref_line(num, 0, 1, want); CHECK(call(w_udot, bases[bi], 1, v, 0, 0) && printed(want), "U. base %ld [%u]: want \"%s\"", (long)bases[bi], i, want); CHECK(v4_node_load(&n, NODE_ERROR) == (over ? -1 : 0), "U. NODE-ERROR base %ld [%u]", (long)bases[bi], i); for (wi = 0; wi < NWIDTH; wi++) { - over = ref_line(num, widths[wi], want); + over = ref_line(num, widths[wi], 0, want); CHECK(call(w_udotr, bases[bi], 2, v, widths[wi], 0) && printed(want), "U.R base %ld [%u] width %ld: want \"%s\"", (long)bases[bi], i, (long)widths[wi], want); CHECK(v4_node_load(&n, NODE_ERROR) == (over ? -1 : 0), "U.R NODE-ERROR"); @@ -656,12 +670,12 @@ int main(void) /* D. and D.R */ for (j = 0; j < NVEC; j++) { ref_signed((v4_ucell)vec[i], (v4_ucell)vec[j], base, num); - over = ref_line(num, 0, want); + over = ref_line(num, 0, 1, want); CHECK(call(w_ddot, bases[bi], 2, vec[i], vec[j], 0) && printed(want), "D. base %ld [%u,%u]: want \"%s\"", (long)bases[bi], i, j, want); CHECK(v4_node_load(&n, NODE_ERROR) == (over ? -1 : 0), "D. NODE-ERROR"); for (wi = 0; wi < NWIDTH; wi += 5) { - over = ref_line(num, widths[wi], want); + over = ref_line(num, widths[wi], 0, want); CHECK(call(w_ddotr, bases[bi], 3, vec[i], vec[j], widths[wi]) && printed(want), "D.R base %ld [%u,%u] width %ld: want \"%s\"", (long)bases[bi], i, j, (long)widths[wi], want); @@ -699,14 +713,14 @@ int main(void) CHECK(dh >= 6 && rh >= 6, "SPACES leaves room"); headroom(".", w_dot, 1, -12345, 0, 0, "-12345 ", &dh, &rh); CHECK(dh >= 2 && rh >= 2, ". leaves room"); - headroom(".R", w_dotr, 2, -12345, 9, 0, " -12345 ", &dh, &rh); + headroom(".R", w_dotr, 2, -12345, 9, 0, " -12345", &dh, &rh); CHECK(dh >= 2 && rh >= 2, ".R leaves room"); headroom("U.", w_udot, 1, 12345, 0, 0, "12345 ", &dh, &rh); CHECK(dh >= 3 && rh >= 3, "U. leaves room"); - headroom("U.R", w_udotr, 2, 12345, 9, 0, " 12345 ", &dh, &rh); + headroom("U.R", w_udotr, 2, 12345, 9, 0, " 12345", &dh, &rh); headroom("D.", w_ddot, 2, -12345, -1, 0, "-12345 ", &dh, &rh); CHECK(dh >= 2 && rh >= 2, "D. leaves room"); - headroom("D.R", w_ddotr, 3, -12345, -1, 9, " -12345 ", &dh, &rh); + headroom("D.R", w_ddotr, 3, -12345, -1, 9, " -12345", &dh, &rh); CHECK(dh >= 2 && rh >= 2, "D.R leaves room"); } diff --git a/v4/tests/test_printing.c b/v4/tests/test_printing.c index 372bc318..573d2eb7 100644 --- a/v4/tests/test_printing.c +++ b/v4/tests/test_printing.c @@ -56,6 +56,7 @@ static int failures = 0, checks = 0; #define HLD ((v4_cell)(V4_NODE_WORDS - 35u)) #define BASE ((v4_cell)(V4_NODE_WORDS - 34u)) #define FIELD ((v4_cell)(V4_NODE_WORDS - 36u)) /* (W): the field width of the .R words */ +#define TRAIL ((v4_cell)(V4_NODE_WORDS - 46u)) /* (W)+1 in the document: whether a blank follows the number */ #define HCAP 63 #define QP ((v4_cell)(V4_NODE_WORDS - 40u)) /* (QP): Q.PRINT's BASE, |q| and sign */ #define DP ((v4_cell)(V4_NODE_WORDS - 44u)) /* (DP): DUMP's BASE, address, count, column */ @@ -301,7 +302,7 @@ static void build_pictured(void) static void build_output(void) { v4_asm_ref a, b, c, d, done1, done2; - v4_cell l, l_tail, l_line; + v4_cell l, l_tail, l_rbody, l_ubody, l_dbody, l_line; /* : C@ ( baddr -- c ) call-free, 5.3 * dup 2/ 2/ a! 3 and k A: word address @@ -380,16 +381,21 @@ static void build_output(void) HERE_(b); O(DROP); O(SEMI); - /* : .R ( n width -- ) - * (W) b! !b dup push -if A inv 1 + A: 0 <# #S pop SIGN #> baddr u + /* : .R ( n width -- ) FORTH-79: no blank after it + * 0 (W) 1 + b! !b + * BODY: (W) b! !b dup push -if A inv 1 + A: 0 <# #S pop SIGN #> baddr u * TAIL: (W) b! @b -if POS drop jump OUT width < 0 * POS: over - SPACES - * OUT: TYPE jump SPACE + * OUT: TYPE (W) 1 + b! @b if DONE drop jump SPACE + * DONE: drop ; * The width waits in the variable (W), on neither stack, so the picture * runs as deep as it does on its own. A negative width is dropped before - * the subtraction, which could otherwise wrap. U.R and D.R jump to TAIL, - * and SPACE returns to the caller. */ + * the subtraction, which could otherwise wrap. (W)+1 says whether a blank + * follows the number: `.` sets it and enters at BODY with a width of 0; + * `.R` clears it. U.R and D.R jump to TAIL. */ w_dotr = v4_asm_label(&as); + LIT(0); VSET(TRAIL); + l_rbody = v4_asm_label(&as); VSET(FIELD); O(DUP); O(PUSH); a = FWD(MINUS_IF); O(INV); LIT(1); O(ADD); HERE_(a); LIT(0); CALL(w_begin); CALL(w_hashs); O(RPOP); CALL(w_sign); CALL(w_end); @@ -400,30 +406,37 @@ static void build_output(void) O(OVER); SUB_INLINE(); CALL(w_spaces); HERE_(b); l_out = v4_asm_label(&as); - CALL(w_type); JUMP(w_space); + CALL(w_type); VGET(TRAIL); a = FWD(IF); + O(DROP); JUMP(w_space); + HERE_(a); + O(DROP); O(SEMI); - /* : . ( n -- ) 0 jump .R */ + /* : . ( n -- ) -1 (W) 1 + b! !b 0 jump BODY a blank after it */ w_dot = v4_asm_label(&as); - LIT(0); JUMP(w_dotr); + LIT(-1); VSET(TRAIL); LIT(0); JUMP(l_rbody); - /* : U.R ( u width -- ) (W) b! !b 0 <# #S #> jump TAIL */ + /* : U.R ( u width -- ) 0 (W) 1 + b! !b UBODY: (W) b! !b 0 <# #S #> jump TAIL */ w_udotr = v4_asm_label(&as); + LIT(0); VSET(TRAIL); + l_ubody = v4_asm_label(&as); VSET(FIELD); LIT(0); CALL(w_begin); CALL(w_hashs); CALL(w_end); JUMP(l_tail); - /* : U. ( u -- ) 0 jump U.R */ + /* : U. ( u -- ) -1 (W) 1 + b! !b 0 jump UBODY */ w_udot = v4_asm_label(&as); - LIT(0); JUMP(w_udotr); + LIT(-1); VSET(TRAIL); LIT(0); JUMP(l_ubody); /* : D.R ( d width -- ) - * (W) b! !b dup push -if A DNEGATE A: <# #S pop SIGN #> jump TAIL */ + * 0 (W) 1 + b! !b DBODY: (W) b! !b dup push -if A DNEGATE A: <# #S pop SIGN #> jump TAIL */ w_ddotr = v4_asm_label(&as); + LIT(0); VSET(TRAIL); + l_dbody = v4_asm_label(&as); VSET(FIELD); O(DUP); O(PUSH); a = FWD(MINUS_IF); CALL(w_dnegate); HERE_(a); CALL(w_begin); CALL(w_hashs); O(RPOP); CALL(w_sign); CALL(w_end); JUMP(l_tail); - /* : D. ( d -- ) 0 jump D.R */ + /* : D. ( d -- ) -1 (W) 1 + b! !b 0 jump DBODY */ w_ddot = v4_asm_label(&as); - LIT(0); JUMP(w_ddotr); + LIT(-1); VSET(TRAIL); LIT(0); JUMP(l_dbody); /* ---- the words under test ---- */ /* : CR ( -- ) 10 jump EMIT */ @@ -445,7 +458,7 @@ static void build_output(void) * pop 15 FOR 2/ UNEXT HIMASK and high cell of |q| >> 16 * #S (QP) 3 + b! @b SIGN #> * (QP) b! @b BASE b! !b - * jump OUT TYPE jump SPACE, in .R + * -1 (W) 1 + b! !b jump OUT TYPE and a blank, in .R * frac * 100000 / 65536 is frac * 3125 / 2048, which stays inside a * 32-bit cell; times 3125 is times 5 five times. HIMASK clears the top * 16 bits, making the 2/ shift a logical one. */ @@ -476,6 +489,7 @@ static void build_output(void) LIT((v4_cell)(MAXU >> 16)); O(AND); CALL(w_hashs); VGET(QP + 3); CALL(w_sign); CALL(w_end); VGET(QP); VSET(BASE); + LIT(-1); VSET(TRAIL); JUMP(l_out); /* : (DB) ( -- c ) (DP) 1 + b! @b (DP) 3 + b! @b + jump C@ @@ -793,7 +807,7 @@ int main(void) build_pictured(); build_output(); CHECK(v4_asm_ok(&as), "printing words assemble"); - CHECK(v4_asm_label(&as) < XVAR, "code stays below the variables"); + CHECK(v4_asm_label(&as) < TRAIL, "code stays below the variables"); printf(" code: %ld of %u words\n", (long)v4_asm_label(&as) - CODE0, (unsigned)V4_NODE_WORDS); /* 128 bytes to dump: every kind of byte, with v3's twenty at 0xD0. */