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 <noreply@anthropic.com>
This commit is contained in:
rajames
co-authored by
Claude Opus 5.5
Claude Opus 5.5
parent
dc7e37ba5c
commit
c02505db69
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
+2
-1
@@ -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
|
||||
|
||||
@@ -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 ;
|
||||
@@ -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));
|
||||
|
||||
@@ -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];
|
||||
|
||||
Reference in New Issue
Block a user