/* 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 #include #include #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 nacks; /* how many NACKs have come to the console, */ static v4_cell nack_from, nack_about; /* and the last of them: who refused, and the node the refused message was for */ 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]; } else if (v4_message_type(&coming) == V4_MSG_NACK) { nacks++; nack_from = v4_message_from(&coming); nack_about = 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 ---- */ nacks = 0; CHECK(is_empty(tell(99, "1 2 + .")) && ended == 0, "text for a node there is no way to is not done by anyone"); CHECK(nacks == 1 && nack_from == 10 && nack_about == 99, "the console, which sent it, is told it was refused, by the node that could not pass it on: %d from %ld about %ld", nacks, (long)nack_from, (long)nack_about); CHECK(strcmp(tell(10, "(LOST) @ ."), "1 ") == 0, "and that node 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"); CHECK(pool[0].n.mem[OWED_COUNT] == 0 && pool[1].n.mem[OWED_COUNT] == 0 && pool[2].n.mem[OWED_COUNT] == 0 && waiting(hera) && waiting(mid) && waiting(far), "every refusal a node owed has been sent, and all three are at rest"); CHECK(pool[0].n.mem[REFUSED] + pool[1].n.mem[REFUSED] + pool[2].n.mem[REFUSED] > 0, "senders were told of what was refused: %ld %ld %ld", (long)pool[0].n.mem[REFUSED], (long)pool[1].n.mem[REFUSED], (long)pool[2].n.mem[REFUSED]); } /* ---- refusals and waits (docs/v4.0.0/MESH.md 7b) --------------------------- * No message is lost without its sender being told, and no node waits * for ever. */ /* no way: the refusal travels back to the node that sent the message */ { v4_cell refused = pool[2].n.mem[REFUSED], lost = pool[0].n.mem[LOST]; CHECK(is_empty(tell(12, ": N77 S\" 1 DROP\" 77 SEND ; N77")) && ended_how == V4_TEXT_COMPLETED, "node 12 sends text to node 77: it has a way for everything, toward 11"); CHECK(pool[0].n.mem[LOST] == lost + 1, "node 10, two away, has no way to 77 and counts the message"); CHECK(pool[2].n.mem[REFUSED] == refused + 1, "and node 12 is told: its count of refusals is one more"); } /* a sender that is waiting for the answer stops waiting */ CHECK(strstr(tell(12, ": W77 S\" 1 DROP\" 77 SEND 77 AWAIT . ; W77"), "Message refused") != NULL && ended == 1 && ended_how == V4_TEXT_ERROR && ended_from == 12, "a node that sends to 77 and waits for its answer: the wait ends, with an error that says the message was refused: \"%s\"", printed); CHECK(strcmp(tell(12, "7 8 * ."), "56 ") == 0 && pool[2].n.mem[AWAIT_FROM] == 0, "and it goes on to its next line, waiting for no one"); /* no room: a node that is waiting keeps what it is sent, and has room for only so much */ { v4_cell lost = pool[1].n.mem[LOST], refused = pool[0].n.mem[REFUSED], got, not_taken; CHECK(is_empty(tell(11, "0 GOT !")) && is_empty(tell(11, "12 AWAIT .")) && ended == 0 && pool[1].n.mem[AWAIT_FROM] == 12, "node 11 waits for an answer from 12, which is not going to send one"); CHECK(is_empty(tell(10, ": F 49 0 DO S\" HIT\" 11 SEND LOOP ; F")) && ended == 1 && ended_from == 10, "node 10 sends it 49 messages meanwhile"); CHECK(pool[1].n.mem[MQ_COUNT] > 300 && pool[1].n.mem[MQ_COUNT] <= MQ_CELLS - 36, "node 11 has kept what it has room for, and left the room that is kept for refusals: %ld cells", (long)pool[1].n.mem[MQ_COUNT]); CHECK(pool[1].n.mem[OWED_COUNT] == 8, "it owes a refusal for each of the rest, as many as it can owe: %ld", (long)pool[1].n.mem[OWED_COUNT]); CHECK(pool[0].n.mem[REFUSED] == refused, "and has sent none yet: it is still waiting"); /* a GONE that does not come from its centre is not acted on */ CHECK(is_empty(tell(12, "12 11 GONE")) && pool[1].n.mem[AWAIT_FROM] == 12, "node 12 tells it that 12 is gone: that is not its centre speaking, and it goes on waiting"); /* one from its centre ends the wait */ CHECK(is_empty(tell(10, "12 NO-ROUTE")), "node 10 forgets the way to 12"); CHECK(strstr(tell(10, "12 11 GONE"), "Node gone") != NULL && printed_from == 11 && ended_from != -1, "node 10, its centre, tells it 12 is gone: its wait ends with an error that says so: \"%s\"", printed); CHECK(pool[1].n.mem[AWAIT_FROM] == 0 && waiting(mid), "it is waiting for no one, and is back at its ports"); got = strtol(tell(11, "GOT @ ."), NULL, 10); not_taken = 49 - got; CHECK(got >= 30 && not_taken > 8, "it then did every message it had kept: %ld of the 49", (long)got); CHECK(pool[0].n.mem[REFUSED] == refused + 8, "and sent the eight refusals it owed: node 10 was told of %ld", (long)(pool[0].n.mem[REFUSED] - refused)); /* two more than node 10's: node 12's word of how "12 11 GONE" ended came this way for the console while * node 11 was full, and was not taken; nor could the refusal for it be owed */ CHECK(pool[1].n.mem[LOST] == lost + (not_taken + 1) + (not_taken + 1 - 8), "it counted each message it did not take, and each refusal it could not owe: %ld for %ld not taken", (long)(pool[1].n.mem[LOST] - lost), (long)(not_taken + 1)); /* the way to 12 is forgotten: what is sent there now is refused */ refused = pool[1].n.mem[REFUSED]; CHECK(is_empty(tell(11, ": P12 S\" 1 DROP\" 12 SEND ; P12")) && pool[1].n.mem[REFUSED] == refused + 1, "having forgotten the way to 12, what node 11 sends there goes toward its centre, which has no way either, and is refused"); CHECK(is_empty(tell(10, "12 2 ROUTE")) && is_empty(tell(11, "12 3 ROUTE")) && strcmp(tell(12, "7 8 * ."), "56 ") == 0, "told the way again, they reach 12 as before"); } /* a line from the console breaks a wait (MESH.md 7b.6) */ CHECK(is_empty(tell(10, "12 AWAIT .")) && ended == 0 && pool[0].n.mem[AWAIT_FROM] == 12 && waiting(hera), "node 10 waits for an answer from 12, which is not going to send one"); CHECK(is_empty(tell(11, "20 22 + .")) && ended == 0 && pool[0].n.mem[AWAIT_FROM] == 12, "text from the console for node 11 comes to node 10 on its way: node 10 keeps it, and goes on waiting"); { const char *r = tell(10, "65 EMIT"); CHECK(strstr(r, "Interrupted\n") != NULL && pool[0].n.mem[AWAIT_FROM] == 0, "text from the console for node 10 itself ends its wait, with an error that says so: \"%s\"", r); CHECK(strstr(r, "A") != NULL && strstr(r, "42 ") != NULL && ended == 3, "the line is then done as usual, and so is what was kept for node 11: \"%s\", %d ended", r, ended); CHECK(strstr(r, "Interrupted\n") < strstr(r, "A"), "the wait ends before the line that ended it is done"); } CHECK(strcmp(tell(10, "1 2 + ."), "3 ") == 0 && waiting(hera) && waiting(mid) && waiting(far), "and all three go on as before"); CHECK(strstr(tell(10, "5 NO-ROUTE"), "ERROR") == NULL && strcmp(tell(11, "20 22 + ."), "42 ") == 0, "forgetting the way to a node there was no way to changes nothing"); printf(" %d checks, %d failures\n", checks, failures); return failures != 0; }