From 26a6a165379c919f9c17e3be452b46d3d48f6fb4 Mon Sep 17 00:00:00 2001 From: rajames Date: Sun, 4 Oct 2026 09:58:26 -0400 Subject: [PATCH] feat(v4.0.0): the text assembler lays down dictionary headers '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 --- v4/include/v4/text.h | 16 +++++++ v4/src/text.c | 97 ++++++++++++++++++++++++++++++++++++++- v4/tests/test_host_dict.c | 24 +++++++++- v4/tests/test_text.c | 38 +++++++++++++++ 4 files changed, 173 insertions(+), 2 deletions(-) diff --git a/v4/include/v4/text.h b/v4/include/v4/text.h index 6cc006b0..da97aa3b 100644 --- a/v4/include/v4/text.h +++ b/v4/include/v4/text.h @@ -42,6 +42,15 @@ * may use other macros; it may not define a word, a label * or a macro. * + * header NAME a dictionary entry for NAME (capsule/dict.v4), laid down + * in front of the word that the next `:` starts, and + * linked to the header before it. NAME is taken as it + * stands -- it may be ( or \ or + -- and is at most 31 + * characters. Between it and the `:` may come the flags + * immediate, data, inline and compile-only. The word after + * `:` is the assembler's name for the code, as always, and + * need not be the same: header + inline : PLUS + ; + * * A name is looked up in this order: opcode, macro, number, constant, label * (for a branch target), word. So an opcode's name cannot be redefined, and * the FORTH words that share one (`@`, `!`, `+`, ...) are written as their @@ -99,6 +108,9 @@ typedef struct { char pool[V4_TEXT_POOL]; unsigned pool_used; + v4_cell latest; /* xt of the newest header, 0 if none */ + int header_pending; /* a header waits for its `:` */ + unsigned line; int failed; char message[224]; @@ -125,6 +137,10 @@ int v4_text_finish(v4_text *t); /* The address of the word NAME, or -1 if there is none. */ v4_cell v4_text_word(const v4_text *t, const char *name); +/* The xt of the newest `header`, 0 if there has been none: what the + * dictionary's LATEST starts as. */ +v4_cell v4_text_latest(const v4_text *t); + /* The next free word address. */ v4_cell v4_text_here(v4_text *t); diff --git a/v4/src/text.c b/v4/src/text.c index c69c8f6c..3179a06d 100644 --- a/v4/src/text.c +++ b/v4/src/text.c @@ -50,11 +50,22 @@ static const v4_text_symbol *find(const v4_text *t, const char *s) return NULL; } +/* The entry flags a `header` may be given (capsule/dict.v4). */ +static v4_cell flag_of(const char *s) +{ + if (strcmp(s, "immediate") == 0) return 1; + if (strcmp(s, "data") == 0) return 4; + if (strcmp(s, "inline") == 0) return 8; + if (strcmp(s, "compile-only") == 0) return 16; + return 0; +} + static int is_reserved(const char *s) { return strcmp(s, ":") == 0 || strcmp(s, "macro") == 0 || strcmp(s, "endmacro") == 0 || strcmp(s, "\\") == 0 || strcmp(s, "(") == 0 - || strcmp(s, "FOR") == 0 || strcmp(s, "NEXT") == 0 || strcmp(s, "UNEXT") == 0; + || strcmp(s, "FOR") == 0 || strcmp(s, "NEXT") == 0 || strcmp(s, "UNEXT") == 0 + || strcmp(s, "header") == 0 || flag_of(s) != 0; } static int is_label_def(const char *s) @@ -129,6 +140,75 @@ static int next_token(v4_text *t, reader *r, char *tok) } } +static void end_word(v4_text *t); +static void check_asm(v4_text *t, const char *tok); + +/* The next run of non-blank characters of the source, whatever they are: + * a header's name may be ( or \ or any opcode. */ +static int raw_token(v4_text *t, reader *r, char *tok) +{ + const char *p; + unsigned len = 0; + if (r->depth != 1) return 0; + p = r->p[0]; + while (*p == ' ' || *p == '\t' || *p == '\r' || *p == '\n') { if (*p == '\n') t->line++; p++; } + while (*p && *p != ' ' && *p != '\t' && *p != '\r' && *p != '\n') { + if (len < V4_TEXT_MAX_TOKEN) tok[len] = *p; + len++; p++; + } + r->p[0] = p; + if (len == 0 || len > V4_TEXT_MAX_TOKEN) return 0; + tok[len] = 0; + return 1; +} + +/* One cell appended at the next word address; nothing is being built. */ +static void put_cell(v4_text *t, v4_cell value) +{ + v4_asm *as = &t->as; + if (as->here < 0 || (v4_ucell)as->here >= V4_NODE_WORDS) { as->error = 1; return; } + v4_node_store(as->n, as->here, value); + as->here++; +} + +/* `header NAME`: a dictionary entry for NAME, as capsule/dict.v4 lays one + * out, in front of the word the next `:` starts: + * the name: its count byte, then its characters, four bytes to a cell, + * zero-padded to a whole cell + * flags, the name's word address, the link to the entry before + * and the code follows. */ +static void header(v4_text *t, reader *r) +{ + char name[V4_TEXT_MAX_TOKEN + 1u]; + unsigned len, cells, i; + v4_cell nfa; + + if (r->depth != 1) { fail(t, "not allowed in a macro", "header"); return; } + if (t->header_pending) { fail(t, "header must be followed by :", NULL); return; } + if (!raw_token(t, r, name)) { fail(t, "header without a name, or one too long", NULL); return; } + len = (unsigned)strlen(name); + if (len > 31) { fail(t, "a header's name is at most 31 characters", name); return; } + end_word(t); + nfa = v4_asm_label(&t->as); + cells = (len + 4u) / 4u; + for (i = 0; i < cells; i++) { + v4_ucell w = 0; + for (unsigned b = 0; b < 4; b++) { + unsigned at = 4u * i + b; /* byte 0 is the count */ + unsigned ch = at == 0 ? len : (at <= len ? (unsigned char)name[at - 1u] : 0u); + w |= (v4_ucell)ch << (8u * b); + } + put_cell(t, (v4_cell)w); + } + put_cell(t, 0); + put_cell(t, nfa); + put_cell(t, t->latest); + check_asm(t, name); + if (t->failed) return; + t->latest = t->as.here; + t->header_pending = 1; +} + /* A branch may go in the next slot only if that slot can reach every word of * the node; otherwise it starts a new word. */ static void place_branch(v4_text *t) @@ -269,12 +349,19 @@ static void one_token(v4_text *t, reader *r, const char *tok) v4_cell v; int op, big; + if (strcmp(tok, "header") == 0) { header(t, r); return; } + if (t->header_pending) { + v4_cell f = flag_of(tok); + if (f) { as->n->mem[t->latest - 3] |= f; return; } + if (strcmp(tok, ":") != 0) { fail(t, "header must be followed by :", tok); return; } + } else if (flag_of(tok)) { fail(t, "a flag with no header before it", tok); return; } if (strcmp(tok, ":") == 0) { char name[V4_TEXT_MAX_TOKEN + 1u]; if (r->depth != 1) { fail(t, "not allowed in a macro", tok); return; } if (!next_token(t, r, name)) { fail(t, ": without a name", NULL); return; } end_word(t); define(t, name, KIND_WORD, v4_asm_label(as)); + t->header_pending = 0; return; } if (strcmp(tok, "macro") == 0) { define_macro(t, r); return; } @@ -371,6 +458,8 @@ void v4_text_begin(v4_text *t, v4_node *n, v4_cell origin) t->line = 0; t->failed = 0; t->message[0] = 0; + t->latest = 0; + t->header_pending = 0; } void v4_text_constant(v4_text *t, const char *name, v4_cell value) @@ -390,6 +479,7 @@ int v4_text_assemble(v4_text *t, const char *source) r.depth = 1; t->line = 1; while (!t->failed && next_token(t, &r, tok)) one_token(t, &r, tok); + if (!t->failed && t->header_pending) fail(t, "header must be followed by :", NULL); if (!t->failed) end_word(t); return !t->failed; } @@ -446,6 +536,11 @@ v4_cell v4_text_word(const v4_text *t, const char *name) return s && s->kind == KIND_WORD ? s->value : (v4_cell)-1; } +v4_cell v4_text_latest(const v4_text *t) +{ + return t->latest; +} + v4_cell v4_text_here(v4_text *t) { return v4_asm_label(&t->as); diff --git a/v4/tests/test_host_dict.c b/v4/tests/test_host_dict.c index b2108aaa..15fa6f74 100644 --- a/v4/tests/test_host_dict.c +++ b/v4/tests/test_host_dict.c @@ -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]; diff --git a/v4/tests/test_text.c b/v4/tests/test_text.c index 7d514750..94b32359 100644 --- a/v4/tests/test_text.c +++ b/v4/tests/test_text.c @@ -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));