From 7b710aa32234cb15ded728ac2e3fbfbdea108602 Mon Sep 17 00:00:00 2001 From: rajames Date: Sat, 3 Oct 2026 21:13:32 -0400 Subject: [PATCH] feat(v4.0.0): assemble definitions written as text Test support, beside the slot packer: reads definitions in the notation DECOMPOSITION.md uses -- words, opcodes, literals, constants, labels, branches, FOR NEXT and FOR UNEXT, in-line macros, comments -- and lays them down through the slot packer, so they no longer have to be retyped opcode by opcode in C. Tested by assembling SWAP, UM/MOD, C@ and C! both ways on two nodes and comparing memory word for word, by running what is assembled, and on every error it reports, each with its line number. Co-Authored-By: Claude Opus 5.5 --- v4/README.md | 4 +- v4/include/v4/text.h | 131 +++++++++++++ v4/src/text.c | 428 +++++++++++++++++++++++++++++++++++++++++ v4/tests/test_text.c | 443 +++++++++++++++++++++++++++++++++++++++++++ 4 files changed, 1005 insertions(+), 1 deletion(-) create mode 100644 v4/include/v4/text.h create mode 100644 v4/src/text.c create mode 100644 v4/tests/test_text.c diff --git a/v4/README.md b/v4/README.md index 2a67cf01..ebcf0c98 100644 --- a/v4/README.md +++ b/v4/README.md @@ -16,7 +16,9 @@ and every ISA, hosted and bare metal, must still reach its `ok` prompt. What exists so far is the single node: registers, circular stacks, memory, all 32 opcodes, per-opcode and per-call-target heat, and three console registers (`CONSOLE-TX`, which captures output, and `CONSOLE-RX` and `CONSOLE-STATUS`, which hand out -input a test feeds) standing in for the console node until the mesh exists. `make -C v4 test` builds +input a test feeds) standing in for the console node until the mesh exists. The tests load definitions +onto a node either opcode by opcode (`v4/include/v4/asm.h`) or as text in the notation `DECOMPOSITION.md` +uses (`v4/include/v4/text.h`). `make -C v4 test` builds and runs the tests at both cell widths; `make -C v4 sanitize` repeats them under ASan and UBSan. There is no compiler capsule, no POST and no K measurement yet. diff --git a/v4/include/v4/text.h b/v4/include/v4/text.h new file mode 100644 index 00000000..9d8aeac8 --- /dev/null +++ b/v4/include/v4/text.h @@ -0,0 +1,131 @@ +/* text.h -- assemble definitions written as text onto a node. + * + * Until now every DECOMPOSITION.md definition was retyped by hand in the + * tests as calls to the slot packer (asm.h), one opcode at a time. This + * reads the definitions as they are written in the document instead: + * + * : EMIT ( c -- ) CONSOLE-TX b! !b ; + * : SPACE 32 jump EMIT + * + * and lays them down through the same slot packer, so the words it produces + * are the ones the hand-written calls would have produced. It is test + * support, like asm.h: it is not the compiler capsule (JUSTIFICATION.md + * section 9), which is itself v4 code and will be assembled by this. + * + * THE NOTATION. Tokens are separated by white space. Names are case + * sensitive; the 32 opcode mnemonics are lower case. + * + * \ ... comment to the end of the line + * ( ... ) comment to the closing parenthesis + * : NAME start the word NAME at the next instruction word. A + * word ends where the next one starts; `;` is the return + * opcode and a word may hold several, or none (it then + * runs on into the next word). + * NAME call the word NAME. It may be defined later in the + * text, or in a later call to v4_text_assemble. + * 123 -5 $FF a literal: `@p` and its value. Decimal, or hex after $. + * It must fit a cell, as a signed or an unsigned number. + * CONST a constant given by v4_text_constant: a literal. + * ; + dup a! ... an opcode. `@p` cannot be written; write the number. + * jump X call X if X -if X next X + * a branch to X: a label of this word if it has one of + * that name, before or after the branch; otherwise a word. + * LABEL: a label, at the next instruction word. Labels belong + * to the word they are in and may be used before they + * are defined. + * FOR ... NEXT `push`, then the body, then `next` back to the body. + * FOR ... UNEXT the same with `unext`: the body and the `unext` must + * fit one instruction word and hold no literal. + * macro NAME ... endmacro + * NAME stands for the tokens between, wherever it is + * written afterwards (the document's "in line"). A macro + * may use other macros; it may not define a word, a label + * or a macro. + * + * 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 + * opcode sequences. + * + * BRANCH PLACEMENT. A branch's address field is what is left of its word, so + * it reaches less the later its slot. The slot packer refuses a branch that + * cannot reach its target; this never asks it to: a branch is put in a slot + * only if that slot reaches the whole node (at 1024 words, every legal slot), + * and otherwise starts a new word. + * + * ERRORS. The first error stops the assembly and is kept: v4_text_error + * gives a message with the line number, and every later call does nothing. + */ +#ifndef V4_TEXT_H +#define V4_TEXT_H + +#include "v4/asm.h" + +#define V4_TEXT_MAX_SYMBOLS 2048u /* words, constants and macros */ +#define V4_TEXT_MAX_LABELS 64u /* in one word */ +#define V4_TEXT_MAX_REFS 1024u /* branches whose target is not known yet */ +#define V4_TEXT_POOL 65536u /* characters of names and macro text */ +#define V4_TEXT_MAX_TOKEN 63u +#define V4_TEXT_MAX_DEPTH 8u /* macros inside macros; FOR inside FOR */ + +typedef struct { + unsigned name; /* offset into pool */ + unsigned char kind; + v4_cell value; /* address, constant, or macro text offset */ +} v4_text_symbol; + +typedef struct { + unsigned name; + v4_asm_ref ref; + unsigned line; + int local; /* may still turn out to be a label of this word */ +} v4_text_ref; + +typedef struct { + v4_asm as; + + v4_text_symbol sym[V4_TEXT_MAX_SYMBOLS]; + unsigned nsym; + + struct { unsigned name; v4_cell addr; } label[V4_TEXT_MAX_LABELS]; + unsigned nlabel; + + v4_text_ref ref[V4_TEXT_MAX_REFS]; + unsigned nref; + + v4_cell for_addr[V4_TEXT_MAX_DEPTH]; + unsigned nfor; + + char pool[V4_TEXT_POOL]; + unsigned pool_used; + + unsigned line; + int failed; + char message[160]; +} v4_text; + +/* Start assembling at word address `origin` of node `n`. */ +void v4_text_begin(v4_text *t, v4_node *n, v4_cell origin); + +/* Give NAME a value; written in the text it is a literal. */ +void v4_text_constant(v4_text *t, const char *name, v4_cell value); + +/* Assemble `source`, a NUL-terminated string. May be called several times; + * words, constants and macros carry over, labels do not. Returns 1 if there + * has been no error. */ +int v4_text_assemble(v4_text *t, const char *source); + +/* Finish: every branch must have found its target. Returns 1 if there has + * been no error. Assembling may continue afterwards. */ +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 next free word address. */ +v4_cell v4_text_here(v4_text *t); + +/* "" if there has been no error, else what and where. */ +const char *v4_text_error(const v4_text *t); + +#endif /* V4_TEXT_H */ diff --git a/v4/src/text.c b/v4/src/text.c new file mode 100644 index 00000000..123eb032 --- /dev/null +++ b/v4/src/text.c @@ -0,0 +1,428 @@ +/* text.c -- assemble definitions written as text. See text.h. */ +#include "v4/text.h" +#include +#include +#include +#include + +enum { KIND_WORD = 1, KIND_CONST, KIND_MACRO }; + +static const char *const mnemonic[V4_OPCODE_COUNT] = { + ";", "ex", "jump", "call", "unext", "next", "if", "-if", + "@p", "@+", "@b", "@", "!p", "!+", "!b", "!", + "+*", "2*", "2/", "inv", "+", "and", "xor", "drop", + "dup", "pop", "over", "a", "nop", "push", "b!", "a!" +}; + +/* Where tokens come from: the source text, or a macro's text on top of it. */ +typedef struct { + const char *p[V4_TEXT_MAX_DEPTH + 1u]; + unsigned depth; /* 0: nothing; 1: the source; more: in macros */ +} reader; + +static void fail(v4_text *t, const char *what, const char *token) +{ + if (t->failed) return; + t->failed = 1; + if (token) snprintf(t->message, sizeof t->message, "line %u: %s: %s", t->line, what, token); + else snprintf(t->message, sizeof t->message, "line %u: %s", t->line, what); +} + +static unsigned intern(v4_text *t, const char *s) +{ + size_t len = strlen(s) + 1u; + unsigned at = t->pool_used; + if (len > V4_TEXT_POOL - t->pool_used) { fail(t, "out of name space", s); return 0; } + memcpy(t->pool + at, s, len); + t->pool_used += (unsigned)len; + return at; +} + +static int opcode_of(const char *s) +{ + for (int i = 0; i < (int)V4_OPCODE_COUNT; i++) if (strcmp(s, mnemonic[i]) == 0) return i; + return -1; +} + +static const v4_text_symbol *find(const v4_text *t, const char *s) +{ + for (unsigned i = t->nsym; i-- > 0; ) if (strcmp(t->pool + t->sym[i].name, s) == 0) return &t->sym[i]; + return NULL; +} + +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; +} + +static int is_label_def(const char *s) +{ + size_t len = strlen(s); + return len > 1 && s[len - 1] == ':'; +} + +/* A whole token that is a number: decimal with an optional sign, or $hex. + * It must fit a cell, read as signed or as unsigned. */ +static int number_of(const char *s, v4_cell *out, int *too_big) +{ + const char *digits = s; + char *end; + int neg = 0, base = 10; + unsigned long long u; + + *too_big = 0; + if (*digits == '$') { base = 16; digits++; } + else if (*digits == '-') { neg = 1; digits++; } + if (*digits == 0) return 0; + for (const char *c = digits; *c; c++) { + int ok = (*c >= '0' && *c <= '9') + || (base == 16 && ((*c >= 'a' && *c <= 'f') || (*c >= 'A' && *c <= 'F'))); + if (!ok) return 0; + } + errno = 0; + u = strtoull(digits, &end, base); + if (*end) return 0; + if (errno == ERANGE + || (neg ? u > (unsigned long long)V4_MSB : u > (unsigned long long)(v4_ucell)~(v4_ucell)0)) { + *too_big = 1; + return 1; + } + *out = neg ? (v4_cell)((v4_ucell)0 - (v4_ucell)u) : (v4_cell)(v4_ucell)u; + return 1; +} + +/* The next token, or 0 at the end. Comments are skipped here, and lines + * counted, in the source only: a macro's text holds neither. */ +static int next_token(v4_text *t, reader *r, char *tok) +{ + for (;;) { + const char *p; + unsigned len = 0; + if (r->depth == 0) return 0; + p = r->p[r->depth - 1u]; + while (*p == ' ' || *p == '\t' || *p == '\r' || *p == '\n') { + if (*p == '\n' && r->depth == 1) t->line++; + p++; + } + if (*p == 0) { r->depth--; continue; } + while (*p && *p != ' ' && *p != '\t' && *p != '\r' && *p != '\n') { + if (len < V4_TEXT_MAX_TOKEN) tok[len] = *p; + len++; p++; + } + if (len > V4_TEXT_MAX_TOKEN) { tok[V4_TEXT_MAX_TOKEN] = 0; fail(t, "name too long", tok); return 0; } + tok[len] = 0; + if (strcmp(tok, "\\") == 0) { + while (*p && *p != '\n') p++; + r->p[r->depth - 1u] = p; + continue; + } + if (strcmp(tok, "(") == 0) { + while (*p && *p != ')') { if (*p == '\n' && r->depth == 1) t->line++; p++; } + if (*p == 0) { fail(t, "comment not closed", NULL); return 0; } + r->p[r->depth - 1u] = p + 1; + continue; + } + r->p[r->depth - 1u] = p; + return 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) +{ + v4_asm *as = &t->as; + if (as->slot == 0) return; + if (!v4_iword_branch_legal(as->slot) + || (v4_ucell)v4_iword_slot_mask(as->slot) < (v4_ucell)(V4_NODE_WORDS - 1u)) + (void)v4_asm_label(as); +} + +static void check_asm(v4_text *t, const char *tok) +{ + if (t->as.error) fail(t, "does not fit: memory is full, or a branch cannot reach", tok); +} + +static void branch_to(v4_text *t, unsigned op, v4_cell target, const char *tok) +{ + place_branch(t); + v4_asm_branch(&t->as, op, target); + check_asm(t, tok); +} + +static void branch_later(v4_text *t, unsigned op, const char *name, int local) +{ + v4_text_ref *ref; + if (t->nref == V4_TEXT_MAX_REFS) { fail(t, "too many unresolved branches", name); return; } + place_branch(t); + ref = &t->ref[t->nref]; + ref->name = intern(t, name); + ref->ref = v4_asm_branch_fwd(&t->as, op); + ref->line = t->line; + ref->local = local; + check_asm(t, name); + if (!t->failed) t->nref++; +} + +/* A branch to `name`. Written as a bare name it is a call to a word. After + * a branch mnemonic it is a label of this word if the word has one, before + * or after the branch, and only otherwise a word -- so it cannot be settled + * until the word ends, even when a word of that name already exists. */ +static void branch(v4_text *t, unsigned op, const char *name, int may_be_label) +{ + const v4_text_symbol *s; + if (may_be_label) + for (unsigned i = 0; i < t->nlabel; i++) + if (strcmp(t->pool + t->label[i].name, name) == 0) { branch_to(t, op, t->label[i].addr, name); return; } + s = find(t, name); + if (s && s->kind == KIND_WORD && !may_be_label) { branch_to(t, op, s->value, name); return; } + if ((s && s->kind != KIND_WORD) || opcode_of(name) >= 0 || is_reserved(name) || is_label_def(name)) { + fail(t, "not something to branch to", name); + return; + } + { + v4_cell v; int big; + if (number_of(name, &v, &big)) { fail(t, "not something to branch to", name); return; } + } + branch_later(t, op, name, may_be_label); +} + +static void resolve(v4_text *t, unsigned i, v4_cell target) +{ + v4_asm_resolve(&t->as, t->ref[i].ref, target); + if (t->as.error) { + unsigned line = t->line; + t->line = t->ref[i].line; + fail(t, "branch cannot reach", t->pool + t->ref[i].name); + t->line = line; + } + t->ref[i] = t->ref[--t->nref]; +} + +/* The word being assembled ends: its labels go, and what was not a label of + * it must be a word. */ +static void end_word(v4_text *t) +{ + if (t->nfor) { fail(t, "FOR without NEXT or UNEXT", NULL); t->nfor = 0; } + for (unsigned i = 0; i < t->nref && !t->failed; ) { + const v4_text_symbol *s; + if (!t->ref[i].local) { i++; continue; } + t->ref[i].local = 0; + s = find(t, t->pool + t->ref[i].name); + if (s && s->kind == KIND_WORD) resolve(t, i, s->value); /* moves another into place i */ + else i++; + } + t->nlabel = 0; +} + +static void define(v4_text *t, const char *name, unsigned char kind, v4_cell value) +{ + v4_cell v; int big; + if (opcode_of(name) >= 0 || is_reserved(name) || is_label_def(name) || number_of(name, &v, &big)) { + fail(t, "cannot be used as a name", name); + return; + } + if (find(t, name)) { fail(t, "already defined", name); return; } + if (t->nsym == V4_TEXT_MAX_SYMBOLS) { fail(t, "too many names", name); return; } + t->sym[t->nsym].name = intern(t, name); + t->sym[t->nsym].kind = kind; + t->sym[t->nsym].value = value; + if (!t->failed) t->nsym++; +} + +static void define_macro(v4_text *t, reader *r) +{ + char name[V4_TEXT_MAX_TOKEN + 1u], tok[V4_TEXT_MAX_TOKEN + 1u]; + unsigned start, line = t->line; + + if (r->depth != 1) { fail(t, "macro inside a macro", NULL); return; } + if (!next_token(t, r, name)) { fail(t, "macro without a name", NULL); return; } + start = t->pool_used; + for (;;) { + size_t len; + if (!next_token(t, r, tok)) { + if (!t->failed) { t->line = line; fail(t, "macro without endmacro", name); } + return; + } + if (strcmp(tok, "endmacro") == 0) break; + if (strcmp(tok, ":") == 0 || strcmp(tok, "macro") == 0 || is_label_def(tok)) { + fail(t, "not allowed in a macro", tok); + return; + } + len = strlen(tok); + if (len + 2u > V4_TEXT_POOL - t->pool_used) { fail(t, "out of name space", name); return; } + memcpy(t->pool + t->pool_used, tok, len); + t->pool_used += (unsigned)len; + t->pool[t->pool_used++] = ' '; + } + if (t->pool_used == V4_TEXT_POOL) { fail(t, "out of name space", name); return; } + t->pool[t->pool_used++] = 0; + define(t, name, KIND_MACRO, (v4_cell)start); +} + +static void one_token(v4_text *t, reader *r, const char *tok) +{ + const v4_text_symbol *s; + v4_asm *as = &t->as; + v4_cell v; + int op, big; + + 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)); + return; + } + if (strcmp(tok, "macro") == 0) { define_macro(t, r); return; } + if (strcmp(tok, "endmacro") == 0) { fail(t, "endmacro without macro", NULL); return; } + + if (is_label_def(tok)) { + char name[V4_TEXT_MAX_TOKEN + 1u]; + v4_cell addr; + size_t len = strlen(tok) - 1u; + memcpy(name, tok, len); + name[len] = 0; + for (unsigned i = 0; i < t->nlabel; i++) + if (strcmp(t->pool + t->label[i].name, name) == 0) { fail(t, "label already defined in this word", name); return; } + if (t->nlabel == V4_TEXT_MAX_LABELS) { fail(t, "too many labels in one word", name); return; } + addr = v4_asm_label(as); + t->label[t->nlabel].name = intern(t, name); + t->label[t->nlabel].addr = addr; + t->nlabel++; + for (unsigned i = 0; i < t->nref && !t->failed; ) + if (t->ref[i].local && strcmp(t->pool + t->ref[i].name, name) == 0) resolve(t, i, addr); + else i++; + return; + } + + if (strcmp(tok, "FOR") == 0) { + if (t->nfor == V4_TEXT_MAX_DEPTH) { fail(t, "FOR nested too deep", NULL); return; } + v4_asm_op(as, V4_OP_PUSH); + t->for_addr[t->nfor++] = v4_asm_label(as); + check_asm(t, tok); + return; + } + if (strcmp(tok, "NEXT") == 0) { + if (t->nfor == 0) { fail(t, "NEXT without FOR", NULL); return; } + branch_to(t, V4_OP_NEXT, t->for_addr[--t->nfor], tok); + return; + } + if (strcmp(tok, "UNEXT") == 0) { + v4_cell body; + if (t->nfor == 0) { fail(t, "UNEXT without FOR", NULL); return; } + body = t->for_addr[--t->nfor]; + /* unext repeats the word it is in, so it must still be the word the + * body started, with a slot left, and that word must own no literal */ + if (as->here != body || as->slot == 0 || as->slot >= V4_SLOT_COUNT || as->nlit != 0) { + fail(t, "FOR ... UNEXT must fit one instruction word and hold no literal", NULL); + return; + } + v4_asm_op(as, V4_OP_UNEXT); + check_asm(t, tok); + return; + } + + op = opcode_of(tok); + if (op >= 0) { + if (op == V4_OP_FETCH_P) { fail(t, "write the number, not @p", NULL); return; } + if (v4_op_is_branch((unsigned)op)) { + char target[V4_TEXT_MAX_TOKEN + 1u]; + if (!next_token(t, r, target)) { fail(t, "branch without a target", tok); return; } + branch(t, (unsigned)op, target, 1); + return; + } + v4_asm_op(as, (unsigned)op); + check_asm(t, tok); + return; + } + + s = find(t, tok); + if (s && s->kind == KIND_MACRO) { + if (r->depth == V4_TEXT_MAX_DEPTH + 1u) { fail(t, "macros nested too deep", tok); return; } + r->p[r->depth++] = t->pool + (unsigned)s->value; + return; + } + if (number_of(tok, &v, &big)) { + if (big) { fail(t, "number does not fit a cell", tok); return; } + v4_asm_lit(as, v); + check_asm(t, tok); + return; + } + if (s && s->kind == KIND_CONST) { + v4_asm_lit(as, s->value); + check_asm(t, tok); + return; + } + branch(t, V4_OP_CALL, tok, 0); /* a word, defined already or later */ +} + +void v4_text_begin(v4_text *t, v4_node *n, v4_cell origin) +{ + v4_asm_begin(&t->as, n, origin); + t->nsym = 0; + t->nlabel = 0; + t->nref = 0; + t->nfor = 0; + t->pool_used = 0; + t->line = 0; + t->failed = 0; + t->message[0] = 0; +} + +void v4_text_constant(v4_text *t, const char *name, v4_cell value) +{ + if (t->failed) return; + if (strlen(name) > V4_TEXT_MAX_TOKEN) { fail(t, "name too long", name); return; } + define(t, name, KIND_CONST, value); +} + +int v4_text_assemble(v4_text *t, const char *source) +{ + char tok[V4_TEXT_MAX_TOKEN + 1u]; + reader r; + + if (t->failed) return 0; + r.p[0] = source; + r.depth = 1; + t->line = 1; + while (!t->failed && next_token(t, &r, tok)) one_token(t, &r, tok); + if (!t->failed) end_word(t); + return !t->failed; +} + +int v4_text_finish(v4_text *t) +{ + if (t->failed) return 0; + end_word(t); + while (t->nref && !t->failed) { + const v4_text_symbol *s = find(t, t->pool + t->ref[0].name); + if (!s || s->kind != KIND_WORD) { + t->line = t->ref[0].line; + fail(t, "never defined", t->pool + t->ref[0].name); + break; + } + resolve(t, 0, s->value); + } + if (!t->failed && !v4_asm_ok(&t->as)) fail(t, "does not fit: memory is full", NULL); + return !t->failed; +} + +v4_cell v4_text_word(const v4_text *t, const char *name) +{ + const v4_text_symbol *s = find(t, name); + return s && s->kind == KIND_WORD ? s->value : (v4_cell)-1; +} + +v4_cell v4_text_here(v4_text *t) +{ + return v4_asm_label(&t->as); +} + +const char *v4_text_error(const v4_text *t) +{ + return t->failed ? t->message : ""; +} diff --git a/v4/tests/test_text.c b/v4/tests/test_text.c new file mode 100644 index 00000000..7d514750 --- /dev/null +++ b/v4/tests/test_text.c @@ -0,0 +1,443 @@ +/* test_text.c -- the text assembler (text.h). + * + * Its job is to produce, from a definition written as text, the words the + * slot packer (asm.h) produces from the same definition written by hand. So + * the first test assembles four real definitions both ways, on two nodes, + * and compares the memory word for word; the rest check each piece of the + * notation, that what is assembled runs, and every error it reports. + */ +#include "v4/text.h" +#include "v4/testcode.h" +#include +#include + +static int failures = 0, checks = 0; +#define CHECK(c,...) do{checks++; if(!(c)){failures++; printf("FAIL %s:%d: ",__FILE__,__LINE__); printf(__VA_ARGS__); printf("\n");}}while(0) + +#define CANARY ((v4_cell)0x0C0FFEE5) +#define ORIGIN 16 +#define VARS ((v4_cell)(V4_NODE_WORDS - 16u)) + +static v4_node na, nb; /* by hand, by text */ +static v4_exec_state es; +static v4_heat h; +static v4_asm as; +static v4_text tx; /* large: not on the stack */ + +/* ---- four definitions by hand, as the other tests write them ----------- */ + +#define O(name) v4_asm_op(&as, V4_OP_##name) +#define LIT(v) v4_asm_lit(&as, (v4_cell)(v)) +#define CALL(w) v4_asm_branch(&as, V4_OP_CALL, (w)) +#define FWD(op) v4_asm_branch_fwd(&as, V4_OP_##op) +#define HERE_(r) v4_asm_resolve(&as, (r), v4_asm_label(&as)) + +static v4_cell hand_swap, hand_ummod, hand_cfetch, hand_cstore, hand_roundtrip, hand_end; + +static void build_by_hand(void) +{ + v4_node_reset(&na); + v4_asm_begin(&as, &na, ORIGIN); + + hand_swap = v4_asm_label(&as); + O(OVER); O(PUSH); O(PUSH); O(DROP); O(RPOP); O(RPOP); O(SEMI); + + { + v4_cell loop, l_sub, l_setbit, l_nosub; + v4_asm_ref r0, r1, r2, r3, r4, r5, r6, to_sub1, to_sub2, to_nosub1, to_nosub2, to_setbit; + hand_ummod = v4_asm_label(&as); + O(BANG_A); LIT(V4_CELL_BITS - 1); O(PUSH); + loop = v4_asm_label(&as); + r0 = FWD(MINUS_IF); + O(TWO_STAR); O(OVER); r1 = FWD(MINUS_IF); + O(DROP); LIT(1); O(ADD); r2 = FWD(JUMP); + HERE_(r1); O(DROP); + HERE_(r2); O(PUSH); O(TWO_STAR); O(RPOP); + to_sub1 = FWD(JUMP); + HERE_(r0); + O(TWO_STAR); O(OVER); r3 = FWD(MINUS_IF); + O(DROP); LIT(1); O(ADD); r4 = FWD(JUMP); + HERE_(r3); O(DROP); + HERE_(r4); O(PUSH); O(TWO_STAR); O(RPOP); + O(DUP); O(PUSH_A); O(XOR); r5 = FWD(MINUS_IF); + O(DROP); to_nosub1 = FWD(MINUS_IF); + to_sub2 = FWD(JUMP); + HERE_(r5); + O(DROP); O(DUP); O(INV); O(PUSH_A); O(ADD); O(INV); r6 = FWD(MINUS_IF); + O(DROP); to_nosub2 = FWD(JUMP); + HERE_(r6); + O(PUSH); O(DROP); O(RPOP); to_setbit = FWD(JUMP); + l_sub = v4_asm_label(&as); + O(INV); O(PUSH_A); O(ADD); O(INV); + l_setbit = v4_asm_label(&as); + O(PUSH); LIT(1); O(ADD); O(RPOP); + l_nosub = v4_asm_label(&as); + v4_asm_branch(&as, V4_OP_NEXT, loop); + O(OVER); O(PUSH); O(PUSH); O(DROP); O(RPOP); O(RPOP); O(SEMI); + v4_asm_resolve(&as, to_sub1, l_sub); + v4_asm_resolve(&as, to_sub2, l_sub); + v4_asm_resolve(&as, to_setbit, l_setbit); + v4_asm_resolve(&as, to_nosub1, l_nosub); + v4_asm_resolve(&as, to_nosub2, l_nosub); + } + + { + v4_asm_ref f0, f1, f2; + hand_cfetch = v4_asm_label(&as); + O(DUP); O(TWO_SLASH); O(TWO_SLASH); O(BANG_A); LIT(3); O(AND); + f0 = FWD(IF); + LIT(-1); O(ADD); f1 = FWD(IF); + LIT(-1); O(ADD); f2 = FWD(IF); + O(DROP); O(FETCH_A); LIT(23); O(PUSH); + (void)v4_asm_label(&as); + O(TWO_SLASH); O(UNEXT); + LIT(255); O(AND); O(SEMI); + HERE_(f2); + O(DROP); O(FETCH_A); LIT(15); O(PUSH); + (void)v4_asm_label(&as); + O(TWO_SLASH); O(UNEXT); + LIT(255); O(AND); O(SEMI); + HERE_(f1); + O(DROP); O(FETCH_A); LIT(7); O(PUSH); + (void)v4_asm_label(&as); + O(TWO_SLASH); O(UNEXT); + LIT(255); O(AND); O(SEMI); + HERE_(f0); + O(DROP); O(FETCH_A); LIT(255); O(AND); O(SEMI); + } + + { + v4_asm_ref k0, k1, k2; + hand_cstore = v4_asm_label(&as); + O(DUP); O(TWO_SLASH); O(TWO_SLASH); O(BANG_A); + LIT(3); O(AND); O(PUSH); LIT(255); O(AND); O(RPOP); + k0 = FWD(IF); + LIT(-1); O(ADD); k1 = FWD(IF); + LIT(-1); O(ADD); k2 = FWD(IF); + O(DROP); LIT(23); O(PUSH); + (void)v4_asm_label(&as); + O(TWO_STAR); O(UNEXT); + O(FETCH_A); LIT((v4_cell)(v4_ucell)0xFF000000u); O(INV); O(AND); O(ADD); O(STORE_A); O(SEMI); + HERE_(k2); + O(DROP); LIT(15); O(PUSH); + (void)v4_asm_label(&as); + O(TWO_STAR); O(UNEXT); + O(FETCH_A); LIT(-16711681); O(AND); O(ADD); O(STORE_A); O(SEMI); + HERE_(k1); + O(DROP); LIT(7); O(PUSH); + (void)v4_asm_label(&as); + O(TWO_STAR); O(UNEXT); + O(FETCH_A); LIT(-65281); O(AND); O(ADD); O(STORE_A); O(SEMI); + HERE_(k0); + O(DROP); O(FETCH_A); LIT(-256); O(AND); O(ADD); O(STORE_A); O(SEMI); + } + + /* ( c baddr -- c' ) dup push C! pop C@ ; calls, one of them backward */ + hand_roundtrip = v4_asm_label(&as); + O(DUP); O(PUSH); CALL(hand_cstore); O(RPOP); v4_asm_branch(&as, V4_OP_JUMP, hand_cfetch); + + hand_end = v4_asm_label(&as); + CHECK(v4_asm_ok(&as), "the hand-written words assemble"); +} + +/* The same four, as DECOMPOSITION.md writes them. */ +static const char source[] = + "\\ four words from DECOMPOSITION.md sections 4 and 5.3\n" + "macro SWAP over push push drop pop pop endmacro\n" + "\n" + ": SWAP' ( a b -- b a ) SWAP ;\n" + "\n" + ": UM/MOD ( ulo uhi ud -- urem uquot )\n" + " a! N-1 FOR\n" + " -if L0 \\ hi's top bit set\n" + " 2* over -if L1 drop 1 + jump L2\n" + " L1: drop L2: push 2* pop\n" + " jump SUB\n" + " L0:\n" + " 2* over -if L3 drop 1 + jump L4\n" + " L3: drop L4: push 2* pop\n" + " dup a xor -if L5\n" + " drop -if NOSUB jump SUB\n" + " L5: drop dup inv a + inv -if L6\n" + " drop jump NOSUB\n" + " L6: push drop pop jump SETBIT\n" + " SUB: inv a + inv\n" + " SETBIT: push 1 + pop\n" + " NOSUB:\n" + " NEXT\n" + " SWAP ;\n" + "\n" + ": C@ ( baddr -- c )\n" + " dup 2/ 2/ a! 3 and\n" + " if K0 -1 + if K1 -1 + if K2\n" + " drop @ 23 FOR 2/ UNEXT 255 and ;\n" + " K2: drop @ 15 FOR 2/ UNEXT 255 and ;\n" + " K1: drop @ 7 FOR 2/ UNEXT 255 and ;\n" + " K0: drop @ 255 and ;\n" + "\n" + ": C! ( c baddr -- )\n" + " dup 2/ 2/ a! 3 and push 255 and pop\n" + " if K0 -1 + if K1 -1 + if K2\n" + " drop 23 FOR 2* UNEXT @ 4278190080 inv and + ! ;\n" + " K2: drop 15 FOR 2* UNEXT @ -16711681 and + ! ;\n" + " K1: drop 7 FOR 2* UNEXT @ -65281 and + ! ;\n" + " K0: drop @ -256 and + ! ;\n" + "\n" + ": ROUNDTRIP ( c baddr -- c' ) dup push C! pop jump C@\n"; + +/* ---- running on the text-assembled node -------------------------------- */ + +static int call(v4_node *n, v4_cell word, unsigned argc, v4_cell a, v4_cell b, v4_cell c) +{ + v4_dstack_reset(&n->ds); + v4_rstack_reset(&n->rs); + v4_exec_reset(&es); + v4_heat_reset(&h); + v4_dstack_push(&n->ds, CANARY); + if (argc > 0) v4_dstack_push(&n->ds, a); + if (argc > 1) v4_dstack_push(&n->ds, b); + if (argc > 2) v4_dstack_push(&n->ds, c); + return word >= 0 && v4_test_call(n, &es, &h, word, 100000) > 0; +} +static v4_cell pop(v4_node *n) { return v4_dstack_pop(&n->ds); } + +/* Assemble `src` on a fresh node; 1 if it assembles and finishes. */ +static int ok(const char *src) +{ + v4_node_reset(&nb); + v4_text_begin(&tx, &nb, ORIGIN); + v4_text_constant(&tx, "VAR", VARS); + return v4_text_assemble(&tx, src) && v4_text_finish(&tx); +} +/* Assemble `src`; 1 if it is refused with a message holding `what`, and, + * when `line` is not 0, naming that line. */ +static int refused(const char *src, const char *what, unsigned line) +{ + char want[32]; + if (ok(src)) return 0; + snprintf(want, sizeof want, "line %u:", line); + if (strstr(v4_text_error(&tx), what) == NULL) { printf(" message was: %s\n", v4_text_error(&tx)); return 0; } + if (line && strncmp(v4_text_error(&tx), want, strlen(want)) != 0) { printf(" message was: %s\n", v4_text_error(&tx)); return 0; } + return 1; +} +/* Run the word NAME of the last assembly on up to two arguments; its one result. */ +static v4_cell result(const char *name, unsigned argc, v4_cell a, v4_cell b) +{ + v4_cell r; + if (!call(&nb, v4_text_word(&tx, name), argc, a, b, 0)) return (v4_cell)0x0BADBAD; + r = pop(&nb); + return pop(&nb) == CANARY ? r : (v4_cell)0x0BADBAD; +} + +int main(void) +{ + unsigned i; + + printf("v4 text assembler tests: V4_CELL_BITS=%d\n", V4_CELL_BITS); + + /* ---- the same words by hand and by text ---- */ + build_by_hand(); + + v4_node_reset(&nb); + v4_text_begin(&tx, &nb, ORIGIN); + v4_text_constant(&tx, "N-1", V4_CELL_BITS - 1); + CHECK(v4_text_assemble(&tx, source), "the text assembles: %s", v4_text_error(&tx)); + CHECK(v4_text_finish(&tx), "and finishes: %s", v4_text_error(&tx)); + CHECK(v4_text_error(&tx)[0] == 0, "with no error message"); + + CHECK(v4_text_word(&tx, "SWAP'") == hand_swap, "SWAP' is where the hand-written one is"); + CHECK(v4_text_word(&tx, "UM/MOD") == hand_ummod, "UM/MOD is where the hand-written one is"); + CHECK(v4_text_word(&tx, "C@") == hand_cfetch, "C@ is where the hand-written one is"); + CHECK(v4_text_word(&tx, "C!") == hand_cstore, "C! is where the hand-written one is"); + CHECK(v4_text_word(&tx, "ROUNDTRIP") == hand_roundtrip, "ROUNDTRIP is where the hand-written one is"); + CHECK(v4_text_here(&tx) == hand_end, "the text ends where the hand-written code ends: %ld, %ld", + (long)v4_text_here(&tx), (long)hand_end); + CHECK(hand_end - ORIGIN > 60, "the comparison covers a real amount of code: %ld words", (long)(hand_end - ORIGIN)); + for (i = 0; i < V4_NODE_WORDS; i++) if (na.mem[i] != nb.mem[i]) break; + CHECK(i == V4_NODE_WORDS, "every word of memory is the same; first difference at %u", i); + CHECK(v4_text_word(&tx, "SWAP") == -1 && v4_text_word(&tx, "N-1") == -1 && v4_text_word(&tx, "NOPE") == -1, + "a macro, a constant and an unknown name are not words"); + + /* and they run */ + CHECK(call(&nb, v4_text_word(&tx, "UM/MOD"), 3, 100, 0, 7) && pop(&nb) == 14 && pop(&nb) == 2 && pop(&nb) == CANARY, + "100 0 7 UM/MOD is 2 14"); + for (i = 0; i < 8; i++) { + v4_cell baddr = VARS * 4 + (v4_cell)i; + CHECK(call(&nb, v4_text_word(&tx, "ROUNDTRIP"), 2, (v4_cell)(0x341 + i), baddr, 0) + && pop(&nb) == (v4_cell)((0x41 + i) & 0xFF) && pop(&nb) == CANARY, "C! then C@ at byte %u", i); + } + + /* ---- the notation, piece by piece ---- */ + + /* numbers */ + CHECK(ok(": T 123 ;") && result("T", 0, 0, 0) == 123, "a decimal literal"); + CHECK(ok(": T -5 ;") && result("T", 0, 0, 0) == -5, "a negative literal"); + CHECK(ok(": T $FF ;") && result("T", 0, 0, 0) == 255, "a hex literal"); + CHECK(ok(": T $ff $Ab + ;") && result("T", 0, 0, 0) == 255 + 0xAB, "hex in either case"); + CHECK(ok(": T 0 ;") && result("T", 0, 0, 0) == 0, "zero"); + CHECK(ok(": T 1 2 3 4 5 6 7 + + + + + + ;") && result("T", 0, 0, 0) == 28, "seven literals in a row"); +#if V4_CELL_BITS == 32 + CHECK(ok(": T 4294967295 ;") && result("T", 0, 0, 0) == -1, "the largest unsigned number is all ones"); + CHECK(ok(": T -2147483648 ;") && result("T", 0, 0, 0) == (v4_cell)V4_MSB, "the most negative number"); + CHECK(ok(": T $FFFFFFFF ;") && result("T", 0, 0, 0) == -1, "eight hex digits"); + CHECK(refused(": T 4294967296 ;", "does not fit a cell", 1), "one more than fits is refused"); + CHECK(refused(": T -2147483649 ;", "does not fit a cell", 1), "one less than fits is refused"); + CHECK(refused(": T $100000000 ;", "does not fit a cell", 1), "nine hex digits are refused"); +#else + CHECK(ok(": T 18446744073709551615 ;") && result("T", 0, 0, 0) == -1, "the largest unsigned number is all ones"); + CHECK(ok(": T -9223372036854775808 ;") && result("T", 0, 0, 0) == (v4_cell)V4_MSB, "the most negative number"); + CHECK(ok(": T $FFFFFFFFFFFFFFFF ;") && result("T", 0, 0, 0) == -1, "sixteen hex digits"); + CHECK(refused(": T 18446744073709551616 ;", "does not fit a cell", 1), "one more than fits is refused"); + CHECK(refused(": T -9223372036854775809 ;", "does not fit a cell", 1), "one less than fits is refused"); + CHECK(refused(": T $10000000000000000 ;", "does not fit a cell", 1), "seventeen hex digits are refused"); +#endif + CHECK(refused(": T 99999999999999999999999999 ;", "does not fit a cell", 1), "a very long number is refused"); + + /* constants */ + CHECK(ok(": T VAR ;") && result("T", 0, 0, 0) == VARS, "a constant is a literal"); + CHECK(ok(": ST ( x -- ) VAR a! ! ; : LD ( -- x ) VAR a! @ ;") + && call(&nb, v4_text_word(&tx, "ST"), 1, 4321, 0, 0) && pop(&nb) == CANARY + && result("LD", 0, 0, 0) == 4321 && nb.mem[VARS] == 4321, "a constant used as an address"); + + /* comments */ + CHECK(ok("\\ a line comment\n: T ( a stack comment ) 7 \\ another\n ( and\n one over two lines ) 8 + ; \\ the end") + && result("T", 0, 0, 0) == 15, "comments are skipped"); + CHECK(ok(": (T) 5 ; : T (T) (T) + ;") && result("T", 0, 0, 0) == 10, "a name in parentheses is a name, not a comment"); + CHECK(refused(": T 1 ( never closed", "comment not closed", 0), "an open comment is refused"); + + /* every opcode has its mnemonic */ + { + static const char *const m[V4_OPCODE_COUNT] = { + ";", "ex", "jump", "call", "unext", "next", "if", "-if", "@p", "@+", "@b", "@", "!p", "!+", "!b", "!", + "+*", "2*", "2/", "inv", "+", "and", "xor", "drop", "dup", "pop", "over", "a", "nop", "push", "b!", "a!" }; + for (i = 0; i < V4_OPCODE_COUNT; i++) { + char src[64]; + unsigned op; + if (v4_op_is_branch(i) || i == V4_OP_FETCH_P) continue; + snprintf(src, sizeof src, ": T %s", m[i]); + CHECK(ok(src), "opcode %s assembles", m[i]); + op = (unsigned)(((v4_ucell)nb.mem[ORIGIN] >> V4_SLOT_LOW_BIT(0)) & 0x1Fu); + CHECK(op == i, "%s is opcode %u, got %u", m[i], i, op); + } + } + CHECK(refused(": T @p ;", "write the number", 1), "@p cannot be written"); + + /* calls: backward, forward, and across calls to v4_text_assemble */ + CHECK(ok(": A 3 ; : T A A + ;") && result("T", 0, 0, 0) == 6, "a call to an earlier word"); + CHECK(ok(": T A A + ; : A 4 ;") && result("T", 0, 0, 0) == 8, "a call to a later word"); + CHECK(ok(": T jump A : A 9 ;") && result("T", 0, 0, 0) == 9, "a jump to a later word"); + CHECK(ok(": T call A 1 + ; : A 9 ;") && result("T", 0, 0, 0) == 10, "call NAME is the same as NAME"); + v4_node_reset(&nb); + v4_text_begin(&tx, &nb, ORIGIN); + CHECK(v4_text_assemble(&tx, ": T B 1 + ;") && v4_text_assemble(&tx, "macro TWICE dup + endmacro : B 20 TWICE ;") + && v4_text_finish(&tx) && result("T", 0, 0, 0) == 41, "a word defined in a later assembly; macros carry over"); + CHECK(v4_text_assemble(&tx, ": U T TWICE ;") && v4_text_finish(&tx) && result("U", 0, 0, 0) == 82, + "assembling goes on after a finish"); + CHECK(ok(": A 1 ; : B A A + ; : C B B + ; : T C C + ;") && result("T", 0, 0, 0) == 8, "calls three deep"); + CHECK(ok(": T 5 \n : U 1 + ;") && result("T", 0, 0, 0) == 6, "a word with no ; runs on into the next"); + + /* labels */ + CHECK(ok(": T ( n -- 1|2 ) if Z drop 1 ; Z: drop 2 ;") && result("T", 1, 5, 0) == 1 && result("T", 1, 0, 0) == 2, + "a forward label"); + CHECK(ok(": T ( n -- 0 ) L: if DONE -1 + jump L DONE: ;") && result("T", 1, 9, 0) == 0, "a backward label"); + CHECK(ok(": T ( n -- f ) -if P drop -1 ; P: drop 0 ;") && result("T", 1, -3, 0) == -1 && result("T", 1, 3, 0) == 0, + "-if to a label"); + CHECK(ok(": A ( n -- 1|2 ) if L drop 1 ; L: drop 2 ; : T ( n -- 3|4 ) if L drop 3 ; L: drop 4 ;") + && result("A", 1, 0, 0) == 2 && result("T", 1, 0, 0) == 4 && result("T", 1, 1, 0) == 3, + "the same label name in two words"); + CHECK(ok(": L 50 ; : T ( n -- x ) if L drop 1 ; L: drop 2 ;") && result("T", 1, 0, 0) == 2, + "a label of this word comes before a word of the same name, even defined after the branch"); + CHECK(ok(": L 50 ; : T ( n -- x ) L: if DONE -1 + jump L DONE: drop 3 ;") && result("T", 1, 4, 0) == 3, + "and defined before it"); + CHECK(ok(": L drop 50 ; : T ( n -- x ) if L drop 1 ; : U 2 ;") && result("T", 1, 0, 0) == 50, + "with no such label the branch goes to the word"); + CHECK(ok(": L drop 50 ; : T ( n -- x ) if L drop 1 ;") && result("T", 1, 0, 0) == 50, + "also when the text ends there"); + CHECK(ok(": T ( n -- x ) if OUT drop 1 ; : OUT drop 77 ;") && result("T", 1, 0, 0) == 77 && result("T", 1, 4, 0) == 1, + "a branch target that is no label of its word is a word"); + CHECK(refused(": T L: 1 L: 2 ;", "label already defined", 1), "a label twice in one word is refused"); + CHECK(refused(": T if NOWHERE ;\n: U 1 ;", "never defined", 1), "a branch to nothing is refused, with its line"); + CHECK(refused("\n\n: T 1 MISSING + ;", "never defined", 3), "a call to nothing is refused, with its line"); + CHECK(refused(": T jump", "branch without a target", 1), "a branch with nothing after it is refused"); + CHECK(refused(": T jump 5 ;", "not something to branch to", 1), "a branch to a number is refused"); + CHECK(refused(": T jump VAR ;", "not something to branch to", 1), "a branch to a constant is refused"); + CHECK(refused(": T jump dup ;", "not something to branch to", 1), "a branch to an opcode is refused"); + + /* FOR ... NEXT and FOR ... UNEXT */ + CHECK(ok(": T ( n -- n+5 ) 4 FOR 1 + NEXT ;") && result("T", 1, 10, 0) == 15, "FOR NEXT runs its body n+1 times"); + CHECK(ok(": T ( n -- n*8 ) 2 FOR 2* UNEXT ;") && result("T", 1, 3, 0) == 24, "FOR UNEXT runs its body n+1 times"); + CHECK(ok(": T ( n -- x ) 1 FOR 2 FOR 2* UNEXT NEXT ;") && result("T", 1, 1, 0) == 64, "UNEXT inside NEXT"); + CHECK(ok(": T ( n -- x ) 2 FOR 2* UNEXT 1 + ;") && result("T", 1, 1, 0) == 9, "code after UNEXT shares its word"); + CHECK(ok(": T ( n -- x ) 2 FOR dup + 2* nop UNEXT ;") && result("T", 1, 1, 0) == 64, "a body of four slots and unext fit"); + CHECK(refused(": T 2 FOR dup + 2* nop nop nop UNEXT ;", "must fit one instruction word", 1), "a body of six slots does not"); + CHECK(refused(": T 2 FOR 1 + UNEXT ;", "must fit one instruction word", 1), "a literal in an UNEXT body is refused"); + CHECK(refused(": T NEXT ;", "NEXT without FOR", 1), "NEXT alone is refused"); + CHECK(refused(": T UNEXT ;", "UNEXT without FOR", 1), "UNEXT alone is refused"); + CHECK(refused(": T 3 FOR 1 + ;\n: U ;", "FOR without NEXT", 2), "FOR left open is refused"); + CHECK(refused(": T 0 FOR 0 FOR 0 FOR 0 FOR 0 FOR 0 FOR 0 FOR 0 FOR 0 FOR ;", "nested too deep", 1), "nine FORs deep is refused"); + + /* macros */ + CHECK(ok("macro SWAP over push push drop pop pop endmacro : T ( a b -- b ) SWAP drop ;") + && result("T", 2, 3, 10) == 10, "a macro is laid down in line"); + CHECK(ok("macro 1+ 1 + endmacro macro 2+ 1+ 1+ endmacro : T 2+ 2+ ;") && result("T", 1, 5, 0) == 9, "macros in macros"); + CHECK(ok("macro TEN ( a comment ) 10 \\ and another\n endmacro : T TEN TEN + ;") && result("T", 0, 0, 0) == 20, + "comments inside a macro are dropped"); + CHECK(ok("macro SHL3 2 FOR 2* UNEXT endmacro : T SHL3 ;") && result("T", 1, 1, 0) == 8, "FOR UNEXT in a macro"); + CHECK(ok(": A 6 ; macro CALLS A A + endmacro : T CALLS ;") && result("T", 0, 0, 0) == 12, "a macro that calls words"); + CHECK(ok("macro NOTHING endmacro : T 5 NOTHING ;") && result("T", 0, 0, 0) == 5, "an empty macro"); + CHECK(refused("macro M L: endmacro", "not allowed in a macro", 1), "a label in a macro is refused"); + CHECK(refused("macro M : X ; endmacro", "not allowed in a macro", 1), "a word in a macro is refused"); + CHECK(refused("macro M macro N endmacro endmacro", "not allowed in a macro", 1), "a macro in a macro is refused"); + CHECK(refused("macro M 1 2 3", "macro without endmacro", 1), "a macro left open is refused"); + CHECK(refused("macro", "macro without a name", 0), "macro with no name is refused"); + CHECK(refused(": T endmacro ;", "endmacro without macro", 1), "endmacro alone is refused"); + CHECK(refused("macro M M endmacro : T M ;", "nested too deep", 1), "a macro that uses itself is refused"); + + /* names */ + CHECK(refused(": A 1 ;\n: A 2 ;", "already defined", 2), "a word defined twice is refused"); + CHECK(refused(": VAR 1 ;", "already defined", 1), "a word named like a constant is refused"); + CHECK(refused("macro A 1 endmacro : A 2 ;", "already defined", 1), "a word named like a macro is refused"); + CHECK(refused(": dup 1 ;", "cannot be used as a name", 1), "a word named like an opcode is refused"); + CHECK(refused(": 12 1 ;", "cannot be used as a name", 1), "a word named like a number is refused"); + CHECK(refused(": FOR 1 ;", "cannot be used as a name", 1), "a word named FOR is refused"); + CHECK(refused("macro + 1 endmacro", "cannot be used as a name", 1), "a macro named like an opcode is refused"); + CHECK(refused(": X: 1 ;", "cannot be used as a name", 1), "a word named like a label is refused"); + CHECK(refused(":", ": without a name", 0), ": with no name is refused"); + CHECK(refused(": T THIS-NAME-IS-MUCH-TOO-LONG-TO-BE-A-NAME-IN-THIS-ASSEMBLER-BY-A-WIDE-MARGIN ;", "name too long", 1), + "a name of more than 63 characters is refused"); + CHECK(ok(": Dup 3 ; : T Dup Dup + ;") && result("T", 0, 0, 0) == 6, "names are case sensitive"); + 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"); + + /* 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)); + + /* a full node */ + { + static char big[8 * V4_NODE_WORDS + 64]; + size_t at = 0; + at += (size_t)sprintf(big + at, ": T "); + for (i = 0; i < V4_NODE_WORDS; i++) at += (size_t)sprintf(big + at, "1 2 3 "); + CHECK(refused(big, "does not fit", 1), "text that overflows the node is refused"); + CHECK(v4_node_guards_intact(&nb), "and wrote nothing outside it"); + } + + /* a branch always reaches: fill most of the node, then branch across it */ + { + static char far[8 * V4_NODE_WORDS + 256]; + size_t at = 0; + at += (size_t)sprintf(far + at, ": T ( n -- x ) nop nop nop if FAR drop 7 ; "); + at += (size_t)sprintf(far + at, ": PAD "); + for (i = 0; i < V4_NODE_WORDS - 200u; i++) at += (size_t)sprintf(far + at, "nop ; "); + at += (size_t)sprintf(far + at, ": FAR drop 99 ; "); + CHECK(ok(far) && result("T", 1, 0, 0) == 99 && result("T", 1, 6, 0) == 7, + "a branch from a late slot to the other end of the node: %s", v4_text_error(&tx)); + CHECK(v4_text_word(&tx, "FAR") > (v4_cell)(V4_NODE_WORDS - 200u), "FAR is far: %ld", (long)v4_text_word(&tx, "FAR")); + } + + CHECK(v4_node_guards_intact(&na) && v4_node_guards_intact(&nb), "guards intact"); + + printf(" %d checks, %d failures\n", checks, failures); + return failures ? 1 : 0; +}