LithosAnanake/v4/tests/test_host_dict.c

/* test_host_dict.c -- the dictionary, executed on the host node.
 *
 * DECOMPOSITION.md 5.12 and 5.13: HERE ALIGN ALLOT , C, 2, PAD LATEST, FIND
 * and ', and the entry-field words.  The definitions are text,
 * capsules/v4/sys/dict.f18, on top of core.f18 and input.f18.
 *
 * v4's dictionary is new: v3's was a C structure and its words handed out
 * host pointers.  What carries over is what the words mean:
 *   HERE  the next free address        ,  C,  2,  append a cell, a byte, a double
 *   ALLOT reserve space                ALIGN  round the pointer up to a cell
 *   FIND  ( -- xt | 0 ) the word named next in the input, 0 if there is none
 *         (v3 and FORTH-79 agree, and so does v4)
 *   '     FORTH-79: its parameter field address; not found is an error.
 *         v3's ' returned what FIND returns.  For a word that is code the
 *         two are the same address; for a data word (one made by CREATE,
 *         VARIABLE or CONSTANT) the parameter field is the cell after its
 *         code, which is what FORTH-79's  n ' NAME !  idiom needs.
 *   xt    as in v3, the one handle the field words take: >LINK LFA LINK>
 *         >NAME NFA NAME> CFA PFA >BODY
 * An address unit is a cell (D-1), so ALLOT counts cells where v3's counted
 * bytes, and HERE moves by 1 for a cell where v3's moved by 8.
 *
 * v3's LATEST pushes HERE, not the latest word (reported, not fixed); here
 * it is the newest entry's xt.
 */
#include "v4/text.h"
#include "v4/testcode.h"
#include <stdint.h>
#include <stdio.h>
#include <string.h>

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 DICT_W       ((v4_cell)4096)            /* dictionary space: words 4096 .. 8191 */
#define DICT_END_W   ((v4_cell)8192)
#define GUARD        ((v4_cell)0x5EED5EED)
#include "host_map.h"

static v4_node       n;
static v4_exec_state es;
static v4_heat       h;
static v4_text       tx;

static unsigned char byte_at(v4_cell baddr)
{
    return (unsigned char)(((v4_ucell)n.mem[baddr >> 2] >> (8u * (unsigned)(baddr & 3))) & 0xFFu);
}
static void put_bytes(v4_cell baddr, const void *src, unsigned len)
{
    const unsigned char *s = (const unsigned char *)src;
    for (unsigned i = 0; i < len; i++) {
        v4_cell ba = baddr + (v4_cell)i;
        unsigned sh = 8u * (unsigned)(ba & 3);
        v4_ucell w = (v4_ucell)n.mem[ba >> 2];
        n.mem[ba >> 2] = (v4_cell)((w & ~((v4_ucell)0xFFu << sh)) | ((v4_ucell)s[i] << sh));
    }
}
static void set_line(const char *s)
{
    unsigned len = (unsigned)strlen(s);
    put_bytes(TIB, s, len + 1u);
    n.mem[SPAN] = (v4_cell)len;
    n.mem[TO_IN] = 0;
}
static v4_cell W(const char *name)
{
    v4_cell w = v4_text_word(&tx, name);
    if (w < 0) { failures++; printf("FAIL: no word %s\n", name); }
    return w;
}
static void fresh(void)
{
    v4_dstack_reset(&n.ds);
    v4_rstack_reset(&n.rs);
    v4_exec_reset(&es);
    v4_heat_reset(&h);
    n.mem[NODE_ERROR] = 0;
    v4_dstack_push(&n.ds, CANARY);
}
static int go(const char *name) { return v4_test_call(&n, &es, &h, W(name), 4000000) > 0; }
static int run(const char *name, unsigned argc, v4_cell a, v4_cell b)
{
    fresh();
    if (argc > 0) v4_dstack_push(&n.ds, a);
    if (argc > 1) v4_dstack_push(&n.ds, b);
    return go(name);
}
static v4_cell pop(void) { return v4_dstack_pop(&n.ds); }
static int clean(void)   { return pop() == CANARY; }
static int err(void)     { return n.mem[NODE_ERROR] != 0; }
/* word ( -- x ) or ( a -- x ): its one result, or a value no test expects */
static v4_cell get(const char *name, unsigned argc, v4_cell a)
{
    v4_cell r;
    if (!run(name, argc, a, 0)) return (v4_cell)0x0BADBAD;
    r = pop();
    return clean() ? r : (v4_cell)0x0BADBAD;
}

static void empty_dictionary(void)
{
    for (v4_cell i = DICT_W - 1; i <= DICT_END_W; i++) n.mem[i] = GUARD;
    n.mem[DP] = DICT_W * 4;
    n.mem[LATEST] = 0;
}

/* Make an entry named `name` through WORD and (HEADER); its xt, or 0 if
 * none was made. */
static v4_cell define(const char *name)
{
    v4_cell was = n.mem[LATEST];
    set_line(name);
    if (!run("MAKE", 0, 0, 0) || !clean()) return 0;
    return n.mem[LATEST] != was ? n.mem[LATEST] : 0;
}
/* FIND on the text `name`. */
static v4_cell find(const char *name)
{
    set_line(name);
    return get("FIND", 0, 0);
}
/* The counted name of entry xt is `want` (cut to 31), zero-padded to a cell,
 * and its fields are in place. */
static int entry_is(v4_cell xt, const char *want, v4_cell link, v4_cell flags)
{
    unsigned len = (unsigned)strlen(want), cells, i;
    v4_cell nfa;
    if (len > 31) len = 31;
    cells = (len + 4) / 4;
    nfa = xt - 3 - (v4_cell)cells;
    if (n.mem[xt - 1] != link || n.mem[xt - 2] != nfa || n.mem[xt - 3] != flags) return 0;
    if (byte_at(nfa * 4) != len) return 0;
    for (i = 0; i < len; i++) if (byte_at(nfa * 4 + 1 + (v4_cell)i) != (unsigned char)want[i]) return 0;
    for (i = len + 1; i < cells * 4; i++) if (byte_at(nfa * 4 + (v4_cell)i) != 0) return 0;
    return 1;
}

static uint32_t rng = 0x1234ABCDu;
static uint32_t rnd(void) { rng ^= rng << 13; rng ^= rng >> 17; rng ^= rng << 5; return rng; }

/* Stack headroom, as in test_foundation.c. */
typedef void (*setup_fn)(void);
static int fits(const char *name, setup_fn setup, unsigned argc, v4_cell a, unsigned nres, const v4_cell *want,
                unsigned dfill, unsigned rfill)
{
    unsigned i;
    setup();
    v4_dstack_reset(&n.ds);
    v4_rstack_reset(&n.rs);
    v4_exec_reset(&es);
    n.mem[NODE_ERROR] = 0;
    for (i = 0; i < dfill; i++) v4_dstack_push(&n.ds, (v4_cell)(0x5A000000 + i));
    v4_dstack_push(&n.ds, CANARY);
    if (argc > 0) v4_dstack_push(&n.ds, a);
    for (i = 0; i < rfill; i++) v4_rstack_push(&n.rs, (v4_cell)(0x6B000000 + i));
    if (!go(name)) return 0;
    for (i = nres; i-- > 0; ) if (pop() != want[i]) return 0;
    if (pop() != CANARY) return 0;
    for (i = dfill; i-- > 0; ) if (pop() != (v4_cell)(0x5A000000 + i)) return 0;
    for (i = rfill; i-- > 0; ) if (v4_rstack_pop(&n.rs) != (v4_cell)(0x6B000000 + i)) return 0;
    return !err();
}
static void headroom(const char *name, setup_fn setup, unsigned argc, v4_cell a, unsigned nres, int min_d, int min_r)
{
    v4_cell want[2];
    unsigned i;
    int dh, rh;
    setup();
    CHECK(run(name, argc, a, 0), "%s runs", name);
    for (i = nres; i-- > 0; ) want[i] = pop();
    for (dh = 0; dh < V4_DATA_DEPTH; dh++) if (!fits(name, setup, argc, a, nres, want, (unsigned)dh + 1u, 0)) break;
    for (rh = 0; rh < V4_RET_DEPTH; rh++) if (!fits(name, setup, argc, a, nres, want, 0, (unsigned)rh + 1u)) break;
    printf("  %-8s headroom: data %d below canary, return %d below its return address\n", name, dh, rh);
    CHECK(dh >= min_d && rh >= min_r, "%s leaves room", name);
}
static void setup_three(void)
{
    empty_dictionary();
    (void)define("ALPHA"); (void)define("BETA"); (void)define("GAMMA");
    set_line("ALPHA rest");
}
static void setup_new(void)   { empty_dictionary(); set_line("NEWWORD rest"); }

int main(void)
{
    unsigned i, t;
    v4_cell a, b, c, capsule_latest;

    printf("v4 host dictionary tests: V4_CELL_BITS=%d, V4_NODE_WORDS=%u\n", V4_CELL_BITS, (unsigned)V4_NODE_WORDS);

    {
        static const char *const files[] = { "core.f18", "input.f18", "dict.f18" };
        CHECK(host_load(&tx, &n, files, 3), "the capsule assembles");
    }
    capsule_latest = v4_text_latest(&tx);
    CHECK(v4_text_assemble(&tx,
              ": 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 */
              "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");
    printf("  code: %ld words\n", (long)v4_text_here(&tx) - 16);
    if (failures) { printf("  %d checks, %d failures\n", checks, failures); return 1; }
    n.mem[BASE] = 10;

    /* ---- the space: HERE , C, 2, ALIGN ALLOT ---- */
    empty_dictionary();
    CHECK(get("HERE", 0, 0) == DICT_W, "HERE starts at the dictionary's first cell");
    CHECK(run(",", 1, 111, 0) && clean() && !err() && n.mem[DICT_W] == 111 && get("HERE", 0, 0) == DICT_W + 1, ", stores a cell and HERE moves by 1");
    CHECK(run(",", 1, -222, 0) && clean() && n.mem[DICT_W + 1] == -222 && get("HERE", 0, 0) == DICT_W + 2, "the next cell");

    /* C, packs four to a cell; HERE is the next whole cell; , aligns first */
    n.mem[DICT_W + 2] = 0;
    for (i = 0; i < 4; i++) {
        CHECK(run("C,", 1, (v4_cell)(0x100 + 'a' + i), 0) && clean() && !err(), "C, [%u]", i);
        CHECK(byte_at((DICT_W + 2) * 4 + (v4_cell)i) == 'a' + i, "C, stores the low byte at the next byte [%u]", i);
        CHECK(get("HERE", 0, 0) == DICT_W + 3, "HERE is the next whole cell after %u bytes", i + 1);
    }
    CHECK(run("C,", 1, 'e', 0) && clean() && get("HERE", 0, 0) == DICT_W + 4 && n.mem[DP] == (DICT_W + 3) * 4 + 1, "a fifth byte starts another cell");
    CHECK(run(",", 1, 333, 0) && clean() && n.mem[DICT_W + 4] == 333 && n.mem[DP] == (DICT_W + 5) * 4, ", after C, goes in the next whole cell");
    CHECK(byte_at((DICT_W + 3) * 4) == 'e', "and leaves the byte alone");
    CHECK(run("C,", 1, 'f', 0) && clean() && run("ALIGN", 0, 0, 0) && clean() && n.mem[DP] == (DICT_W + 6) * 4, "ALIGN rounds up to a cell");
    CHECK(run("ALIGN", 0, 0, 0) && clean() && n.mem[DP] == (DICT_W + 6) * 4, "ALIGN when aligned does nothing");

    /* 2, : the low cell first, as v3 (HERE 1 2 2, : the first cell holds 1) */
    CHECK(run("2,", 2, 1, 2) && clean() && n.mem[DICT_W + 6] == 1 && n.mem[DICT_W + 7] == 2 && get("HERE", 0, 0) == DICT_W + 8, "v3: 2, stores the low cell first");

    /* ALLOT counts cells */
    CHECK(run("ALLOT", 1, 5, 0) && clean() && !err() && get("HERE", 0, 0) == DICT_W + 13, "5 ALLOT reserves five cells");
    CHECK(run("ALLOT", 1, 0, 0) && clean() && get("HERE", 0, 0) == DICT_W + 13, "0 ALLOT reserves none");
    CHECK(run("ALLOT", 1, -3, 0) && clean() && !err() && get("HERE", 0, 0) == DICT_W + 10, "-3 ALLOT gives three back");
    CHECK(run("C,", 1, 'x', 0) && run("ALLOT", 1, 2, 0) && clean() && get("HERE", 0, 0) == DICT_W + 13
          && n.mem[DP] == (DICT_W + 13) * 4, "ALLOT aligns first");
    CHECK(n.mem[DICT_W - 1] == GUARD, "nothing below the dictionary space written");

    /* the ends of the space */
    empty_dictionary();
    CHECK(run("ALLOT", 1, -1, 0) && clean() && err() && get("HERE", 0, 0) == DICT_W, "ALLOT below the start is refused and sets NODE-ERROR");
    CHECK(run("ALLOT", 1, DICT_END_W - DICT_W, 0) && clean() && !err() && get("HERE", 0, 0) == DICT_END_W, "the whole space can be allotted");
    CHECK(run(",", 1, 99, 0) && clean() && err() && n.mem[DICT_END_W] == GUARD && get("HERE", 0, 0) == DICT_END_W, ", into a full dictionary stores nothing and sets NODE-ERROR");
    CHECK(run("C,", 1, 99, 0) && clean() && err() && n.mem[DICT_END_W] == GUARD, "so does C,");
    CHECK(run("ALLOT", 1, 1, 0) && clean() && err() && get("HERE", 0, 0) == DICT_END_W, "and ALLOT");
    CHECK(run("ALLOT", 1, -1, 0) && clean() && !err() && run(",", 1, 77, 0) && clean() && !err() && n.mem[DICT_END_W - 1] == 77, "the last cell can be used");
    CHECK(get("'PAD", 0, 0) == PAD, "PAD is its buffer's byte address");

    /* ---- entries ---- */
    empty_dictionary();
    CHECK(get("LATEST", 0, 0) == 0, "LATEST is 0 in an empty dictionary");
    a = define("ALPHA");
    CHECK(a == DICT_W + 2 + 3 && !err(), "an entry's xt follows its name and three cells: %ld", (long)a);
    CHECK(entry_is(a, "ALPHA", 0, 0), "the first entry: name, no flags, link 0");
    CHECK(get("LATEST", 0, 0) == a && get("HERE", 0, 0) == a, "LATEST is its xt, and its code starts at HERE");
    CHECK(run(",", 1, 1001, 0) && clean(), "some code");
    b = define("B");
    CHECK(b == a + 1 + 1 + 3 && entry_is(b, "B", a, 0), "the second entry links to the first");
    (void)run(",", 1, 1002, 0);
    c = define("GAMMA-DELTA");
    CHECK(c == b + 1 + 3 + 3 && entry_is(c, "GAMMA-DELTA", b, 0), "an eleven-character name takes three cells");
    CHECK(get("LATEST", 0, 0) == c, "LATEST is the newest");

    /* the field words, all from the xt */
    CHECK(get(">LINK", 1, c) == c - 1 && get("LFA", 1, c) == c - 1, ">LINK and LFA are the link's address");
    CHECK(get("LINK>", 1, c - 1) == b && get("LINK>", 1, b - 1) == a && get("LINK>", 1, a - 1) == 0, "LINK> follows it, to 0 at the end");
    CHECK(get(">NAME", 1, c) == (c - 6) * 4 && get("NFA", 1, c) == (c - 6) * 4, ">NAME and NFA are the name's byte address");
    CHECK(byte_at(get(">NAME", 1, b)) == 1 && byte_at(get(">NAME", 1, b) + 1) == 'B', "which is its count byte, then its characters");
    CHECK(get("NAME>", 1, get(">NAME", 1, a)) == a && get("NAME>", 1, get(">NAME", 1, b)) == b && get("NAME>", 1, get(">NAME", 1, c)) == c, "NAME> goes back to the xt");
    CHECK(get("CFA", 1, c) == c, "CFA is the xt itself, as v3");
    CHECK(get("PFA", 1, c) == c && get(">BODY", 1, c) == c, "the parameter field of a code word is its code");
    CHECK(run("DATA!", 0, 0, 0) && clean() && n.mem[c - 3] == 4, "(marking the newest a data word)");
    CHECK(get("PFA", 1, c) == c + 1 && get(">BODY", 1, c) == c + 1, "the parameter field of a data word is the cell after its code");
    CHECK(get("PFA", 1, b) == b, "and the others are unchanged");
    {
        v4_cell nfa = get(">NAME", 1, c);
        CHECK(run("TRAVERSE", 2, nfa, 1) && pop() == nfa + 12 && clean(), "TRAVERSE forward goes past the name's last character");
        CHECK(run("TRAVERSE", 2, nfa, 5) && pop() == nfa + 12 && clean(), "for any positive n");
        CHECK(run("TRAVERSE", 2, nfa, -1) && pop() == nfa && clean(), "TRAVERSE backward leaves the address, as v3");
        CHECK(run("TRAVERSE", 2, nfa, 0) && pop() == nfa && clean(), "and so does 0");
    }

    /* SMUDGE toggles the newest entry's hidden bit; HIDDEN sets it */
    CHECK(run("SMUDGE", 0, 0, 0) && clean() && n.mem[c - 3] == 6, "SMUDGE hides the newest entry, keeping its other flags");
    CHECK(run("SMUDGE", 0, 0, 0) && clean() && n.mem[c - 3] == 4, "SMUDGE again shows it");
    CHECK(run("HIDDEN", 0, 0, 0) && clean() && n.mem[c - 3] == 6 && run("HIDDEN", 0, 0, 0) && clean() && n.mem[c - 3] == 6, "HIDDEN hides it, once or twice");
    CHECK(n.mem[b - 3] == 0 && n.mem[a - 3] == 0, "the others are untouched");
    CHECK(run("SMUDGE", 0, 0, 0) && clean() && n.mem[c - 3] == 4, "shown again");
    empty_dictionary();
    CHECK(run("SMUDGE", 0, 0, 0) && clean() && run("HIDDEN", 0, 0, 0) && clean() && n.mem[DICT_W] == GUARD && n.mem[DICT_W - 1] == GUARD,
          "SMUDGE and HIDDEN do nothing in an empty dictionary");

    /* names: empty, long, and the edge of the space */
    empty_dictionary();
    CHECK(define("") == 0 && err() && get("HERE", 0, 0) == DICT_W && n.mem[LATEST] == 0, "an empty name makes nothing and sets NODE-ERROR");
    {
        char long31[40], long40[48];
        memset(long31, 'q', 31); long31[31] = 0;
        memset(long40, 'q', 40); long40[40] = 0;
        a = define(long31);
        CHECK(a == DICT_W + 8 + 3 && entry_is(a, long31, 0, 0), "a 31-character name is kept whole");
        b = define(long40);
        CHECK(b != 0 && entry_is(b, long31, a, 0) && b - a == 8 + 3, "a 40-character name is cut to 31");
    }
    empty_dictionary();
    n.mem[DP] = (DICT_END_W - 4) * 4;
    CHECK(define("ABCD") == 0 && err() && n.mem[LATEST] == 0 && n.mem[DP] == (DICT_END_W - 4) * 4 && n.mem[DICT_END_W - 4] == GUARD,
          "an entry that does not fit makes nothing, moves nothing, and sets NODE-ERROR");
    n.mem[DP] = (DICT_END_W - 5) * 4;
    CHECK(define("ABCD") == DICT_END_W && !err() && n.mem[DICT_END_W] == GUARD, "one that just fits is made");

    /* ---- FIND ---- */
    empty_dictionary();
    CHECK(find("ANYTHING") == 0 && !err(), "FIND in an empty dictionary is 0, and no error");
    a = define("ALPHA"); (void)run(",", 1, 1, 0);
    b = define("BETA");  (void)run(",", 1, 2, 0);
    c = define("GAMMA"); (void)run(",", 1, 3, 0);
    CHECK(find("ALPHA") == a && find("BETA") == b && find("GAMMA") == c && !err(), "FIND finds each word");
    CHECK(find("DELTA") == 0 && find("ALPH") == 0 && find("ALPHAS") == 0 && find("LPHA") == 0 && !err(), "and not what is not there, nor a part of a name");
    CHECK(find("alpha") == 0 && find("Alpha") == 0, "names are case sensitive, as v3");
    CHECK(find("   BETA   and more") == b && n.mem[TO_IN] == 8, "FIND takes the next word of the input stream and leaves >IN after it");
    CHECK(find("") == 0 && find("    ") == 0 && !err(), "at the end of the input it is 0");
    {
        v4_cell a2 = define("ALPHA");
        CHECK(a2 != 0 && a2 != a && find("ALPHA") == a2, "a later word of the same name is the one found");
        CHECK(run("SMUDGE", 0, 0, 0) && find("ALPHA") == a, "hidden, the earlier one is found again");
        CHECK(run("SMUDGE", 0, 0, 0) && find("ALPHA") == a2, "shown, the later");
        CHECK(run("HIDDEN", 0, 0, 0) && find("ALPHA") == a && find("BETA") == b, "HIDDEN hides only the newest");
    }
    /* 31 characters are significant */
    {
        char n31[40], n32a[40], n32b[40], n30[40];
        empty_dictionary();
        memset(n31, 'k', 31); n31[31] = 0;
        memcpy(n32a, n31, 31); n32a[31] = 'X'; n32a[32] = 0;
        memcpy(n32b, n31, 31); n32b[31] = 'Y'; n32b[32] = 0;
        memset(n30, 'k', 30); n30[30] = 0;
        a = define(n32a);
        CHECK(find(n32a) == a && find(n32b) == a && find(n31) == a, "names that agree in their first 31 characters are the same name");
        CHECK(find(n30) == 0, "one that is shorter is not");
        n31[30] = 'j';
        CHECK(find(n31) == 0, "nor one that differs in the 31st");
    }

    /* ---- ' ---- */
    empty_dictionary();
    a = define("CODEWORD"); (void)run(",", 1, 1, 0);
    b = define("DATAWORD"); (void)run("DATA!", 0, 0, 0); (void)run(",", 1, 2, 0); (void)run(",", 1, 55, 0);
    set_line("CODEWORD x");
    CHECK(get("(')", 0, 0) == a && !err() && n.mem[TO_IN] == 9, "' of a code word is its code address, which is what FIND gives");
    set_line("DATAWORD");
    CHECK(get("(')", 0, 0) == b + 1 && !err() && n.mem[b + 1] == 55, "' of a data word is its parameter field");
    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)) == capsule_latest, "linked in order, after the capsule's own");
        CHECK(capsule_latest != 0 && find("WORD") == W("WORD") && find("C@") == W("C@") && find(",") == W(",") && find("\\") == W("BACKSLASH"),
              "the capsule's own words are found under their FORTH names");
        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];
        static v4_cell xts[300];
        unsigned count = 0;
        empty_dictionary();
        for (t = 0; t < 300; t++) {
            unsigned len = 1 + rnd() % (t % 7 == 0 ? 34 : 9), dup = 0;
            char *nm = names[count];
            for (i = 0; i < len; i++) nm[i] = (char)("ABCDEFGHab01-+*/!@"[rnd() % 18]);
            nm[len] = 0;
            xts[count] = define(nm);
            CHECK(xts[count] != 0 && !err(), "defining \"%s\"", nm);
            (void)run(",", 1, (v4_cell)t, 0);
            if (len > 31) nm[31] = 0;
            for (i = 0; i < count; i++) if (strcmp(names[i], nm) == 0) dup = 1;
            (void)dup;
            count++;
        }
        for (t = 0; t < count; t++) {
            v4_cell want = 0;
            for (i = 0; i < count; i++) if (strcmp(names[i], names[t]) == 0) want = xts[i];      /* the newest of that name */
            CHECK(find(names[t]) == want, "FIND \"%s\"", names[t]);
        }
        /* walk the links from LATEST: every entry, newest first, then 0 */
        {
            v4_cell xt = get("LATEST", 0, 0);
            for (t = count; t-- > 0; ) {
                if (xt != xts[t]) break;
                if (get("NAME>", 1, get(">NAME", 1, xt)) != xt) break;
                xt = get("LINK>", 1, get(">LINK", 1, xt));
            }
            CHECK(t == (unsigned)-1 && xt == 0, "the links run through all %u entries, newest first", count);
        }
        printf("  %u entries in %ld cells\n", count, (long)(get("HERE", 0, 0) - DICT_W));
        CHECK(n.mem[DICT_W - 1] == GUARD && n.mem[DICT_END_W] == GUARD, "nothing outside the dictionary space written");
    }

    /* What they leave their caller (D-2). */
    headroom("FIND", setup_three, 0, 0, 1, 3, 2);
    headroom("(')", setup_three, 0, 0, 1, 3, 2);
    headroom("MAKE", setup_new, 0, 0, 0, 3, 2);
    headroom(",", setup_new, 1, 42, 0, 5, 5);
    headroom("ALLOT", setup_new, 1, 3, 0, 5, 5);

    CHECK(v4_node_guards_intact(&n), "guards intact");

    printf("  %d checks, %d failures\n", checks, failures);
    return failures ? 1 : 0;
}