From c02505db69934c1a4244fe214576ce808072ba25 Mon Sep 17 00:00:00 2001 From: rajames Date: Sun, 4 Oct 2026 20:34:13 -0400 Subject: [PATCH] feat(v4.0.0): 48 more words at the prompt (words.v4) capsule/words.v4: the stack, comparison, shift, double, mixed and string words whose definitions DECOMPOSITION.md already gives and the mesh-node tests execute, now in the host node's vocabulary: 2SWAP 2OVER 2ROT 2>R 2R> 2R@ 2@ 2! -! 0<> 0> <> <= >= U< U> ABS MAX MIN WITHIN LSHIFT RSHIFT D- DABS D0= D0< D= D2* D2/ D< DMAX DMIN M+ M- CMOVE> MOVE FILL ERASE BLANK -TRAILING COMPARE SEARCH SCAN SKIP ?TERMINAL TRUE FALSE INVERT NOP - A shift count that is negative or as large as the cell is an error, as in v3 (code 9, "Shift count out of range"). - tests/test_host_quit.c: 36 sessions from the prompt that are transcripts of the v3 binary, and the cases where v4 keeps the standard (MOVE in cells; M+ and M- with the double low cell first). Co-Authored-By: Claude Opus 5.5 --- docs/v4.0.0/DECOMPOSITION.md | 2 + v4/capsule/core.v4 | 1 + v4/capsule/quit.v4 | 3 +- v4/capsule/words.v4 | 201 +++++++++++++++++++++++++++++++++++ v4/tests/host_map.h | 3 + v4/tests/test_host_quit.c | 70 +++++++++++- 6 files changed, 277 insertions(+), 3 deletions(-) create mode 100644 v4/capsule/words.v4 diff --git a/docs/v4.0.0/DECOMPOSITION.md b/docs/v4.0.0/DECOMPOSITION.md index ca70929a..a160e3fb 100644 --- a/docs/v4.0.0/DECOMPOSITION.md +++ b/docs/v4.0.0/DECOMPOSITION.md @@ -757,6 +757,8 @@ call would bury what it works on. A **compile-only** word may not be executed by `v4/capsule/forth.v4` holds the first words of the vocabulary flagged this way (`DUP`, `+`, `>R`, `I`, `LEAVE`, `@`, the in-line variables and so on). +**The vocabulary at the prompt.** The host node's capsule is `v4/capsule/`, loaded in this order: `core.v4` (bytes, console, strings the rest rest on), `input.v4`, `dict.v4`, `codegen.v4`, `compile.v4`, `quit.v4` (the prompt, faults and errors), `forth.v4` (stack, arithmetic, division, `DEPTH` `PICK` `ROLL`), `numout.v4` (number output, `.S`) and `words.v4` (the stack, comparison, shift, double, mixed and string words of §5.1–5.9: `2SWAP 2OVER 2ROT 2>R 2R> 2R@ 2@ 2! -! 0<> 0> <> <= >= U< U> ABS MAX MIN WITHIN LSHIFT RSHIFT D- DABS D0= D0< D= D2* D2/ D< DMAX DMIN M+ M- CMOVE> MOVE FILL ERASE BLANK -TRAILING COMPARE SEARCH SCAN SKIP ?TERMINAL TRUE FALSE INVERT NOP`). Each is the definition this document gives; `tests/test_host_quit.c` runs them from the prompt against transcripts of the v3 binary. As v3, `LSHIFT` and `RSHIFT` with a count that is negative or as large as the cell is wide are an error (D-18, code 9, `Shift count out of range`). `M+`, like `M-` and `M/MOD`, takes its double in the standard order, low cell first; v3 takes it low cell on top. + **The stacks and the compiler.** The interpreter and compiler run on the same stacks as the user's words, with the user's values beneath them. The capsule was written for stacks of ten cells and nine entries (D-2), and is as sparing as that needed; the host node's are now 32 and 32 (D-17). The two diff --git a/v4/capsule/core.v4 b/v4/capsule/core.v4 index 6faeaca5..9953b2eb 100644 --- a/v4/capsule/core.v4 +++ b/v4/capsule/core.v4 @@ -14,6 +14,7 @@ \ 1 Negative count 2 Not a number 3 Number too long \ 4 Not a character 5 Dictionary full 6 Name missing \ 7 Control structure mismatch 8 Control structures too deep +\ 9 Shift count out of range \ -1 the word has printed its own message macro SWAP over push push drop pop pop endmacro diff --git a/v4/capsule/quit.v4 b/v4/capsule/quit.v4 index c88ae116..45cec7df 100644 --- a/v4/capsule/quit.v4 +++ b/v4/capsule/quit.v4 @@ -95,7 +95,7 @@ header ABORT NODE-ERROR b! @b -if POS drop 2 jump (REPL) POS: -1 + if M1 -1 + if M2 -1 + if M3 -1 + if M4 - -1 + if M5 -1 + if M6 -1 + if M7 -1 + if M8 + -1 + if M5 -1 + if M6 -1 + if M7 -1 + if M8 -1 + if M9 drop 2 jump (REPL) M1: drop $6167654E (EMIT4) $65766974 (EMIT4) $756F6320 (EMIT4) $746E (EMIT4) CR 2 jump (REPL) M2: drop $20746F4E (EMIT4) $756E2061 (EMIT4) $7265626D (EMIT4) CR 2 jump (REPL) @@ -105,6 +105,7 @@ header ABORT M6: drop $656D614E (EMIT4) $73696D20 (EMIT4) $676E6973 (EMIT4) CR 2 jump (REPL) M7: drop $746E6F43 (EMIT4) $206C6F72 (EMIT4) $75727473 (EMIT4) $72757463 (EMIT4) $696D2065 (EMIT4) $74616D73 (EMIT4) $6863 (EMIT4) CR 2 jump (REPL) M8: drop $746E6F43 (EMIT4) $206C6F72 (EMIT4) $75727473 (EMIT4) $72757463 (EMIT4) $74207365 (EMIT4) $64206F6F (EMIT4) $706565 (EMIT4) CR 2 jump (REPL) + M9: drop $66696853 (EMIT4) $6F632074 (EMIT4) $20746E75 (EMIT4) $2074756F (EMIT4) $7220666F (EMIT4) $65676E61 (EMIT4) CR 2 jump (REPL) \ The table the loader gives the node: six words, one for each kind of \ fault in the node's order, each a jump. A jump fills its word, so they diff --git a/v4/capsule/words.v4 b/v4/capsule/words.v4 new file mode 100644 index 00000000..717135b3 --- /dev/null +++ b/v4/capsule/words.v4 @@ -0,0 +1,201 @@ +\ words.v4 -- more of the FORTH vocabulary: the stack, comparison, double, +\ mixed, shift and string words that are short runs of opcodes or small loops. +\ +\ Each is the definition DECOMPOSITION.md gives (sections 4, 5.1 - 5.7, 5.9) +\ and the mesh-node tests execute (test_cells.c, test_foundation.c, +\ test_strings.c), here as words of the host node's vocabulary. Rests on +\ core.v4, forth.v4 and numout.v4. +\ +\ Constants the loader supplies: +\ MAX-INT the largest positive number: every bit but the top one +\ (X) word address of four cells of scratch for COMPARE and SEARCH + +\ ---- stack ---- +header 2SWAP +: 2SWAP ( a b c d -- c d a b ) ROT push ROT pop ; +header 2OVER +: 2OVER ( a b c d -- a b c d a b ) push push over over pop pop jump 2SWAP +header 2ROT +: 2ROT ( a b c d e f -- c d e f a b ) push push 2SWAP pop pop jump 2SWAP +header 2>R inline compile-only : 2>R SWAP push push ; +header 2R> inline compile-only : 2R> pop pop SWAP ; +header 2R@ inline compile-only : 2R@ pop pop over over push push SWAP ; +header NOP inline : NOP' nop ; +header TRUE inline : TRUE -1 ; +header FALSE inline : FALSE 0 ; +header INVERT inline : INVERT inv ; + +\ ---- memory ---- +header 2@ +: 2@ ( addr -- lo hi ) a! @+ @ ; +header 2! +: 2! ( lo hi addr -- ) a! SWAP !+ ! ; +header -! +: -! ( n addr -- ) a! NEGATE @ + ! ; + +\ ---- comparison ---- +header 0<> +: 0<> if Z drop -1 ; Z: ; +header 0> +: 0> -if NN drop 0 ; NN: if Z drop -1 ; Z: ; +header <> +: <> xor jump 0<> +header <= +: <= GREATER jump 0= +header >= +: >= LESS jump 0= +header U< +: U< over over xor -if SAME drop NIP jump 0< + SAME: drop - jump 0< +header U> +: U> SWAP jump U< +header ABS +: ABS -if P inv 1 + P: ; +header MAX +: MAX over over LESS if A drop push drop pop ; A: drop drop ; +header MIN +: MIN over over LESS if B drop drop ; B: drop push drop pop ; +header WITHIN +: WITHIN ( n low high -- flag ) push over pop LESS push LESS inv pop and ; + +\ ---- shifts ---- +\ As v3, a count that is negative or as large as the cell is wide is an +\ error (code 9, "Shift count out of range"). +header LSHIFT +: LSHIFT ( x n -- x' ) + -if NN jump BAD + NN: dup N-1 inv + -if BAD2 drop + L: if DONE -1 + push 2* pop jump L + DONE: drop ; + BAD2: drop + BAD: drop drop NODE-ERROR b! 9 !b ; +header RSHIFT +: RSHIFT ( x n -- x' ) \ zeros come in at the top + -if NN jump BAD + NN: dup N-1 inv + -if BAD2 drop + L: if DONE -1 + push 2/ MAX-INT and pop jump L + DONE: drop ; + BAD2: drop + BAD: drop drop NODE-ERROR b! 9 !b ; + +\ ---- doubles and mixed ---- +header D- +: D- DNEGATE jump D+ +header DABS +: DABS -if P jump DNEGATE P: ; +header D0= +: D0= OR jump 0= +header D0< +: D0< push drop pop jump 0< +header D= +: D= D- jump D0= +header D2* +: D2* 2* over -if P drop 1 + jump J P: drop J: push 2* pop ; +header D2/ +: D2/ push a! 0 pop +* push drop a pop ; +header M+ +: M+ S>D jump D+ +header M- +: M- S>D DNEGATE jump D+ + +\ ( d1 d2 -- d1 d2 flag ) the flag's top bit is set exactly when d1 < d2 +: (D<) + dup push push over pop over over xor if TIE + drop over over xor -if HS drop drop jump S1 + HS: drop push inv pop + inv + S1: -if N1 drop -1 jump D1 N1: drop 0 + D1: pop SWAP ; + TIE: drop drop drop dup push push over pop + over over xor -if LS drop NIP jump S2 + LS: drop push inv pop + inv + S2: -if N2 drop -1 jump D2 N2: drop 0 + D2: pop pop ROT ; +header D< +: D< (D<) push drop drop drop drop pop ; +header DMAX +: DMAX (D<) if L drop push push drop drop pop pop ; L: drop drop drop ; +header DMIN +: DMIN (D<) if L drop drop drop ; L: drop push push drop drop pop pop ; + +\ ---- strings and memory ---- +header ?TERMINAL +: ?TERMINAL ( -- flag ) CONSOLE-STATUS b! @b ; + +header CMOVE> +: CMOVE> ( src dst u -- ) + -if OK drop drop drop NODE-ERROR b! 1 !b ; + OK: if DONE -1 + push + over pop dup push + C@ + over pop dup push + C! + pop jump OK + DONE: drop drop drop ; + +\ FORTH-79: n cells from addr1 to addr2, the cell at addr1 first. +header MOVE +: MOVE ( addr1 addr2 n -- ) + -if OK drop drop drop ; + OK: if DONE push over a! @ over a! ! 1 + push 1 + pop pop -1 + jump OK + DONE: drop drop drop ; + +header FILL +: FILL ( baddr u c -- ) + SWAP push SWAP pop \ c baddr u + -if OK drop drop drop NODE-ERROR b! 1 !b ; + OK: if DONE push over over C! 1 + pop -1 + jump OK + DONE: drop drop drop ; +header ERASE +: ERASE ( baddr u -- ) 0 jump FILL +header BLANK +: BLANK ( baddr u -- ) 32 jump FILL + +header -TRAILING +: -TRAILING ( baddr u -- baddr u' ) + -if L drop 0 ; + L: if DONE over over + -1 + C@ -32 + if SP drop ; + SP: drop -1 + jump L + DONE: ; + +header COMPARE +: COMPARE ( a1 u1 a2 u2 -- n ) + -if A drop 0 A: (X)+1 b! !b + SWAP -if B drop 0 B: dup (X) b! !b + (X)+1 b! @b + over over - -if GE drop drop jump M + GE: drop push drop pop + M: + L: if EQ push + over C@ over C@ - if SAME + -if GT drop drop drop pop drop -1 ; + GT: drop drop drop pop drop 1 ; + SAME: drop 1 + push 1 + pop pop -1 + jump L + EQ: drop drop drop (X) b! @b (X)+1 b! @b - + -if NN drop -1 ; + NN: if ZZ drop 1 ; + ZZ: ; + +header SEARCH +: SEARCH ( a1 u1 a2 u2 -- a3 u3 flag ) + -if A drop 0 A: (X)+1 b! !b (X) b! !b + -if B drop 0 B: dup (X)+3 b! !b over (X)+2 b! !b + L: dup (X)+1 b! @b - -if TRY + drop drop drop (X)+2 b! @b (X)+3 b! @b 0 ; + TRY: drop over (X) b! @b (X)+1 b! @b + I: if MATCH push + over C@ over C@ xor if SAME + drop drop drop pop drop push 1 + pop -1 + jump L + SAME: drop 1 + push 1 + pop pop -1 + jump I + MATCH: drop drop drop -1 ; + +header SCAN +: SCAN ( baddr u c -- baddr' u' ) + 255 and push -if L drop 0 + L: if DONE over C@ pop dup push xor if FOUND + drop push 1 + pop -1 + jump L + FOUND: drop + DONE: pop drop ; +header SKIP +: SKIP ( baddr u c -- baddr' u' ) + 255 and push -if L drop 0 + L: if DONE over C@ pop dup push xor if SAME drop jump DONE + SAME: drop push 1 + pop -1 + jump L + DONE: pop drop ; diff --git a/v4/tests/host_map.h b/v4/tests/host_map.h index a848c086..05c27395 100644 --- a/v4/tests/host_map.h +++ b/v4/tests/host_map.h @@ -53,6 +53,7 @@ #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 XVARS (HBUF_W - 4) /* (X): words.v4, 4 cells */ #define WBUF (WBUF_W * 4) #define TIB (TIB_W * 4) #define PAD (PAD_W * 4) @@ -112,6 +113,8 @@ static int host_load(v4_text *tx, v4_node *n, const char *const *files, unsigned v4_text_constant(tx, "(F)", FVARS); v4_text_constant(tx, "(S)", SVARS); v4_text_constant(tx, "(W)", WVARS); + v4_text_constant(tx, "(X)", XVARS); + v4_text_constant(tx, "MAX-INT", (v4_cell)(V4_MSB - 1u)); v4_text_constant(tx, "HLD", HLD); v4_text_constant(tx, "HEND", HEND); v4_text_constant(tx, "-HFLOOR", -(HEND - 62)); diff --git a/v4/tests/test_host_quit.c b/v4/tests/test_host_quit.c index b409bf8e..74f7adf3 100644 --- a/v4/tests/test_host_quit.c +++ b/v4/tests/test_host_quit.c @@ -184,6 +184,55 @@ static const transcript script[] = { { "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 }, + /* words.v4 */ + { "1 2 3 4 2SWAP . . . .\n", "2 1 4 3 ok\nok> ", 1 }, + { "1 2 3 4 2OVER . . . . . .\n", "2 1 4 3 2 1 ok\nok> ", 1 }, + { "1 2 3 4 5 6 2ROT . . . . . .\n", "2 1 6 5 4 3 ok\nok> ", 1 }, + { ": T 1 2 2>R 2R@ 2R> . . . . ; T\n", "2 1 2 1 ok\nok> ", 1 }, + { "TRUE . FALSE . 5 INVERT . NOP\n", "-1 0 -6 ok\nok> ", 1 }, + { "VARIABLE X 0 , 11 22 X 2! X 2@ . . X @ .\n", "22 11 11 ok\nok> ", 1 }, + { "VARIABLE Y 10 Y ! 3 Y -! Y @ .\n", "7 ok\nok> ", 1 }, + { "0 0<> . 5 0<> . -5 0<> .\n", "0 -1 -1 ok\nok> ", 1 }, + { "0 0> . 5 0> . -5 0> .\n", "0 -1 0 ok\nok> ", 1 }, + { "1 2 <> . 2 2 <> .\n", "-1 0 ok\nok> ", 1 }, + { "1 2 <= . 2 2 <= . 3 2 <= .\n", "-1 -1 0 ok\nok> ", 1 }, + { "1 2 >= . 2 2 >= . 3 2 >= .\n", "0 -1 -1 ok\nok> ", 1 }, + { "1 2 U< . 2 1 U< . -1 1 U< . 1 -1 U< . 3 3 U< .\n", "-1 0 0 -1 0 ok\nok> ", 1 }, + { "1 2 U> . -1 1 U> . 1 -1 U> .\n", "0 -1 0 ok\nok> ", 1 }, + { "-5 ABS . 5 ABS . 0 ABS .\n", "5 5 0 ok\nok> ", 1 }, + { "3 9 MAX . -3 -9 MAX . 3 9 MIN . -3 -9 MIN .\n", "9 -3 3 -9 ok\nok> ", 1 }, + { "5 0 9 WITHIN . 9 0 9 WITHIN . 0 0 9 WITHIN . 5 9 0 WITHIN . -1 0 9 WITHIN .\n", "-1 0 -1 0 0 ok\nok> ", 1 }, + { "1 4 LSHIFT . 3 0 LSHIFT . 256 4 RSHIFT . 1 1 RSHIFT .\n", "16 3 16 0 ok\nok> ", 1 }, + { "5 0 3 0 D- . . 3 0 5 0 D- . .\n", "0 2 -1 -2 ok\nok> ", 1 }, + { "-5 -1 DABS . . 5 0 DABS . .\n", "0 5 0 5 ok\nok> ", 1 }, + { "0 0 D0= . 1 0 D0= . 0 1 D0= .\n", "-1 0 0 ok\nok> ", 1 }, + { "-1 -1 D0< . 5 0 D0< .\n", "-1 0 ok\nok> ", 1 }, + { "5 0 5 0 D= . 5 0 6 0 D= . 5 0 5 1 D= .\n", "-1 0 0 ok\nok> ", 1 }, + { "3 0 D2* . . -1 0 D2* . .\n", "0 6 1 -2 ok\nok> ", 1 }, + { "6 0 D2/ . . -6 -1 D2/ . .\n", "0 3 -1 -3 ok\nok> ", 1 }, + { "1 0 2 0 D< . 2 0 1 0 D< . -1 -1 0 0 D< . 5 0 5 0 D< .\n", "-1 0 -1 0 ok\nok> ", 1 }, + { "1 0 2 0 DMAX . . 1 0 2 0 DMIN . . -1 -1 3 0 DMAX . . -1 -1 3 0 DMIN . .\n", "0 2 0 1 0 3 -1 -1 ok\nok> ", 1 }, + { "PAD 8 65 FILL PAD 4 + C@ . PAD 7 + C@ .\n", "65 65 ok\nok> ", 1 }, + { "PAD 8 65 FILL PAD 4 ERASE PAD C@ . PAD 4 + C@ .\n", "0 65 ok\nok> ", 1 }, + { "PAD 8 65 FILL PAD 2 + 3 BLANK PAD 8 TYPE 124 EMIT\n", "AA AAA| ok\nok> ", 1 }, + { "PAD 16 32 FILL 97 PAD C! 98 PAD 1+ C! 99 PAD 2+ C!\nPAD 16 -TRAILING . PAD - .\n", " ok\nok> 3 0 ok\nok> ", 1 }, + { "PAD 16 32 FILL 97 PAD C! 98 PAD 1+ C! 99 PAD 2+ C!\nPAD 3 PAD 3 COMPARE . PAD 3 PAD 2 COMPARE . PAD 2 PAD 3 COMPARE .\nPAD 3 PAD 1+ 2 COMPARE .\n", " ok\nok> 0 1 -1 ok\nok> -1 ok\nok> ", 1 }, + { "PAD 16 32 FILL 97 PAD C! 98 PAD 1+ C! 99 PAD 2+ C!\nPAD 16 98 SCAN . PAD - . PAD 16 97 SKIP . PAD - . PAD 16 122 SCAN . PAD - .\n", " ok\nok> 15 1 15 1 0 16 ok\nok> ", 1 }, + { "PAD 16 32 FILL 97 PAD C! 98 PAD 1+ C! 99 PAD 2+ C!\nPAD 16 PAD 1+ 2 SEARCH . . PAD - .\n122 PAD 20 + C! PAD 16 PAD 20 + 1 SEARCH . . PAD - .\n", " ok\nok> -1 15 1 ok\nok> 0 16 0 ok\nok> ", 1 }, + { "PAD 16 32 FILL 97 PAD C! 98 PAD 1+ C! 99 PAD 2+ C!\nPAD PAD 1+ 3 CMOVE> PAD 4 TYPE 124 EMIT\n", " ok\nok> aabc| ok\nok> ", 1 }, + { "PAD 0 65 FILL PAD 0 -TRAILING . DROP PAD 0 PAD 0 COMPARE .\n", "0 0 ok\nok> ", 1 }, + /* v4's own: FORTH-79's MOVE and the standard order for M- (v3's differ), and the errors */ + { "VARIABLE A 1 , 2 , VARIABLE B 0 , 0 , 5 A ! A B 3 MOVE B @ . B 1+ @ . B 2+ @ .\n", "5 1 2 ok\nok> ", 0 }, + { "VARIABLE A 7 A ! A A 0 MOVE A A -3 MOVE A @ .\n", "7 ok\nok> ", 0 }, + { "5 0 3 M- . . 5 0 -7 M- . . 0 0 1 M- . .\n", "0 2 0 12 -1 -1 ok\nok> ", 0 }, + { "5 0 3 M+ . . 5 0 -7 M+ . .\n", "0 8 -1 -2 ok\nok> ", 0 }, + { "0 -1 D0< . -1 0 D0< .\n", "-1 0 ok\nok> ", 0 }, + { "?TERMINAL . 65 EMIT\n?TERMINAL .\n", "-1 A ok\nok> 0 ok\nok> ", 0 }, + { "7 1 -1 LSHIFT 65 EMIT\n.S\n", "Shift count out of range\n ERROR\nok> <1> 7 \n ok\nok> ", 0 }, + { "7 1 -1 RSHIFT 65 EMIT\n.S\n", "Shift count out of range\n ERROR\nok> <1> 7 \n ok\nok> ", 0 }, + { "7 PAD -1 65 FILL 66 EMIT\n.S\n", "Negative count\n ERROR\nok> <1> 7 \n ok\nok> ", 0 }, + { "7 PAD PAD -1 CMOVE> 66 EMIT\n.S\n", "Negative count\n ERROR\nok> <1> 7 \n ok\nok> ", 0 }, + { "PAD 4 65 FILL PAD -5 -TRAILING . DROP PAD -1 PAD -1 COMPARE .\nPAD -3 65 SCAN . DROP\n", "0 0 ok\nok> 0 ok\nok> ", 0 }, /* 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 }, @@ -263,8 +312,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", "numout.v4" }; - CHECK(host_load(&tx, &n, files, 8), "the capsule assembles"); + static const char *const files[] = { "core.v4", "input.v4", "dict.v4", "codegen.v4", "compile.v4", "quit.v4", "forth.v4", "numout.v4", "words.v4" }; + CHECK(host_load(&tx, &n, files, 9), "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"); @@ -549,6 +598,23 @@ int main(void) CHECK(is(say("DECIMAL\n"), " ok\nok> "), "(back to decimal)"); CHECK(is(say("9223372036854775807 2 BASE ! U. DECIMAL\n"), "111111111111111111111111111111111111111111111111111111111111111 ok\nok> "), "a 63-digit number prints whole"); #endif + /* the shifts, to the last bit */ + { + char line[96], want[64]; + boot_bare(); + snprintf(line, sizeof line, "1 %d LSHIFT .\n", V4_CELL_BITS); + CHECK(is(say(line), "Shift count out of range\n ERROR\nok> "), "a shift by the cell's width is out of range"); + snprintf(line, sizeof line, "1 %d LSHIFT 0< . -1 %d RSHIFT . -8 1 RSHIFT 2* 8 + .\n", V4_CELL_BITS - 1, V4_CELL_BITS - 1); + CHECK(is(say(line), "-1 1 0 ok\nok> "), "a shift by one less reaches the top bit, and RSHIFT brings zeros in"); + snprintf(line, sizeof line, "-1 1 RSHIFT .\n"); +#if V4_CELL_BITS == 32 + snprintf(want, sizeof want, "2147483647 ok\nok> "); +#else + snprintf(want, sizeof want, "9223372036854775807 ok\nok> "); +#endif + CHECK(is(say(line), want), "-1 1 RSHIFT is the largest positive number"); + } + /* .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];