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

feat(v4.0.0): the text assembler lays down dictionary headers

Browse Source 
'header NAME [flags]' in front of a word gives it a dictionary entry in
the layout capsule/dict.v4 uses, linked to the header before it, so the
words of a capsule are in the dictionary as soon as it is assembled.
The name is taken as it stands (it may be ( or + or ;) and the
assembler's own name for the code may differ.

Tested in the assembler's own test, and by FIND and the field words
running over assembler-made entries beside ones (HEADER) made.

Co-Authored-By: Claude Opus 5.5 <noreply@anthropic.com>
This commit is contained in:
rajames
2026-10-04 09:58:26 -04:00
co-authored by Claude Opus 5.5
parent 880560fc00
commit 26a6a16537
4 changed files with 173 additions and 2 deletions
Download Patch File Download Diff File Expand all files Collapse all files
v4/tests/test_host_dict.c
+23 -1
View File
@@ -237,7 +237,10 @@ int main(void)
": MAKE ( -- ) 32 WORD jump (HEADER)\n"
": 'PAD PAD ;\n"
": DATA! ( -- ) LATEST (FLAGS) a! @ 4 OR ! ;\n" /* what CREATE will do */
": IMM! ( -- ) LATEST (FLAGS) a! @ 1 OR ! ;\n"), /* what IMMEDIATE will do */
": IMM! ( -- ) LATEST (FLAGS) a! @ 1 OR ! ;\n" /* what IMMEDIATE will do */
"header FIRST-HEADER : ASM-A 1 ;\n"
"header B immediate inline : ASM-B 2 ;\n"
"header ( immediate : ASM-PAREN 3 ;\n"),
"wrappers: %s", v4_text_error(&tx));
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");
@@ -392,6 +395,25 @@ int main(void)
set_line("NOSUCHWORD");
CHECK(get("'", 0, 0) == 0 && err(), "' of a word that is not there is an error");
/* ---- entries the text assembler made ---- */
{
v4_cell xa = W("ASM-A"), xb = W("ASM-B"), xp = W("ASM-PAREN"), made;
empty_dictionary();
n.mem[LATEST] = v4_text_latest(&tx);
CHECK(v4_text_latest(&tx) == xp, "the assembler's latest header is the last one in the text");
CHECK(find("FIRST-HEADER") == xa && find("B") == xb && find("(") == xp && find("ASM-A") == 0 && !err(), "FIND finds the words the assembler gave headers");
CHECK(n.mem[xa - 3] == 0 && n.mem[xb - 3] == 1 + 8 && n.mem[xp - 3] == 1, "with the flags it gave them");
CHECK(get("LINK>", 1, get(">LINK", 1, xp)) == xb && get("LINK>", 1, get(">LINK", 1, xb)) == xa && get("LINK>", 1, get(">LINK", 1, xa)) == 0, "linked in order");
CHECK(get("NAME>", 1, get(">NAME", 1, xa)) == xa && get("NAME>", 1, get(">NAME", 1, xp)) == xp, "and the field words work on them");
/* the same name through (HEADER): the same cells */
made = define("FIRST-HEADER");
CHECK(made != 0 && n.mem[made - 3] == n.mem[xa - 3] && made - n.mem[made - 2] == xa - n.mem[xa - 2], "an entry made by (HEADER) has the same shape");
for (i = 0; i < (unsigned)(xa - 3 - n.mem[xa - 2]); i++)
if (n.mem[n.mem[xa - 2] + (v4_cell)i] != n.mem[n.mem[made - 2] + (v4_cell)i]) break;
CHECK(i == (unsigned)(xa - 3 - n.mem[xa - 2]), "and the same name cells");
CHECK(n.mem[made - 1] == xp && find("FIRST-HEADER") == made && find("B") == xb, "new entries link on to the assembler's");
}
/* ---- many words, against a list kept in C ---- */
{
static char names[300][36];
v4/tests/test_text.c
+38
View File
@@ -409,6 +409,44 @@ int main(void)
CHECK(ok(": 2DUP over over ; : 1+ 1 + ; : T ( a b -- 2a+2b+1 ) 2DUP + + + 1+ ;") && result("T", 2, 2, 3) == 11,
"names that begin with digits");
/* headers: a dictionary entry in front of a word (capsule/dict.v4) */
CHECK(ok("header DUP : (DUP) dup + ;"), "a header assembles: %s", v4_text_error(&tx));
{
v4_cell xt = v4_text_word(&tx, "(DUP)");
CHECK(xt == ORIGIN + 4 && v4_text_latest(&tx) == xt, "the code follows the name cell and three more: %ld", (long)xt);
CHECK((v4_ucell)nb.mem[ORIGIN] == (3u | ('D' << 8) | ('U' << 16) | ((v4_ucell)'P' << 24)), "the name: its count, then its characters");
CHECK(nb.mem[xt - 3] == 0 && nb.mem[xt - 2] == ORIGIN && nb.mem[xt - 1] == 0, "flags 0, the name's address, link 0");
CHECK(result("(DUP)", 1, 7, 0) == 14, "and the word runs");
}
CHECK(ok(": BEFORE 1 ; header A : A' 2 ; header LONGER-NAM immediate : B' 3 ; : MID 4 ; header + inline compile-only : PLUS + ;")
&& result("BEFORE", 0, 0, 0) == 1 && result("B'", 0, 0, 0) == 3 && result("MID", 0, 0, 0) == 4, "headers among other words");
{
v4_cell a = v4_text_word(&tx, "A'"), b = v4_text_word(&tx, "B'"), c = v4_text_word(&tx, "PLUS");
CHECK(nb.mem[a - 1] == 0 && nb.mem[b - 1] == a && nb.mem[c - 1] == b && v4_text_latest(&tx) == c, "each links to the one before; the newest is the latest");
CHECK(nb.mem[a - 3] == 0 && nb.mem[b - 3] == 1 && nb.mem[c - 3] == 24, "the flags: none, immediate, inline and compile-only");
CHECK(b - a == 2 + 3 + 3 && nb.mem[b - 2] == b - 6, "a ten-character name takes three cells");
CHECK((v4_ucell)nb.mem[b - 4] == (('N') | ('A' << 8) | ('M' << 16)), "and is padded with zeros");
CHECK((v4_ucell)nb.mem[c - 4] == (1u | ('+' << 8)), "an opcode's name is taken as it stands");
}
CHECK(ok("header ( immediate : PAREN ; header \\ immediate : BACKSLASH ; header : : COLON ; header ; : SEMI ; header header : H ;"),
"names the assembler would otherwise read as its own: %s", v4_text_error(&tx));
CHECK((v4_ucell)nb.mem[v4_text_word(&tx, "PAREN") - 4] == (1u | ('(' << 8))
&& (v4_ucell)nb.mem[v4_text_word(&tx, "BACKSLASH") - 4] == (1u | ('\\' << 8))
&& (v4_ucell)nb.mem[v4_text_word(&tx, "COLON") - 4] == (1u | (':' << 8))
&& (v4_ucell)nb.mem[v4_text_word(&tx, "SEMI") - 4] == (1u | (';' << 8)), "are names like any other");
CHECK(ok("header data-word data : D 1 ;") && nb.mem[v4_text_word(&tx, "D") - 3] == 4, "the data flag");
CHECK(ok("header 1234567890123456789012345678901 : W ;"), "a 31-character name fits");
CHECK(refused("header 12345678901234567890123456789012 : W ;", "at most 31 characters", 1), "a 32-character one is refused");
CHECK(refused("header X 5 : W ;", "header must be followed by :", 1), "something other than a flag or : after a header is refused");
CHECK(refused("header X header Y : W ;", "header must be followed by :", 1), "so is another header");
CHECK(refused("header X", "header must be followed by :", 0), "and the end of the text");
CHECK(refused("header", "header without a name", 0), "header with no name is refused");
CHECK(refused(": T immediate ;", "a flag with no header", 1), "a flag with no header is refused");
CHECK(refused("macro M header X endmacro", "", 0) || 1, "(header inside a macro body is only text until the macro is used)");
CHECK(refused("macro M header X : W ; endmacro", "not allowed in a macro", 1), "a word in a macro is still refused");
CHECK(refused(": immediate 1 ;", "cannot be used as a name", 1), "a flag's name cannot name a word");
CHECK(ok(": T 1 ;") && v4_text_latest(&tx) == 0, "with no header the latest is 0");
/* once it has failed it stays failed, and says why */
CHECK(!ok(": T 1 ;\n: T 2 ;") && !v4_text_assemble(&tx, ": U 3 ;") && !v4_text_finish(&tx)
&& strstr(v4_text_error(&tx), "line 2: already defined: T") != NULL, "the first error is kept: %s", v4_text_error(&tx));