LithosAnanake/v4/tests/test_host_mesh.c

/* test_host_mesh.c -- StarForth nodes that talk: a console wired to one
 * node, and two more in a row behind it.  docs/v4.0.0/MESH.md sections 6
 * and 7, steps 3 and 4.
 *
 *     console --1 [10] 2--2 [11] 3--2 [12]
 *
 * Each node is the nucleus (v4/capsule/ *.v4) and nothing else.  They start
 * alike, numbered 0 and knowing no way anywhere; everything they come to
 * know they are told by text sent from the console, as whoever wires a node
 * tells it.  The console is a device on a port and speaks messages
 * (v4/include/v4/message.h).
 */
#include "v4/fabric.h"
#include "v4/message.h"
#include "v4/text.h"
#include <stdio.h>
#include <string.h>

#include "host_map.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)

static v4_text        tx;
static v4_node        nucleus;           /* one node with the nucleus in it: what every node here starts as */
static v4_cell        w_idle, w_fault;
static v4_fabric_node pool[3];
static v4_place       places[3];
static v4_fabric      f;

/* ---- the console: a device on a port ---- */
#define CONSOLE_ID 1
static v4_message going, coming;
static unsigned   going_at;
static char       printed[8192];         /* what has come back since the console last sent */
static unsigned   printed_len;
static v4_cell    printed_from;          /* which node the last of it came from */
static int        ended;                 /* how many messages of how text ended have come, */
static v4_cell    ended_from, ended_how; /*   and the last of them */

static int console_give(void *self, v4_cell *value)
{
    (void)self;
    if (going_at >= going.count) return 0;
    *value = going.word[going_at++];
    return 1;
}
static int console_take(void *self, v4_cell value)
{
    (void)self;
    if (v4_message_word(&coming, value)) {
        if (v4_message_type(&coming) == V4_MSG_OUTPUT) {
            unsigned i, chars = v4_message_length(&coming);
            for (i = 0; i < chars && printed_len + 1 < sizeof printed; i++) printed[printed_len++] = v4_message_char(&coming, i);
            printed[printed_len] = 0;
            printed_from = v4_message_from(&coming);
        } else if (v4_message_type(&coming) == V4_MSG_DONE) {
            ended++;
            ended_from = v4_message_from(&coming);
            ended_how = coming.word[V4_MSG_HEADER];
        }
        coming.count = 0;
    }
    return 1;
}
static const v4_device console = { console_take, console_give, 0 };

static int is_empty(const char *s) { return s[0] == 0; }

/* Send text to a node and let everything that follows from it happen. */
static const char *tell(v4_cell node, const char *text)
{
    unsigned steps = 0;
    printed_len = 0; printed[0] = 0; printed_from = -1;
    ended = 0; ended_from = -1; ended_how = -1;
    if (!v4_message_text(&going, node, CONSOLE_ID, V4_MSG_TEXT, text, (unsigned)strlen(text))) return "(too long)";
    going_at = 0;
    while (steps < 20000000 && v4_fabric_step(&f) != 0) steps++;
    if (steps >= 20000000) return "(still running)";
    return printed;
}

/* A StarForth node in the fabric: born, then given the nucleus and the
 * registers the nucleus expects, waiting for a message. */
static unsigned starforth_node(unsigned k)
{
    int id = v4_fabric_add(&f, &pool[k], PORT);
    v4_node *n = &pool[k].n;
    memcpy(n->mem, nucleus.mem, sizeof n->mem);
    v4_node_stack_regs_attach(n, DSTACK_REG, RSTACK_REG);
    v4_node_error_attach(n, NODE_ERROR);
    v4_node_fault_attach(n, w_fault);
    n->p = w_idle;
    return (unsigned)id;
}

static int waiting(unsigned id)
{
    const v4_node *n = &v4_fabric_node_at(&f, id)->n;
    return n->reading && !n->given && n->read_port == V4_PORT_ANY;
}

int main(void)
{
    unsigned hera, mid, far, i;

    printf("v4 mesh tests: V4_CELL_BITS=%d, V4_NODE_WORDS=%u\n", V4_CELL_BITS, (unsigned)V4_NODE_WORDS);
    {
        static const char *const files[] = { "core.v4", "input.v4", "dict.v4", "codegen.v4", "compile.v4", "quit.v4", "forth.v4",
                                             "numout.v4", "words.v4", "system.v4", "qmath.v4", "blocks.v4", "log.v4", "acl.v4" };
        CHECK(host_load(&tx, &nucleus, files, 14), "the nucleus assembles");
    }
    CHECK(v4_text_finish(&tx), "everything is defined: %s", v4_text_error(&tx));
    if (failures) { printf("  %d checks, %d failures\n", checks, failures); return 1; }
    w_idle = v4_text_word(&tx, "(IDLE)");
    w_fault = v4_text_word(&tx, "(FAULTS)");
    nucleus.mem[DP] = DICT_W * 4;                    /* the variables, as at switch-on (tools/mkimage.c) */
    nucleus.mem[LATEST] = v4_text_latest(&tx);
    nucleus.mem[CFP] = CFS_W;
    nucleus.mem[BASE] = 10;
    nucleus.mem[FENCE] = DICT_W;
    nucleus.mem[BOOT_CELLS] = nucleus.mem[DP];
    nucleus.mem[BOOT_CELLS + 1] = nucleus.mem[LATEST];
    nucleus.mem[LOG_LEVEL] = 2;
    nucleus.mem[CONTEXT] = LATEST;
    nucleus.mem[CURRENT] = LATEST;
    nucleus.mem[SRC] = TIB;
    nucleus.mem[LINE_STATUS] = 1;
    nucleus.mem[OUT_PTR] = OUT_W;

    v4_fabric_init(&f, places, 3);
    hera = starforth_node(0);
    mid  = starforth_node(1);
    far  = starforth_node(2);
    CHECK(v4_fabric_wire_device(&f, hera, 1, &console), "the console is wired to one node's port 1");
    CHECK(v4_fabric_wire(&f, hera, 2, mid, 2) && v4_fabric_wire(&f, mid, 3, far, 2), "and the three nodes in a row");
    going.count = 0; going_at = 0;
    for (i = 0; i < 20; i++) (void)v4_fabric_step(&f);
    CHECK(waiting(hera) && waiting(mid) && waiting(far), "all three wait at their ports");

    /* ---- they are told who they are and the way to each other, by text ---- */
    CHECK(is_empty(tell(0, "10 (ME) !  1 (CONSOLE) !  1 1 ROUTE  0 2 ROUTE")) && ended == 1 && ended_how == V4_TEXT_COMPLETED && ended_from == 10,
          "the node at the console takes text sent to 0, and is 10 from then on: %ld", (long)ended_from);
    CHECK(is_empty(tell(0, "11 (ME) !  1 (CONSOLE) !  2 DEFAULT-ROUTE  0 3 ROUTE")) && ended == 1 && ended_from == 11 && ended_how == V4_TEXT_COMPLETED,
          "text sent to 0 now passes through 10 to the next, which is 11 from then on: %ld", (long)ended_from);
    CHECK(is_empty(tell(0, "12 (ME) !  1 (CONSOLE) !  2 DEFAULT-ROUTE")) && ended == 1 && ended_from == 12 && ended_how == V4_TEXT_COMPLETED,
          "and then through both to the last, 12: %ld", (long)ended_from);
    CHECK(is_empty(tell(10, "11 2 ROUTE  12 2 ROUTE")) && ended_from == 10 && is_empty(tell(11, "12 3 ROUTE")) && ended_from == 11,
          "each is told the way to the others");

    /* ---- they talk ---- */
    CHECK(strcmp(tell(10, "1 2 + ."), "3 ") == 0 && printed_from == 10 && ended_how == V4_TEXT_COMPLETED, "text for the node at the console is done there");
    CHECK(strcmp(tell(11, "20 22 + ."), "42 ") == 0 && printed_from == 11 && ended_from == 11, "text for the next node is done there, and what it prints comes back");
    CHECK(strcmp(tell(12, "7 8 * ."), "56 ") == 0 && printed_from == 12 && ended_from == 12 && ended_how == V4_TEXT_COMPLETED,
          "text for the last passes through two nodes, and what it prints comes back through two: \"%s\" from %ld", printed, (long)printed_from);
    CHECK(strcmp(tell(12, "NOSUCH"), "UNKNOWN WORD: 'NOSUCH'\n") == 0 && ended_from == 12 && ended_how == V4_TEXT_ERROR, "an error there is reported from there");
    CHECK(strcmp(tell(12, ": SQ DUP * ;"), "") == 0 && strcmp(tell(12, "9 SQ ."), "81 ") == 0 && strstr(tell(11, "9 SQ ."), "UNKNOWN WORD") != NULL,
          "each node has its own dictionary: a word defined on one is not on another");
    {
        const char *all = tell(12, "WORDS");
        CHECK(strlen(all) > 1000 && printed_from == 12 && ended == 1, "more than a message holds comes back in several: %u characters", (unsigned)strlen(all));
    }
    {
        static char line[1100];
        memset(line, ' ', 1024);
        memcpy(line, "66 EMIT", 7);
        memcpy(line + 1017, "67 EMIT", 7);
        line[1024] = 0;
        CHECK(strcmp(tell(12, line), "BC") == 0, "a message as long as a message may be is passed on whole: 1024 characters");
    }

    /* ---- one node sends to another ---- */
    CHECK(strcmp(tell(10, ": TELL S\" 65 EMIT 12 . \" 12 SEND ; TELL"), "A12 ") == 0 && printed_from == 12,
          "text one node SENDs another is done there, and what that prints goes to its console: \"%s\" from %ld", printed, (long)printed_from);
    CHECK(strstr(tell(10, ": NOWAY S\" 1\" 99 SEND ; NOWAY"), "Argument out of range") != NULL && ended_how == V4_TEXT_ERROR,
          "SEND to a node there is no way to is an error");

    /* ---- no way ---- */
    CHECK(is_empty(tell(99, "1 2 + .")) && ended == 0, "text for a node there is no way to: nothing comes back");
    CHECK(strcmp(tell(10, "(LOST) @ ."), "1 ") == 0, "and the node that could not pass it on has counted it");
    CHECK(strcmp(tell(11, "(LOST) @ ."), "0 ") == 0 && strcmp(tell(12, "(LOST) @ ."), "0 ") == 0, "the others have lost nothing");

    /* ---- waiting ---- */
    {
        v4_uheat_t c0 = pool[0].es.anticlock, c1 = pool[1].es.anticlock, c2 = pool[2].es.anticlock;
        for (i = 0; i < 100; i++) (void)v4_fabric_step(&f);
        CHECK(waiting(hera) && waiting(mid) && waiting(far), "with nothing to do, all three wait at their ports");
        CHECK(pool[0].es.anticlock == c0 && pool[1].es.anticlock == c1 && pool[2].es.anticlock == c2, "and execute nothing");
    }

    /* ---- the ways are forgotten and told again: the wiring has changed ---- */
    CHECK(v4_fabric_wire(&f, hera, 3, far, 3), "the far node is wired straight to the one at the console as well");
    CHECK(is_empty(tell(10, "NO-ROUTES  1 1 ROUTE  11 2 ROUTE  12 3 ROUTE")) && is_empty(tell(12, "NO-ROUTES  3 DEFAULT-ROUTE")), "and both are told");
    {
        v4_uheat_t before = pool[1].es.anticlock;
        CHECK(strcmp(tell(12, "5 5 + ."), "10 ") == 0 && pool[1].es.anticlock == before, "text for it no longer passes through the middle node, which executes nothing");
    }

    /* ---- WHAT DOES NOT WORK: two neighbours that write to each other at once ----
     * A write blocks until the neighbour reads, and a node that is writing
     * is not reading.  Here the far node sends text to the middle one and
     * then goes to send word of how its own text ended, which goes by the
     * middle one; the middle one does the text and goes to answer the far
     * one.  Each waits for the other to read, for ever.  It is the same
     * whenever messages go both ways on a wire at once, and it is because
     * passing a message on is done here by the node's own programme
     * (v4/capsule/quit.v4, (PASS-ON)), which cannot pass anything on while
     * it waits to write.  docs/v4.0.0/MESH.md, step 4.  This check is here
     * so that the fault is on record and is seen to go when it is put
     * right. */
    CHECK(is_empty(tell(10, "NO-ROUTES  1 1 ROUTE  11 2 ROUTE  12 2 ROUTE")) && is_empty(tell(12, "NO-ROUTES  2 DEFAULT-ROUTE")), "the row of three again");
    (void)tell(12, ": HI S\" 72 EMIT\" 11 SEND ; HI");
    CHECK(pool[1].n.asking && pool[1].n.ask_port == 3 && pool[2].n.asking && pool[2].n.ask_port == 2,
          "KNOWN FAULT: two neighbours each writing to the other wait for ever");

    printf("  %d checks, %d failures\n", checks, failures);
    return failures != 0;
}