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

feat(v4.0.0): vocabularies, to FORTH-79

Browse Source 
- VOCABULARY DEFINITIONS CONTEXT CURRENT FORTH, and v3's ORDER.  A name is
  looked up in the CONTEXT vocabulary and then in FORTH; a new entry goes
  into the CURRENT vocabulary; : makes the CURRENT vocabulary CONTEXT;
  FORTH is immediate.
- WORDS lists the CONTEXT vocabulary.  FORGET takes what was defined later
  out of every vocabulary, and a vocabulary that goes gives way to FORTH.
- v3's vocabularies separate nothing: a word defined in one is found from
  every other, and one redefined in a vocabulary replaces FORTH's for good.
- tests/test_host_quit.c: isolation, chaining to FORTH, two vocabularies
  with the same names, FORGET across them; and DUMP is now checked to put
  BASE back.

Co-Authored-By: Claude Opus 5.5 <noreply@anthropic.com>
This commit is contained in:
rajames
2026-10-05 07:18:28 -04:00
co-authored by Claude Opus 5.5
parent ab272cc2ad
commit 0fbe1432b7
6 changed files with 147 additions and 20 deletions
Download Patch File Download Diff File Expand all files Collapse all files
v4/tests/host_map.h
+10
View File
@@ -40,6 +40,9 @@
#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 CONTEXT (TOP - 64) /* the vocabulary names are looked up in */
#define CURRENT (TOP - 63) /* the vocabulary new words go into */
#define VOC_LINK (TOP - 50) /* the newest vocabulary */
#define FENCE (TOP - 26) /* FORGET's lower limit */
#define HLD (TOP - 25) /* where the pictured number has got to */
#define QVARS (TOP - 52) /* (Q): quit.v4, 2 cells */
@@ -133,6 +136,9 @@ static int host_load(v4_text *tx, v4_node *n, const char *const *files, unsigned
v4_text_constant(tx, "MAX-INT", (v4_cell)(V4_MSB - 1u));
v4_text_constant(tx, "HLD", HLD);
v4_text_constant(tx, "FENCE", FENCE);
v4_text_constant(tx, "CONTEXT", CONTEXT);
v4_text_constant(tx, "CURRENT", CURRENT);
v4_text_constant(tx, "VOC-LINK", VOC_LINK);
v4_text_constant(tx, "HEND", HEND);
v4_text_constant(tx, "-HFLOOR", -(HEND - 62));
v4_text_constant(tx, "DSTACK-DEPTH", DSTACK_REG);
@@ -147,6 +153,10 @@ static int host_load(v4_text *tx, v4_node *n, const char *const *files, unsigned
return 0;
}
}
/* one vocabulary, FORTH, whose head cell is LATEST */
n->mem[CONTEXT] = LATEST;
n->mem[CURRENT] = LATEST;
n->mem[VOC_LINK] = 0;
return 1;
}
v4/tests/test_host_quit.c
+41 -1
View File
@@ -18,6 +18,10 @@
* v3 goes on compiling the lines that follow into it.
* - ABORT" at the prompt stops the line when its flag is true. v3 prints
* the text and carries on. Compiled into a word, v3's crashes (SIGSEGV).
* - vocabularies are FORTH-79's: a word defined in one is found only when
* that vocabulary is CONTEXT, and FORTH is searched after it. v3 finds
* every word everywhere, and a word redefined in a vocabulary replaces
* FORTH's for good.
* - every error has a message (D-18), but v4's says what was wrong, not
* which word: "Control structure mismatch" where v3 says
* "LOOP: missing DO".
@@ -82,6 +86,9 @@ static void boot_with(unsigned depth)
n.mem[BASE] = 10;
n.mem[NODE_ERROR] = 0;
n.mem[FENCE] = DICT_W;
n.mem[CONTEXT] = LATEST;
n.mem[CURRENT] = LATEST;
n.mem[VOC_LINK] = 0;
v4_node_console_attach(&n, CONSOLE_TX);
v4_node_console_input_attach(&n, CONSOLE_RX, CONSOLE_ST);
v4_node_fault_attach(&n, w_fault);
@@ -814,6 +821,39 @@ int main(void)
CHECK(is(say("FORGET G3 G1 G2\n"), "AB ok\nok> ") && is(say("G3\n"), "UNKNOWN WORD: 'G3'\n ERROR\nok> "), "one above it can");
}
/* ---- 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");
CHECK(is(say("VOCABULARY ANIMALS ANIMALS DEFINITIONS : CAT 65 EMIT ; CAT FORTH CAT\n"), "AUNKNOWN WORD: 'CAT'\n ERROR\nok> "),
"a word defined in a vocabulary is found there and not in FORTH");
CHECK(is(say("ORDER\n"), "Search order: FORTH \nCurrent: ANIMALS\n ok\nok> "), "FORTH is CONTEXT; ANIMALS is still CURRENT");
CHECK(is(say("ANIMALS CAT 1 2 + . ORDER\n"), "A3 Search order: ANIMALS FORTH\nCurrent: ANIMALS\n ok\nok> "), "with ANIMALS as CONTEXT, FORTH is searched after it");
CHECK(is(say(": DUP 66 EMIT ; DUP FORTH 5 DUP . . ANIMALS DUP\n"), "B5 5 B ok\nok> "), "a name in both: each vocabulary has its own");
CHECK(is(say("FORTH DEFINITIONS VOCABULARY PLANTS PLANTS DEFINITIONS : CAT 67 EMIT ; CAT\n"), "C ok\nok> "), "a second vocabulary with the same name in it");
CHECK(is(say("ANIMALS CAT PLANTS CAT FORTH DEFINITIONS\n"), "AC ok\nok> "), "each finds its own");
CHECK(is(say("ANIMALS WORDS PLANTS WORDS FORTH\n"), "DUP CAT \nCAT \n ok\nok> "), "WORDS lists the CONTEXT vocabulary");
CHECK(is(say("ANIMALS CONTEXT @ CURRENT @ = . : X 1 ; CONTEXT @ CURRENT @ = .\n"), "0 -1 ok\nok> "), ": makes the CURRENT vocabulary CONTEXT");
CHECK(is(say(": T1 ANIMALS ; : T2 FORTH 68 EMIT ; T1 CAT T2 ORDER\n"), "ADSearch order: ANIMALS FORTH\nCurrent: FORTH\n ok\nok> "),
"a vocabulary's name can be compiled; FORTH is immediate");
CHECK(is(say("VOCABULARY\nFORTH\n"), "Name missing\n ERROR\nok> ok\nok> "), "VOCABULARY needs a name");
/* FORGET across vocabularies */
boot_bare();
CHECK(is(say("VOCABULARY V1 V1 DEFINITIONS : A1 1 ; FORTH DEFINITIONS : B1 2 ;\n"), " ok\nok> ")
&& is(say("V1 DEFINITIONS : A2 3 ; FORTH DEFINITIONS\n"), " ok\nok> "), "words in two vocabularies, defined turn about");
CHECK(is(say("FORGET B1 V1 A1 . A2\n"), "1 UNKNOWN WORD: 'A2'\n ERROR\nok> "), "FORGET takes what was defined later out of every vocabulary");
CHECK(is(say("B1\n"), "UNKNOWN WORD: 'B1'\n ERROR\nok> ") && is(say("V1 DEFINITIONS : A3 4 ; A1 A3 + . FORTH DEFINITIONS\n"), "5 ok\nok> "), "and the vocabulary goes on");
{
v4_cell dp;
CHECK(is(say("HERE . \n"), out) && n.mem[VOC_LINK] != 0, "(one vocabulary)");
dp = n.mem[DP];
CHECK(is(say("VOCABULARY V2 V2 DEFINITIONS : Z 1 ; VOCABULARY V3 ORDER\n"), "Search order: V2 FORTH\nCurrent: V2\n ok\nok> "), "a vocabulary that is CONTEXT and CURRENT");
CHECK(is(say("FORGET V2 ORDER\n"), "Search order: FORTH \nCurrent: FORTH\n ok\nok> ") && n.mem[DP] == dp,
"forgotten, FORTH takes its place and the space is back");
CHECK(is(say("V2\n"), "UNKNOWN WORD: 'V2'\n ERROR\nok> ") && is(say("V3\n"), "UNKNOWN WORD: 'V3'\n ERROR\nok> ")
&& is(say("V1 A1 . FORTH : OK1 65 EMIT ; OK1\n"), "1 A ok\nok> "), "its words and the vocabulary defined inside it are gone; the rest works");
CHECK(is(say("FORGET V1 FORGET V1\n"), "UNKNOWN WORD: 'V1'\n ERROR\nok> ") && n.mem[VOC_LINK] == 0, "and with V1 forgotten there is none");
}
/* ---- WORDS ---- */
boot_bare();
CHECK(is(say(": ZEBRA ; : YAK ; : HALFWAY 1\n"), " ok\nok> "), "two words and a definition under way");
@@ -845,7 +885,7 @@ int main(void)
at += (size_t)snprintf(want + at, sizeof want - at, "00 7E C8 7F |.~..|\n");
snprintf(want + at, sizeof want - at, " ok\nok> ");
CHECK(is(say("PAD 20 DUMP\n"), want), "a line and four bytes, in hex though BASE is ten");
CHECK(is(say("BASE @ .\n"), "10 ok\nok> "), "and BASE is put back");
CHECK(is(say("BASE @ 48 + EMIT\n"), ": ok\nok> "), "and BASE is put back");
CHECK(is(say("8 BASE ! PAD 24 DUMP DECIMAL\n"), want), "the same from octal");
}