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 <stdlib.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;
    HOST_MESSAGES_EMPTY(&nucleus);

    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");
    }

    /* ---- two neighbours with something for each other at the same moment ----
     * A write blocks until the neighbour reads, and a node that is writing
     * is not reading: so a node looks before it begins a message, and of
     * two neighbours only the one with the lower number may wait to write
     * to the other (v4/capsule/core.v4, (GATE); docs/v4.0.0/MESH.md 7a).
     * Each node is told who is on each of its ports. */
    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");
    CHECK(is_empty(tell(10, "11 2 NEIGHBOUR  0 3 NEIGHBOUR")) && is_empty(tell(11, "10 2 NEIGHBOUR  12 3 NEIGHBOUR")) && is_empty(tell(12, "11 2 NEIGHBOUR  0 3 NEIGHBOUR")),
          "each is told who is on the other end of its ports");
    CHECK(strstr(tell(10, "11 8 NEIGHBOUR"), "Argument out of range") != NULL && strstr(tell(10, "11 -1 NEIGHBOUR"), "Argument out of range") != NULL,
          "a port a node has not got is an error");
    /* the far node sends the middle one text, and then word of how its own
     * text ended, which goes by the middle one; the middle one does the
     * text and answers the far one: the two messages meet on one wire */
    CHECK(strcmp(tell(12, ": HI S\" 72 EMIT\" 11 SEND ; HI"), "H") == 0 && printed_from == 11 && ended == 1 && ended_from == 12,
          "from the far end to the middle, with the answers crossing: \"%s\" from %ld", printed, (long)printed_from);
    CHECK(waiting(hera) && waiting(mid) && waiting(far), "and all three are waiting again");

    /* every node sends every other a number of messages, all at once: each
     * counts what it is sent */
    CHECK(is_empty(tell(10, "VARIABLE GOT  : HIT 1 GOT +! ;  VARIABLE WHO  VARIABLE SENT  : BURST WHO ! 0 DO S\" HIT\" WHO @ SEND  1 SENT +! LOOP ;")) &&
          is_empty(tell(11, "VARIABLE GOT  : HIT 1 GOT +! ;  VARIABLE WHO  VARIABLE SENT  : BURST WHO ! 0 DO S\" HIT\" WHO @ SEND  1 SENT +! LOOP ;")) &&
          is_empty(tell(12, "VARIABLE GOT  : HIT 1 GOT +! ;  VARIABLE WHO  VARIABLE SENT  : BURST WHO ! 0 DO S\" HIT\" WHO @ SEND  1 SENT +! LOOP ;")), "each node is given a word to count with and one to send with");
    {
        const char *r = tell(10, ": GO S\" 6 10 BURST 6 12 BURST\" 11 SEND  S\" 6 11 BURST 6 10 BURST\" 12 SEND  6 11 BURST  6 12 BURST ; GO");
        CHECK(is_empty(r), "six messages from each node to each other, all at once: \"%s\"", r);
        CHECK(waiting(hera) && waiting(mid) && waiting(far), "all three come to rest");
        CHECK(strcmp(tell(10, "GOT @ . (LOST) @ ."), "12 1 ") == 0 && strcmp(tell(11, "GOT @ . (LOST) @ ."), "12 0 ") == 0 && strcmp(tell(12, "GOT @ . (LOST) @ ."), "12 0 ") == 0,
              "every one of them arrived, and none was let go: \"%s\"", printed);
    }

    /* ---- more than a node has room to keep ----
     * A node that takes messages in while it waits to write keeps them, and
     * when it has no room for one more it lets that one go and counts it.
     * Far more are sent here than the nodes can keep. */
    {
        long got = 0, lost = 0, sent = 0, v;
        unsigned k;
        static const v4_cell who[3] = { 10, 11, 12 };
        const char *r;
        CHECK(is_empty(tell(10, "0 GOT !  0 SENT !")) && is_empty(tell(11, "0 GOT !  0 SENT !")) && is_empty(tell(12, "0 GOT !  0 SENT !")), "the counts begin again");
        r = tell(10, ": GO2 S\" 200 10 BURST 200 12 BURST\" 11 SEND  S\" 200 11 BURST 200 10 BURST\" 12 SEND  200 11 BURST  200 12 BURST ; GO2");
        CHECK(strcmp(r, "(still running)") != 0, "two hundred from each to each: it ends");
        CHECK(waiting(hera) && waiting(mid) && waiting(far), "and all three come to rest, none waiting to write");
        for (k = 0; k < 3; k++) {
            r = tell(who[k], "GOT @ .");
            v = strtol(r, NULL, 10); got += v;
            CHECK(v > 0 && v <= 400, "node %ld took %ld of the 400 for it", (long)who[k], v);
            r = tell(who[k], "(LOST) @ .");
            lost += strtol(r, NULL, 10);
            r = tell(who[k], "SENT @ .");
            sent += strtol(r, NULL, 10);
            CHECK(pool[k].n.mem[MQ_COUNT] == 0, "node %ld has none left waiting", (long)who[k]);
        }
        lost -= 1;                                   /* the one for node 99, earlier */
        /* what is let go is of every kind: the text that would have set a
         * node sending, the answers to text, as well as what was sent */
        printf("  of %ld messages the nodes sent each other at once %ld arrived; %ld messages of all kinds were let go for want of room\n", sent, got, lost);
        CHECK(lost > 0, "there was not room for all of them");
        CHECK(got <= sent && got + lost >= sent, "every message sent either arrived or was counted: %ld sent, %ld arrived, %ld let go", sent, got, lost);
        CHECK(strcmp(tell(12, "7 8 * ."), "56 ") == 0 && printed_from == 12, "and the nodes go on as before");
    }

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