admin/LithosAnanake
1
1
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

feat(v4.0.0): the editor, redone in FORTH; COLD WARM PAGE VERSION DEFER

Browse Source 
- capsule/editor.fth: the block editor as FORTH source, which the node
  compiles itself.  It is a vocabulary, EDITOR, used at the ordinary
  prompt: n EDIT, then L N B T P E D S H R I WIPE DONE.  v3's EDIT, a
  shell of its own, is not carried over (ruled 2026-10-05); v3's L S and
  SHOW are kept in FORTH as they were, with COPY.
- system.v4: COLD (the system as the loader left it), WARM, PAGE,
  VERSION, 79-STANDARD (FORTH-79: silent), and DEFER IS DEFER@ as v3.
- input.v4: where words are split at blanks a zero byte reads as a blank,
  so a block never written, or filled a line at a time, loads cleanly.
- tests/test_host_quit.c: the editor's source fed to the prompt line by
  line, every command on empty and full screens, what reaches storage;
  the system words; deferred words.

Co-Authored-By: Claude Opus 5.5 <noreply@anthropic.com>
This commit is contained in:
rajames
2026-10-05 10:25:20 -04:00
co-authored by Claude Opus 5.5
parent c8dc14897c
commit a1afb44598
8 changed files with 298 additions and 9 deletions
Download Patch File Download Diff File Expand all files Collapse all files
v4/capsule/core.v4
+1
View File
@@ -17,6 +17,7 @@
\ 9 Shift count out of range 10 Protected word
\ 11 Division by zero (Q./) 12 Argument out of range
\ 13 Block out of range 14 No block is being loaded
\ 15 Deferred word not set
\ -1 the word has printed its own message
macro SWAP over push push drop pop pop endmacro
v4/capsule/editor.fth
+68
View File
@@ -0,0 +1,68 @@
\ editor.fth -- the block editor, in FORTH.
\
\ This file is FORTH source: the node compiles it itself, a line at a time,
\ as if it were typed. No line is longer than 79 characters.
\
\ A block is a screen of 16 lines of 64 characters. SCR is the screen being
\ edited. The editor is a vocabulary, EDITOR: its words are ordinary FORTH
\ words used at the ordinary prompt, so everything else is there as well.
\
\ n EDIT edit screen n: list it and make EDITOR the CONTEXT vocabulary
\ L list the screen N B the next, the one before
\ n T type line n
\ n P text put the rest of the input line on line n
\ n E erase line n WIPE blank the whole screen
\ n D delete line n; the lines below move up; it is held in PAD
\ n S spread: a blank line at n; the lines from n move down
\ n H hold line n in PAD n R replace line n from PAD
\ n I insert PAD's line at n
\ DONE write what has changed and go back to FORTH
\ a b COPY copy screen a to screen b (in FORTH)
\
\ Every change is UPDATEd; nothing reaches storage until FLUSH or DONE, or
\ until the buffer is wanted for another block.
FORTH DEFINITIONS
\ ( baddr -- ) 64 characters; a zero shows as a blank, others as a dot
: (.LINE)
64 0 DO DUP I + C@
DUP 0= IF DROP 32 THEN DUP 32 < OVER 126 > OR IF DROP 46 THEN EMIT
LOOP DROP ;
\ ( n -- baddr ) where line n of screen SCR is
: (LINE)
DUP 0< OVER 15 > OR ABORT" Line out of range" 64 * SCR @ BLOCK + ;
\ v3's three: a line shown, a line set from a string, the screen shown
: L ( n -- ) (LINE) (.LINE) CR ;
: S ( baddr u n -- )
(LINE) DUP 64 BLANK SWAP 0 MAX 64 MIN CMOVE UPDATE ;
: SHOW ( -- )
." Screen " SCR @ 0 .R ." :" CR
16 0 DO I 2 .R ." : " I (LINE) (.LINE) CR LOOP ;
: COPY ( from to -- ) SWAP BLOCK SWAP BUFFER 1024 CMOVE UPDATE ;
VOCABULARY EDITOR EDITOR DEFINITIONS
: T ( n -- ) DUP (LINE) SWAP 2 .R ." : " (.LINE) CR ;
: L ( -- ) SHOW ;
: E ( n -- ) (LINE) 64 BLANK UPDATE ;
: P ( n -- ) (LINE) DUP 64 BLANK 0 WORD COUNT 64 MIN ROT SWAP CMOVE UPDATE ;
: H ( n -- ) (LINE) PAD 64 CMOVE ;
: R ( n -- ) PAD SWAP (LINE) 64 CMOVE UPDATE ;
: D ( n -- )
DUP H DUP 15 < IF
DUP 1+ (LINE) OVER (LINE) ROT 15 SWAP - 64 * CMOVE
ELSE DROP THEN 15 E ;
: S ( n -- )
DUP 15 < IF DUP (LINE) OVER 1+ (LINE) 3 PICK 15 SWAP - 64 * CMOVE> THEN E ;
: I ( n -- ) DUP S R ;
: WIPE ( -- ) SCR @ BLOCK 1024 BLANK UPDATE ;
: N ( -- ) 1 SCR +! L ;
: B ( -- ) -1 SCR +! L ;
: DONE ( -- ) FLUSH [COMPILE] FORTH ;
FORTH DEFINITIONS
: EDIT ( n -- ) DUP BLOCK DROP SCR ! EDITOR [ EDITOR ] L [ FORTH ] ;
v4/capsule/input.v4
+9 -1
View File
@@ -71,9 +71,17 @@ header QUERY
\ (CONVERT and NUMBER use (P)+2 .. (P)+5; they and WORD never run inside
\ each other.)
\ ( -- c ) the character WORD is at. A zero reads as a blank when words
\ are being split at blanks: a block that has never been written is all
\ zeros, and so is the end of one whose lines were put there one at a time.
: (SRC@)
(P)+6 a! @ (SRC) a! @ + C@ if Z ;
Z: drop (P) a! @ -32 + if B drop 0 ;
B: drop 32 ;
\ In line, not called: WORD may have only a few return entries to spare.
macro (LEFT) (P)+6 a! @ (P)+1 a! @ - endmacro \ ( -- d ) d < 0 while inside the text
macro (CH) (P)+6 a! @ (SRC) a! @ + C@ (P) a! @ xor endmacro \ ( -- x ) x = 0 at a delimiter
macro (CH) (SRC@) (P) a! @ xor endmacro \ ( -- x ) x = 0 at a delimiter
macro (STEP) (P)+6 a! @ 1 + ! endmacro
\ ( c -- baddr ) FORTH-79: characters are taken from TIB until the
v4/capsule/quit.v4
+2
View File
@@ -99,6 +99,7 @@ header ABORT
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 M9
-1 + if M10 -1 + if M11 -1 + if M12 -1 + if M13 -1 + if M14
-1 + if M15
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)
@@ -114,6 +115,7 @@ header ABORT
M12: drop $75677241 (EMIT4) $746E656D (EMIT4) $74756F20 (EMIT4) $20666F20 (EMIT4) $676E6172 (EMIT4) $65 (EMIT4) CR 2 jump (REPL)
M13: drop $636F6C42 (EMIT4) $756F206B (EMIT4) $666F2074 (EMIT4) $6E617220 (EMIT4) $6567 (EMIT4) CR 2 jump (REPL)
M14: drop $62206F4E (EMIT4) $6B636F6C (EMIT4) $20736920 (EMIT4) $6E696562 (EMIT4) $6F6C2067 (EMIT4) $64656461 (EMIT4) CR 2 jump (REPL)
M15: drop $65666544 (EMIT4) $64657272 (EMIT4) $726F7720 (EMIT4) $6F6E2064 (EMIT4) $65732074 (EMIT4) $74 (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
v4/capsule/system.v4
+62
View File
@@ -7,6 +7,7 @@
\ FENCE word address of the variable: FORGET will not remove an entry
\ that starts below the address it holds
\ VOC-LINK word address of the variable: the newest vocabulary, or 0
\ (BOOT) word address of two cells: DP and (LATEST) as the loader left them
header FENCE inline : FENCE' FENCE ;
@@ -104,3 +105,64 @@ header FORGET
C2: CURRENT a! @ (Q) a! @ inv + 1 + -if C3 drop ;
C3: drop (LATEST) CURRENT a! ! ;
MISSING: drop (UNKNOWN) drop ;
\ ---- the system as a whole -------------------------------------------------------
\ (BOOT) is two cells the loader fills when the capsule is in place: DP and
\ the newest FORTH entry as they then are. COLD goes back to them.
\ FORTH-79: execute to be sure a FORTH-79 system is there. It is: nothing
\ happens. (v3's prints two lines and leaves a flag.)
header 79-STANDARD
: 79-STANDARD ;
\ ( -- ) which system this is, and its cell width
header VERSION
: VERSION
$72617453 (EMIT4) $74726F46 (EMIT4) $34762068 (EMIT4) $302E302E (EMIT4) $38314620 (EMIT4) $20 (EMIT4)
N-1 1 + 0 U-DOT-R $7469622D (EMIT4) CR ;
\ ( -- ) clear the screen and put the cursor at the top, as v3: ESC [2J ESC [H
header PAGE
: PAGE 27 EMIT 91 EMIT 50 EMIT 74 EMIT 27 EMIT 91 EMIT 72 jump EMIT
\ ( -- ) as v3's message, and then ABORT: both stacks emptied, the prompt
header WARM
: WARM
$54524F46 (EMIT4) $39372D48 (EMIT4) $72615720 (EMIT4) $7453206D (EMIT4) $747261 (EMIT4) CR
$74737953 (EMIT4) $72206D65 (EMIT4) $61747365 (EMIT4) $64657472 (EMIT4) $2E (EMIT4) CR
jump ABORT
\ ( -- ) the system as it was when the capsule had just been loaded:
\ everything defined since is gone, there is one vocabulary, numbers are
\ decimal, the block buffers are empty. Then as WARM.
header COLD
: COLD
(BOOT) a! @ DP a! !
(BOOT)+1 a! @ (LATEST) a! !
(BOOT) a! @ 2/ 2/ FENCE a! !
(LATEST) CONTEXT a! ! (LATEST) CURRENT a! ! 0 VOC-LINK a! !
10 BASE a! ! 0 SCR a! ! EMPTY-BUFFERS
$54524F46 (EMIT4) $39372D48 (EMIT4) $6C6F4320 (EMIT4) $74532064 (EMIT4) $747261 (EMIT4) CR
$74737953 (EMIT4) $69206D65 (EMIT4) $6974696E (EMIT4) $7A696C61 (EMIT4) $2E6465 (EMIT4) CR
jump ABORT
\ ---- deferred words (as v3) -------------------------------------------------------
\ DEFER xxx makes xxx, which does whatever word it has been given:
\ ' yyy IS xxx gives it one; DEFER@ xxx leaves the one it has. A deferred
\ word with none is an error (code 15, "Deferred word not set").
: (DODEFER)
pop a! @ if UNSET push ; \ go to it: it returns to xxx's caller
UNSET: drop NODE-ERROR b! 15 !b ;
header DEFER
: DEFER &(DODEFER) (C)+3 a! ! (DATA) (C)+8 a! @ if NONE drop 0 jump , NONE: drop ;
: (is!) a! ! ;
: (defer@) a! @ ;
header IS immediate
: IS
(') STATE a! @ if NOW drop (LIT,) &(is!) jump (CALL,)
NOW: drop jump (is!)
header DEFER@ immediate
: DEFER@
(') STATE a! @ if NOW drop (LIT,) &(defer@) jump (CALL,)
NOW: drop jump (defer@)
v4/tests/host_map.h
+2
View File
@@ -64,6 +64,7 @@
#define SRC (BVARS + 8)
#define SRC_HOOK (BVARS + 9)
#define STORAGE_REG (BVARS + 10)
#define BOOT_CELLS (BVARS + 14) /* (BOOT): DP and LATEST as the loader left them, 2 cells */
#define BUF0_W (BVARS - 2 * 256) /* the two block buffers, 256 cells each */
#define BUF1_W (BUF0_W + 256)
#define QVARS (BUF0_W - 4) /* (Q): quit.v4, system.v4 and blocks.v4, 4 cells */
@@ -128,6 +129,7 @@ static int host_load(v4_text *tx, v4_node *n, const char *const *files, unsigned
v4_text_constant(tx, "(W)", WVARS);
v4_text_constant(tx, "(X)", XVARS);
v4_text_constant(tx, "(B)", BVARS);
v4_text_constant(tx, "(BOOT)", BOOT_CELLS);
v4_text_constant(tx, "SCR", SCR);
v4_text_constant(tx, "BLK", BLK);
v4_text_constant(tx, "(SRC)", SRC);
v4/tests/test_host_quit.c
+146
View File
@@ -98,6 +98,8 @@ static void boot_with(unsigned depth)
n.mem[CFP] = CFS_W;
n.mem[BASE] = 10;
n.mem[NODE_ERROR] = 0;
n.mem[BOOT_CELLS] = n.mem[DP];
n.mem[BOOT_CELLS + 1] = capsule_latest;
n.mem[FENCE] = DICT_W;
n.mem[CONTEXT] = LATEST;
n.mem[CURRENT] = LATEST;
@@ -148,6 +150,36 @@ static const char *say(const char *input)
out[n.console_len] = 0;
return out;
}
/* Feed a file of FORTH source to the prompt, a line at a time, as if typed.
* True if every line was accepted: the node said " ok" and nothing else. */
static int load_source(const char *name)
{
char path[512], line[160];
FILE *f;
unsigned num = 0;
snprintf(path, sizeof path, "%s/%s", V4_CAPSULE_DIR, name);
f = fopen(path, "r");
if (!f) { printf(" cannot open %s\n", path); return 0; }
while (fgets(line, sizeof line, f)) {
size_t len = strlen(line);
num++;
if (len == 0 || line[len - 1] != '\n' || len > 80) { printf(" %s line %u: too long\n", name, num); fclose(f); return 0; }
if (strcmp(say(line), " ok\nok> ") != 0) { printf(" %s line %u: %s", name, num, line); printf(" -> "); fputs(out, stdout); printf("\n"); fclose(f); return 0; }
}
fclose(f);
return n.mem[STATE] == 0;
}
/* What the editor's L prints for a screen of blanks. */
static const char *blank_screen(int num)
{
static char text[2048];
size_t at = (size_t)snprintf(text, sizeof text, "Screen %d:\n", num);
for (unsigned k = 0; k < 16; k++) at += (size_t)snprintf(text + at, sizeof text - at, "%2u: %-64s\n", k, "");
snprintf(text + at, sizeof text - at, " ok\nok> ");
return text;
}
static void show(const char *label, const char *s)
{
printf(" %s\"", label);
@@ -932,6 +964,120 @@ int main(void)
CHECK(strncmp(say("50 LIST\n"), "\nBlock 50\n00: \n01: ", 81) == 0 && n.mem[SCR] == 50,
"a block of zeros lists as blanks, and SCR is the block listed");
/* ---- the editor: FORTH source, compiled by the node ---- */
boot_bare();
CHECK(load_source("editor.fth"), "editor.fth compiles, every line of it");
CHECK(is(say("ORDER .S\n"), "Search order: FORTH \nCurrent: FORTH\n<0> \n ok\nok> "), "and leaves FORTH as it found it");
{
char want[2048], blank[65];
size_t at;
unsigned k;
memset(blank, ' ', 64); blank[64] = 0;
#define SCREEN(num, ...) do { static const char *const t_[] = { __VA_ARGS__ }; \
at = (size_t)snprintf(want, sizeof want, "Screen %d:\n", num); \
for (k = 0; k < 16; k++) at += (size_t)snprintf(want + at, sizeof want - at, "%2u: %-64s\n", k, k < sizeof t_ / sizeof t_[0] ? t_[k] : ""); \
snprintf(want + at, sizeof want - at, " ok\nok> "); } while (0)
SCREEN(9, "");
CHECK(is(say("9 EDIT\n"), want), "EDIT lists the screen");
CHECK(is(say("ORDER\n"), "Search order: EDITOR FORTH\nCurrent: FORTH\n ok\nok> ") && n.mem[SCR] == 9, "and the editor's words are now found first");
CHECK(is(say("0 P first line\n"), " ok\nok> ") && is(say("1 P second, with blanks before it\n"), " ok\nok> ")
&& is(say("3 P fourth\n"), " ok\nok> ") && is(say("15 P last\n"), " ok\nok> "), "P puts text on a line");
SCREEN(9, "first line", " second, with blanks before it", "", "fourth", "", "", "", "", "", "", "", "", "", "", "", "last");
CHECK(is(say("L\n"), want), "L lists it");
CHECK(is(say("1 T 2 T\n"), " 1: second, with blanks before it \n 2: \n ok\nok> "), "T types a line");
CHECK(is(say("2 S\n"), " ok\nok> ") && is(say("2 P put in the gap\n"), " ok\nok> "), "S spreads");
SCREEN(9, "first line", " second, with blanks before it", "put in the gap", "", "fourth", "", "", "", "", "", "", "", "", "", "", "");
CHECK(is(say("L\n"), want), "the lines below move down and the last is lost");
CHECK(is(say("1 D\n"), " ok\nok> "), "D deletes");
SCREEN(9, "first line", "put in the gap", "", "fourth");
CHECK(is(say("L\n"), want), "the lines below move up");
CHECK(is(say("5 I 0 H 7 R 2 E\n"), " ok\nok> "), "I inserts the deleted line; H and R copy one; E erases one");
SCREEN(9, "first line", "put in the gap", "", "fourth", "", " second, with blanks before it", "", "first line");
CHECK(is(say("L\n"), want), "as it should be");
CHECK(is(say("0 D 0 D 0 D 0 D 0 D 15 S 15 D 0 S 0 D\n"), " ok\nok> "), "at the ends");
SCREEN(9, " second, with blanks before it", "", "first line");
CHECK(is(say("L\n"), want), "nothing is disturbed");
CHECK(disk[9 * V4_BLOCK_BYTES] == 0, "nothing has reached storage yet");
CHECK(is(say("16 T\n"), "Line out of range\n ok\nok> ") && is(say("-1 E\n"), "Line out of range\n ok\nok> ") && is(say("16 P x\n"), "Line out of range\n ok\nok> "),
"a line that is not there");
CHECK(is(say("9 EDIT\n"), want), "(ABORT left FORTH as CONTEXT; EDIT again)");
CHECK(is(say("DONE ORDER\n"), "Search order: FORTH \nCurrent: FORTH\n ok\nok> ") && memcmp(disk + 9 * V4_BLOCK_BYTES, " second, with blanks", 21) == 0
&& disk[9 * V4_BLOCK_BYTES + 128] == 'f' && disk[9 * V4_BLOCK_BYTES + 1023] == ' ', "DONE writes the screen and goes back to FORTH");
/* text typed into a screen is a programme */
CHECK(is(say("20 EDIT\n"), blank_screen(20)) && is(say("0 P : HELLO .\" Hello from a block\" ;\n"), " ok\nok> ")
&& is(say("1 P HELLO \\ and say it\n"), " ok\nok> ") && is(say("2 P 3 4 + .\n"), " ok\nok> ") && is(say("DONE 20 LOAD\n"), "Hello from a block7 ok\nok> "),
"a screen that has been edited can be loaded");
CHECK(is(say("9 21 COPY 21 LIST\n"), out) && strstr(out, "Block 21\n00: second, with blanks before it") && strstr(out, "02: first line "), "COPY copies a screen");
CHECK(is(say("FLUSH\n"), " ok\nok> ") && memcmp(disk + 21 * V4_BLOCK_BYTES, disk + 9 * V4_BLOCK_BYTES, V4_BLOCK_BYTES) == 0, "and the copy reaches storage");
/* each change on its own reaches storage */
CHECK(is(say("30 EDIT\n"), blank_screen(30)) && is(say("0 P only this\n"), " ok\nok> ") && is(say("DONE\n"), " ok\nok> ")
&& memcmp(disk + 30 * V4_BLOCK_BYTES, "only this ", 10) == 0, "P alone is written");
CHECK(is(say("30 EDIT\n"), out) && is(say("0 E DONE\n"), " ok\nok> ") && disk[30 * V4_BLOCK_BYTES] == ' ', "E alone is written");
/* D and I with every line in use */
CHECK(is(say("31 EDIT\n"), blank_screen(31)), "another screen");
for (k = 0; k < 16; k++) {
char line[32];
snprintf(line, sizeof line, "%u P line %c\n", k, 'A' + k);
CHECK(is(say(line), " ok\nok> "), "line %u", k);
}
CHECK(is(say("3 D\n"), " ok\nok> "), "delete line 3 of a full screen");
SCREEN(31, "line A", "line B", "line C", "line E", "line F", "line G", "line H", "line I", "line J", "line K", "line L", "line M", "line N", "line O", "line P", "");
CHECK(is(say("L\n"), want), "every line below moved up, the last is blank");
CHECK(is(say("1 I\n"), " ok\nok> "), "insert the deleted line at 1");
SCREEN(31, "line A", "line D", "line B", "line C", "line E", "line F", "line G", "line H", "line I", "line J", "line K", "line L", "line M", "line N", "line O", "line P");
CHECK(is(say("L DONE\n"), want), "every line from 1 moved down");
CHECK(is(say("21 EDIT\n"), out) && is(say("WIPE N\n"), blank_screen(22)) && is(say("B\n"), blank_screen(21)), "WIPE blanks it; N and B move to the next and back");
CHECK(is(say("99 EDIT\n"), "Block out of range\n ERROR\nok> ") && n.mem[SCR] == 21, "EDIT of a block that is not there");
/* v3's three, in FORTH */
CHECK(is(say("FORTH 9 SCR ! 0 L 3 L\n"), " second, with blanks before it \n \n ok\nok> "),
"FORTH's L shows a line, as v3's");
CHECK(is(say("S\" a much longer line than hello\" 3 S\n"), " ok\nok> ")
&& is(say("S\" hello world\" 3 S 3 L\n"), "hello world \n ok\nok> "), "and S sets one from a string, blanks after it");
SCREEN(9, " second, with blanks before it", "", "first line", "hello world");
CHECK(is(say("SHOW\n"), want), "and SHOW shows the screen");
CHECK(is(say("7 PAD 3 16 S\n"), "Line out of range\n ok\nok> "), "a line out of range");
#undef SCREEN
}
/* ---- the small system words ---- */
boot_bare();
CHECK(is(say("79-STANDARD .S\n"), "<0> \n ok\nok> "), "79-STANDARD is satisfied, and says nothing");
{
char want[64];
snprintf(want, sizeof want, "StarForth v4.0.0 F18 %d-bit\n ok\nok> ", V4_CELL_BITS);
CHECK(is(say("VERSION\n"), want), "VERSION");
}
CHECK(is(say("65 EMIT PAGE 66 EMIT\n"), "A\x1b[2J\x1b[HB ok\nok> "), "PAGE, as v3");
CHECK(is(say(": KEEPME 1 ; 1 2 3 WARM 65 EMIT\n.S KEEPME .\n"), "FORTH-79 Warm Start\nSystem restarted.\n ok\nok> <0> \n1 ok\nok> "), "WARM empties the stacks and keeps the dictionary");
{
v4_cell dp = n.mem[BOOT_CELLS];
CHECK(is(say("VOCABULARY VV VV DEFINITIONS : INVV 1 ; HEX 20 BLOCK DROP UPDATE 5 SCR !\n"), " ok\nok> "), "a vocabulary, a base, a block, a screen");
CHECK(is(say("1 2 COLD 65 EMIT\n"), "FORTH-79 Cold Start\nSystem initialized.\n ok\nok> "), "COLD says so");
CHECK(n.mem[DP] == dp && n.mem[LATEST] == capsule_latest && n.mem[CONTEXT] == LATEST && n.mem[CURRENT] == LATEST && n.mem[VOC_LINK] == 0
&& n.mem[BASE] == 10 && n.mem[SCR] == 0 && n.mem[BVARS] == 0 && n.mem[FENCE] == dp / 4, "and everything is as the loader left it");
CHECK(is(say("KEEPME\n"), "UNKNOWN WORD: 'KEEPME'\n ERROR\nok> ") && is(say("VV\n"), "UNKNOWN WORD: 'VV'\n ERROR\nok> ")
&& is(say(".S : NEW 16 . ; NEW\n"), "<0> \n16 ok\nok> "), "what was defined is gone, and the system works");
}
/* deferred words */
boot_bare();
CHECK(is(say("DEFER FOO : BAR 65 EMIT ; ' BAR IS FOO FOO\n"), "A ok\nok> "), "a deferred word does what it is given");
CHECK(is(say("DEFER@ FOO ' BAR = .\n"), "-1 ok\nok> "), "DEFER@ leaves it");
CHECK(is(say(": BAZ 66 EMIT ; : U FOO FOO ; U ' BAZ IS FOO U\n"), "AABB ok\nok> "), "a word that uses it follows the change");
CHECK(is(say(": SETB ['] BAR IS FOO ; : GET DEFER@ FOO ; SETB FOO GET ' BAR = .\n"), "A-1 ok\nok> "), "IS and DEFER@ in a definition");
CHECK(is(say("7 DEFER QUX QUX 65 EMIT\n.S\n"), "Deferred word not set\n ERROR\nok> <1> 7 \n ok\nok> "), "a deferred word with nothing set");
CHECK(is(say(": D3 1 2 3 ; ' D3 IS QUX QUX + + .\n"), "6 ok\nok> ") && is(say("DEFER\n"), "Name missing\n ERROR\nok> ") && is(say("' BAR IS NOSUCH\n"), "UNKNOWN WORD: 'NOSUCH'\n ERROR\nok> "),
"its stack effect is the word's; and the errors");
{
/* a deferred word is no deeper than the word it runs */
char line[64];
CHECK(is(say("VARIABLE V VARIABLE C DEFER RR\n"), " ok\nok> ")
&& is(say(": R1 C @ 1- DUP C ! IF RR EXIT THEN 65 EMIT ; ' R1 IS RR\n"), " ok\nok> "), "a word that runs itself through a deferred word");
snprintf(line, sizeof line, "%u C ! RR\n", (unsigned)(V4_RET_DEPTH - 4u));
CHECK(is(say(line), "A ok\nok> "), "each level takes one return entry, as a plain call does");
snprintf(line, sizeof line, "%u C ! RR\n", (unsigned)V4_RET_DEPTH);
CHECK(is(say(line), "Return stack overflow\n ERROR\nok> "), "and too many is an overflow, as for any word");
}
/* ---- vocabularies (FORTH-79) ---- */
boot_bare();
CHECK(is(say("CONTEXT @ CURRENT @ = . ORDER\n"), "-1 Search order: FORTH \nCurrent: FORTH\n ok\nok> "), "at switch-on there is FORTH");