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 <noreply@anthropic.com>
This commit is contained in:
co-authored by
Claude Opus 5.5
parent
880560fc00
commit
26a6a16537
+96
-1
@@ -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);
|
||||
|
||||
Reference in New Issue
Block a user