diff --git a/capsules/v4/hera.4th b/capsules/v4/hera.4th index 6eda8ebd..1cb35672 100644 --- a/capsules/v4/hera.4th +++ b/capsules/v4/hera.4th @@ -32,6 +32,20 @@ VARIABLE (KID) VARIABLE (KID#) VARIABLE (KIDP) BEGIN PAD CAPSULE-LINE DUP 0< 0= WHILE PAD SWAP (TELL) REPEAT DROP ; Block 8002 +( The nodes this one has had born: for each its number and ) +( its place in the fabric. Sixteen at most. ) +CREATE (KIDS) 32 ALLOT VARIABLE (KIDS#) 0 (KIDS#) ! +: (KID@) ( i -- addr ) 2 * (KIDS) + ; +: (NOTE) ( number place -- ) + (KIDS#) @ 16 < IF + (KIDS#) @ (KID@) SWAP OVER 1+ ! ! 1 (KIDS#) +! + ELSE DROP DROP THEN ; +( which of them has that number: its place in the list, or -1 ) +: (WHICH) ( number -- i | -1 ) + -1 SWAP (KIDS#) @ DUP IF 0 DO + DUP I (KID@) @ = IF SWAP DROP I SWAP THEN + LOOP ELSE DROP THEN DROP ; +Block 8003 ( who it is, where its printing goes, and that everything ) ( not told of goes by its port 2, where this node is ) : (WHO) ( -- ) @@ -48,9 +62,10 @@ Block 8002 (NUCLEUS) (KID#) @ (KIDP) @ ROUTE (KID#) @ (KIDP) @ NEIGHBOUR (WHO) S" v4:forth79.4th" (LINES) -Block 8003 +Block 8004 S" (SEAL)" (TELL) (KID) @ (KID#) @ NODE-PARITY + (KID#) @ (KID) @ (NOTE) (KID) @ ; ( Two outer nodes are joined: port 3 of X to port 4 of Y, ) ( and each is told the other is there. ) @@ -63,7 +78,7 @@ VARIABLE (XP) VARIABLE (XN) VARIABLE (YP) VARIABLE (YN) : (JOIN) ( -- ) (XP) @ 3 (YP) @ 4 NODE-WIRE 0= IF (FAIL) THEN (YN) @ 3 (XN) @ (SAY) (XN) @ 4 (YN) @ (SAY) ; -Block 8004 +Block 8005 ( n -- A UNIT: four outer nodes, n+1 to n+4, on ports 2 ) ( to 5 of this one, and joined in a square: 1-2, 2-4, 4-3, ) ( 3-1. The corners across from each other are not wired: ) @@ -78,3 +93,19 @@ VARIABLE (P1) VARIABLE (P2) VARIABLE (P3) VARIABLE (P4) (P2) @ 2 (N) (X) (P4) @ 4 (N) (Y) (JOIN) (P4) @ 4 (N) (X) (P3) @ 3 (N) (Y) (JOIN) (P3) @ 3 (N) (X) (P1) @ 1 (N) (Y) (JOIN) ; +Block 8006 +( n -- KILL: node n is removed, whatever it was doing. ) +( This node forgets the way to it, and every other node it ) +( has had born is told that n is gone: each forgets its way ) +( to n, and one that is waiting for n's answer stops. ) +( docs/v4.0.0/MESH.md 7b.5. As v3's KILL, by number. ) +: (UNLIST) ( i -- ) + (KIDS#) @ 1- DUP (KIDS#) ! (KID@) DUP @ SWAP 1+ @ + ROT (KID@) SWAP OVER 1+ ! ! ; +: KILL ( n -- ) + DUP (WHICH) DUP 0< IF + DROP DROP ." KILL: no such node" CR -1 NODE-ERROR ! THEN + DUP (KID@) 1+ @ NODE-KILL (UNLIST) + DUP NO-ROUTE + (KIDS#) @ DUP IF 0 DO DUP I (KID@) @ GONE LOOP ELSE DROP THEN + DROP ; diff --git a/v4/tests/test_host_unit.c b/v4/tests/test_host_unit.c index b5ac5ea1..8f0f5d84 100644 --- a/v4/tests/test_host_unit.c +++ b/v4/tests/test_host_unit.c @@ -499,21 +499,62 @@ int main(void) CHECK(strcmp(tell(10, "(LOST) @ ."), "0 ") == 0 && strcmp(tell(12, "(LOST) @ ."), "0 ") == 0, "and no message was let go"); CHECK(waiting(10) && waiting(11) && waiting(12) && waiting(13) && waiting(14), "all five are waiting at their ports again"); - /* ---- a node is killed while its neighbour is writing to it ---- */ + /* ---- Hera kills a node by number, and tells the others it is gone (MESH.md 7b) ---- */ + + /* a node is killed while its neighbour is writing to it */ step_limit = 3000000ul; CHECK(strcmp(tell(14, ": SPIN BEGIN 0 UNTIL ; SPIN"), "(still running)") == 0, "node 14 is stuck in a loop that never ends"); CHECK(strcmp(tell(12, ": TO14 S\" 65 EMIT\" 14 SEND ; TO14"), "(still running)") == 0 && node_numbered(12)->asking, "node 12, beside it, sends it text: 14 never reads, and 12 is blocked writing to it"); { unsigned born = born_count; - const char *r = tell(10, "(P4) @ NODE-KILL 65 EMIT"); - CHECK(strstr(printed, "A") != NULL && node_numbered(14) == NULL && born_count == born, "Hera kills node 14: \"%s\"", r); + const char *r = tell(10, "14 KILL 65 EMIT"); + CHECK(strstr(printed, "A") != NULL && node_numbered(14) == NULL && born_count == born, "Hera kills node 14, by its number: \"%s\"", r); } CHECK(!node_numbered(12)->asking && !node_numbered(12)->stopped && waiting(12), "node 12 is no longer blocked: it is waiting at its ports"); CHECK(strstr(printed, "No one on that port") != NULL, "what it was doing ended in an error, which said so: \"%s\"", printed); step_limit = 30000000ul; CHECK(strcmp(tell(12, "12 100 * ."), "1200 ") == 0 && strcmp(tell(13, "13 100 * ."), "1300 ") == 0 && strcmp(tell(10, "1 2 + ."), "3 ") == 0, "and everything else keeps running: \"%s\"", printed); - CHECK(strstr(tell(12, ": AGAIN14 S\" 65 EMIT\" 14 SEND ; AGAIN14"), "No one on that port") != NULL && waiting(12), "a later write to where node 14 was is an error at once, not a wait: \"%s\"", printed); + CHECK(strstr(tell(12, "5 3 PORT!"), "No one on that port") != NULL && waiting(12), "a write to the port node 14 was on is an error at once, not a wait: \"%s\"", printed); + { + v4_cell refused = node_numbered(12)->mem[REFUSED]; + CHECK(tell(12, ": AGAIN14 S\" 65 EMIT\" 14 SEND ; AGAIN14")[0] == 0 && node_numbered(12)->mem[REFUSED] == refused + 1 && waiting(12), + "every node was told 14 is gone and forgot the way: what node 12 sends it now goes toward Hera, who has no way either, and is refused: \"%s\"", printed); + CHECK(strstr(tell(10, ": H14 S\" 1\" 14 SEND ; H14"), "Argument out of range") != NULL, "Hera herself has no way to it"); + } + + /* a node waits on one that is stuck and is not its neighbour; Hera kills the stuck one */ + step_limit = 3000000ul; + CHECK(strcmp(tell(13, ": SPIN BEGIN 0 UNTIL ; SPIN"), "(still running)") == 0, "node 13 is stuck in a loop"); + CHECK(strcmp(tell(12, ": W13 13 AWAIT . ; W13"), "(still running)") == 0 && node_numbered(12)->mem[AWAIT_FROM] == 13 && waiting(12), + "node 12, which is not wired to it, waits for its answer"); + (void)tell(10, "13 KILL"); + CHECK(node_numbered(13) == NULL && strstr(printed, "Node gone") != NULL && node_numbered(12)->mem[AWAIT_FROM] == 0 && waiting(12), + "Hera kills node 13: node 12's wait ends, with an error that says the node is gone: \"%s\"", printed); + step_limit = 30000000ul; + CHECK(strcmp(tell(12, "12 100 * ."), "1200 ") == 0 && strcmp(tell(11, "11 100 * ."), "1100 ") == 0, "and the others go on"); + + /* Hera's own wait, on a node that is stuck: a line from the console ends it */ + step_limit = 3000000ul; + CHECK(strcmp(tell(12, ": SPIN BEGIN 0 UNTIL ; SPIN"), "(still running)") == 0, "node 12 is stuck in a loop"); + CHECK(strcmp(tell(10, "12 AWAIT ."), "(still running)") == 0 && node_numbered(10)->mem[AWAIT_FROM] == 12 && waiting(10), "Hera waits for its answer, which will not come"); + { + const char *r = tell(10, "12 KILL 66 EMIT"); + CHECK(strstr(r, "Interrupted\n") != NULL && strstr(r, "B") != NULL && strstr(r, "Interrupted\n") < strstr(r, "B") && ended == 2, + "a line typed at the console ends her wait, with an error that says so, and is then done: \"%s\"", r); + CHECK(node_numbered(12) == NULL && node_numbered(10)->mem[AWAIT_FROM] == 0, "the line killed the stuck node"); + } + step_limit = 30000000ul; + + /* what is not a node she has had born */ + { + unsigned born = born_count; + CHECK(strstr(tell(10, "99 KILL"), "KILL: no such node") != NULL && ended_how == V4_TEXT_ERROR, "KILL of a node there never was is an error that says so: \"%s\"", printed); + CHECK(strstr(tell(10, "10 KILL"), "KILL: no such node") != NULL && ended_how == V4_TEXT_ERROR && node_numbered(10) != NULL, "so is KILL of Hera herself"); + CHECK(strstr(tell(10, "14 KILL"), "KILL: no such node") != NULL && ended_how == V4_TEXT_ERROR, "and of a node she has killed already"); + CHECK(born_count == born && node_numbered(11) != NULL && strcmp(tell(11, "11 100 * ."), "1100 ") == 0 && strcmp(tell(10, "1 2 + ."), "3 ") == 0, + "nothing was removed, and the two that are left go on"); + } printf(" %d checks, %d failures\n", checks, failures); return failures != 0;