diff --git a/capsules/v4/nucleus-64.f18 b/capsules/v4/nucleus-64.f18 index 6a9e18e8..78a56597 100644 Binary files a/capsules/v4/nucleus-64.f18 and b/capsules/v4/nucleus-64.f18 differ diff --git a/v4/capsule/core.v4 b/v4/capsule/core.v4 index 3313a97a..4e60c86a 100644 --- a/v4/capsule/core.v4 +++ b/v4/capsule/core.v4 @@ -239,14 +239,26 @@ header CMOVE KEPT-FOR: drop -MQ-ROOM + ROOM: -if FULL drop push + (MQ-TAIL) a! @ (T-TAIL) a! ! (MQ#) a! @ (T-COUNT) a! ! 1 (TAKING) a! ! \ until all of it is here: (MQ-MEND) (MQ-HDR) a! @ (MQ!) (MQ-HDR)+1 a! @ (MQ!) (MQ-HDR)+2 a! @ (MQ!) (MQ-HDR)+3 a! @ (MQ!) (MQ-HDR)+4 a! @ (MQ!) (MQ-HDR)+5 a! @ (MQ!) (MQ-HDR)+6 a! @ (MQ!) (MQ-HDR)+7 a! @ (MQ!) - pop if NOTEXT -1 + FOR @b (MQ!) NEXT ; - NOTEXT: drop ; + pop if NOTEXT -1 + FOR @b (MQ!) NEXT 0 (TAKING) a! ! ; + NOTEXT: drop 0 (TAKING) a! ! ; FULL: drop if READ -1 + FOR @b drop UNEXT jump LOSE READ: drop LOSE: (LOST) a! @ 1 + ! - (MQ-HDR)+1 a! @ (MQ-HDR) a! @ (MQ-HDR)+2 a! @ jump (TELL-OF) + (MQ-HDR)+2 a! @ push 0 (MQ-HDR)+2 a! ! \ its type is taken out of (MQ-HDR): it is not here + (MQ-HDR)+1 a! @ (MQ-HDR) a! @ pop jump (TELL-OF) + +\ ( -- ) A MESSAGE HALF TAKEN IN IS LET GO. Whoever was writing it was +\ removed, and the error that told this node so ended the taking in: what +\ had come is with the messages waiting, and would be taken for a whole +\ message. They are put back as they were before it, and it is counted. +: (MQ-MEND) + (TAKING) a! @ if WHOLE + drop (T-TAIL) a! @ (MQ-TAIL) a! ! (T-COUNT) a! @ (MQ#) a! ! 0 (TAKING) a! ! + (LOST) a! @ 1 + ! ; + WHOLE: drop ; \ ( port to -- ) take in a message and keep it : (TAKE) (TAKE-HDR) jump (TAKE-KEEP) @@ -280,7 +292,8 @@ header CMOVE \ With nothing on the port it is error 18. : (GATE1) ( port -- ) (GATE-PORT) a! ! - L: (GATE-WORD) a! @ (GATE-PORT) a! @ -PORTS - 4 + a! ! \ the offer + L: 0 (WAIT) a! ! \ nothing else is offered + (GATE-WORD) a! @ (GATE-PORT) a! @ -PORTS - 4 + a! ! \ the offer (OFFERS) if CAME -if NOONE drop ; NOONE: drop NODE-ERROR b! 18 !b ; \ no one on that port CAME: drop @@ -316,6 +329,21 @@ header CMOVE \ cell for each port: which refusal is offered there, counted from 1; 0, \ none; -1, a message being passed on. +\ ( w -- ) WRITE A WORD OF A MESSAGE AFTER ITS FIRST, on the port +\ (GATE-PORT) holds, from where no error must come: the passes over the +\ messages waiting (quit.v4). It is offered, and the node waits for that +\ offer only: the neighbour has the first word and is reading the rest. +\ If there turns out to be nothing on the port -- the neighbour was removed +\ -- (W-GONE) is set, and this word and every one after it is let go +\ without waiting. Whoever begins the writing clears (W-GONE) first. +: (!W) + (W-GONE) a! @ if THERE drop drop ; + THERE: drop + (GATE-PORT) a! @ -PORTS - 4 + a! ! + (WAIT1) b! @b drop (PORT)+9 b! @b + -PORTS + -PORTS + -if NOONE drop ; + NOONE: drop 1 (W-GONE) a! ! ; + \ ( k -- ) the k-th refusal owed is done with: the last takes its place : (PAID) (OWED#) a! @ -1 + dup ! @@ -343,6 +371,7 @@ header CMOVE \ ( -- ) let go every refusal owed that cannot be sent; no port has an \ offer; then offer each that is left on its port : (PAY-SET) + 0 (WAIT) a! ! \ what was offered before is not: (IDLE) may have gone round without waiting (OWED#) a! @ if NONE -1 + FOR pop dup push (PAY-DROP) NEXT jump CLEAR @@ -355,9 +384,14 @@ header CMOVE \ ( k -- ) the offer of the k-th refusal owed was taken, and B is at the \ port: its other words are written, and it is done with : (PAY-GO) - dup 2* (OWED) + 1 + a! @ \ k about - 4 (HDR) 4 !b !b \ from, type 4; four characters; about - jump (PAID) + dup (A-WORD) a! ! \ k is kept off the stack: nothing is left there if the port goes + 2* (OWED) + 1 + a! @ push \ R: about + 0 (W-GONE) a! ! + (ME) a! @ (!W) 4 (!W) 16 (!W) 0 (!W) 0 (!W) \ from, type 4, and the three carried + 4 (!W) pop (!W) \ four characters; about + (W-GONE) a! @ if SENT drop (LOST) a! @ 1 + ! jump DONE + SENT: drop + DONE: (A-WORD) a! @ jump (PAID) \ ( -- ) send what has been printed, to where (PRINT-TO) says, by the port \ (PRINT-PORT): its length, then its characters, four to a word, the first diff --git a/v4/capsule/quit.v4 b/v4/capsule/quit.v4 index df61336e..9f305c0e 100644 --- a/v4/capsule/quit.v4 +++ b/v4/capsule/quit.v4 @@ -48,6 +48,21 @@ macro R-CLEAR RSTACK-DEPTH b! a !b endmacro \ structures. A definition that was under way stays hidden. : (RESET) 0 STATE a! ! (CG-RESET) CFBASE (CFP) a! ! ; +\ ( -- ) WHAT WAS PRINTED AND NOT SENT is put with the messages waiting, +\ as a message of type 2 to where (PRINT-TO) says, by +\ the port (PRINT-PORT): its characters four to a word, the first lowest. +: (QUEUE-OUT) + (OUT^) a! @ (OUT) - if NONE \ ( chars ) + dup 3 + 2/ 2/ (MQ#) a! @ + -MQ-ROOM + -if FULL drop + (PRINT-TO) a! @ (MQ!) (ME) a! @ (MQ!) 2 (MQ!) 17 (MQ!) 0 (MQ!) 0 (MQ!) + dup (MQ!) \ its length + 0 (PRINT-PORT) a! @ - (MQ!) \ the port, kept below zero: this node's own + 3 + 2/ 2/ -1 + push (OUT) \ ( at ) R: words - 1 + pop FOR dup a! @+ @+ 8* + @+ 8* 8* + @+ 8* 8* 8* + (MQ!) 4 + NEXT + drop (OUT) (OUT^) a! ! ; + NONE: drop ; + FULL: drop drop (OUT) (OUT^) a! ! (LOST) a! @ 1 + ! ; + \ ( s -- ) the text is done with. What it printed is sent, then a message \ saying how it ended -- 0 QUIT, 1 completed, 2 an error -- and the node waits \ for the next. (DONE) is entered with the same number and, for an error, @@ -59,31 +74,29 @@ macro R-CLEAR RSTACK-DEPTH b! a !b endmacro \ and a stack fault in the middle of a pass would leave those messages in \ pieces. So a text that leaves more ends here in "Stack overflow", with \ the stack emptied, as a fault would end it. -\ THE MESSAGE SAYING HOW IT ENDED is not written here: whoever sent the -\ text may be stuck, and this node would wait on it. It is put with the -\ messages waiting and passed on from (IDLE), as any message for another -\ node is. It is put before the others, and this node does not begin +\ THE MESSAGE SAYING HOW IT ENDED, AND WHAT THE TEXT PRINTED AND HAS NOT +\ SENT, are not written here: whoever they are for, or a node on the way, +\ may be stuck, and this node would wait on it. They are put with the +\ messages waiting, (QUEUE-OUT) for what was printed, and passed on from +\ (IDLE), as any message for another node is. With no room for one it +\ is let go and counted. It is put before the others, and this node does not begin \ another text from the same sender until it has gone ((MINE?)): so what \ one sender is told comes in the order the texts were done. : (FINISH) ( s -- ) DSTACK-DEPTH a! @ -30 + -if OVER drop \ what follows needs four cells of the stack: with 1 (QUIET) a! ! \ from here an error is not this text's: see (RAISED) - (LINE-STATUS) b! dup !b - (FLUSH-OUT) - 1 (MQ#) a! @ + -MQ-ROOM + -if FULL \ how it ended goes with the messages waiting, + (LINE-STATUS) a! ! + (MQ-MEND) + (QUEUE-OUT) \ what the text printed, and then + 1 (MQ#) a! @ + -MQ-ROOM + -if FULL \ how it ended, go with the messages waiting, drop \ to be passed on as any is: (IDLE) - (MQ#) a! @ push \ how many cells are there before it (MSG)+1 a! @ (MQ!) (ME) a! @ (MQ!) 3 (MQ!) \ to whoever sent the text, from this node, type 3 - 0 (MQ!) 0 (MQ!) 0 (MQ!) 4 (MQ!) \ four characters long + 17 (MQ!) 0 (MQ!) 0 (MQ!) 4 (MQ!) \ sixteen nodes may pass it on; four characters long 0 (DONE-PORT) a! @ - (MQ!) \ by the port that leads back, kept below zero: this node's own - (MQ!) \ how it ended - pop if FRONT -1 + FOR (MQ@) (MQ!) NEXT jump (IDLE) \ and those go round behind it: it is the oldest - FRONT: drop jump (IDLE) - OVER: drop 0 DSTACK-DEPTH a! ! jump (D-OVER) \ more left on it than may wait, the text ends in that error - FULL: drop \ no room at all: it is offered here, and the node waits - (MSG)+1 a! @ (DONE-PORT) a! @ (GATE) - 3 (HDR) 4 !b !b + (LINE-STATUS) a! @ (MQ!) \ how it ended jump (IDLE) + FULL: drop (LOST) a! @ 1 + ! jump (IDLE) \ no room at all: it is let go, and counted + OVER: drop 0 DSTACK-DEPTH a! ! jump (D-OVER) \ more left on it than may wait, the text ends in that error : (DONE) if GO -1 + if OK @@ -123,36 +136,47 @@ macro R-CLEAR RSTACK-DEPTH b! a !b endmacro \ ( -- flag ) IS THERE ONE FOR THIS NODE? The first that is, is taken \ out: its seven words into (MSG), the port it came on into (REPLY), its \ text into TIB. -\ TEXT IS NOT BEGUN WHILE THE ANSWER TO ITS SENDER'S LAST IS STILL HERE: -\ a message this node made itself, (FINISH), is ahead of it, to that -\ sender. Whom each such message seen so far is to is noted in (PAY-K), -\ which nothing else is using now, and (A-WORD) is how many: at most as -\ many as there are ports, and with more than that no text is begun. A -\ NACK or a GONE for this node is never held back. +\ TEXT IS NOT BEGUN WHILE WHAT ITS SENDER IS OWED FROM AN EARLIER ONE IS +\ STILL HERE: what that text printed, or how it ended -- a message of type +\ 2 or 3 this node made itself, (FINISH). (NOTES) goes through the +\ messages waiting first and notes whom each such message is to, in +\ (PAY-K), which nothing else is using now; (A-WORD) is how many: as many +\ as there are ports, and one that cannot be noted holds nothing back. A +\ GONE this node is sending holds nothing back either, and a NACK or a +\ GONE for this node is never held back. +: (NOTES) + 0 (A-WORD) a! ! + (MQ#) a! @ (A-LEFT) a! ! + L: (A-LEFT) a! @ if END drop + (MQ-NEXT) + (MQ-HDR)+7 a! @ -if KEEP0 + drop (MQ-HDR)+2 a! @ -2 + if NOTE -1 + if NOTE drop jump KEEP + NOTE: drop (A-WORD) a! @ -PORTS + -if KEEP0 + drop (MQ-HDR) a! @ push (A-WORD) a! @ dup 1 + ! (PAY-K) + a! pop ! + jump KEEP + KEEP0: drop + KEEP: (A-BACK) (A-TEXT) jump L + END: drop ; + : (MINE?) - 0 (A-FOUND) a! ! 0 (A-WORD) a! ! + (NOTES) + 0 (A-FOUND) a! ! (MQ#) a! @ (A-LEFT) a! ! L: (A-LEFT) a! @ if END drop (MQ-NEXT) (A-FOUND) a! @ if LOOK drop jump KEEP LOOK: drop - (MQ-HDR)+7 a! @ -if THEIRS - drop (A-WORD) a! @ -PORTS + -if MANY \ this node's own: whom it is to is noted - drop (MQ-HDR) a! @ push (A-WORD) a! @ dup 1 + ! (PAY-K) + a! pop ! - jump KEEP - MANY: drop PORTS-1 2 + (A-WORD) a! ! jump KEEP \ more than can be noted + (MQ-HDR)+7 a! @ -if THEIRS drop jump KEEP \ this node's own: to be passed on THEIRS: drop (MQ-HDR) a! @ (ME) a! @ xor if MINE drop jump KEEP MINE: drop (MQ-HDR)+2 a! @ -1 + if TEXT drop jump TAKE TEXT: drop - (A-WORD) a! @ if TAKE0 \ no answer is waiting to go - dup -PORTS + -1 + -if HOLD2 drop \ ( n count ) + (A-WORD) a! @ if TAKE0 \ nothing of this node's own is waiting to go (MQ-HDR)+1 a! @ SWAP -1 + (PAY-K) a! \ ( n from count-1 ) FOR dup @+ xor if HIT drop NEXT - drop jump TAKE \ none of them is to this text's sender + drop jump TAKE \ none of it is to this text's sender HIT: drop drop pop drop jump KEEP - HOLD2: drop drop jump KEEP TAKE0: drop TAKE: 1 (A-FOUND) a! ! (MQ-HDR) a! @ (MSG) a! ! (MQ-HDR)+1 a! @ (MSG)+1 a! ! (MQ-HDR)+2 a! @ (MSG)+2 a! ! @@ -203,8 +227,10 @@ macro R-CLEAR RSTACK-DEPTH b! a !b endmacro \ ( -- ) THE OFFER OF ONE WAS TAKEN, on the port (GATE-PORT) holds: the \ first of the messages waiting that goes by that port is the one. Its -\ other words are written, each waiting for the neighbour, which has its -\ first and reads to the end; and it is done with. +\ other words are written, (!W), each waiting for the neighbour, which has +\ its first and reads to the end; and it is done with. If the neighbour +\ is removed meanwhile the rest is let go, and counted: no error comes of +\ it, for an error here would leave the messages waiting in pieces. : (FWD-GO) 0 (A-FOUND) a! ! (MQ#) a! @ (A-LEFT) a! ! @@ -215,15 +241,17 @@ macro R-CLEAR RSTACK-DEPTH b! a !b endmacro (FWD?) if KEEP1 drop (FWD-PORT) (GATE-PORT) a! @ xor if THIS drop jump KEEP KEEP1: drop jump KEEP - THIS: drop 1 (A-FOUND) a! ! - (GATE-PORT) a! @ b! - (MQ-HDR)+1 a! @ !b (MQ-HDR)+2 a! @ !b + THIS: drop 1 (A-FOUND) a! ! (A-WORD) a! ! \ its words of text, kept off the stack + 0 (W-GONE) a! ! + (MQ-HDR)+1 a! @ (!W) (MQ-HDR)+2 a! @ (!W) (MQ-HDR)+3 a! @ if FRESH jump COUNT FRESH: drop 16 - COUNT: -1 + !b \ one fewer may pass it on - (MQ-HDR)+4 a! @ !b (MQ-HDR)+5 a! @ !b (MQ-HDR)+6 a! @ !b - if NOTEXT -1 + FOR (MQ@) !b NEXT jump L - NOTEXT: drop jump L + COUNT: -1 + (!W) \ one fewer may pass it on + (MQ-HDR)+4 a! @ (!W) (MQ-HDR)+5 a! @ (!W) (MQ-HDR)+6 a! @ (!W) + (A-WORD) a! @ if NOTEXT -1 + FOR (MQ@) (!W) NEXT jump SENT + NOTEXT: drop + SENT: (W-GONE) a! @ if WENT drop (LOST) a! @ 1 + ! jump L \ its reader was removed: the rest was let go + WENT: drop jump L KEEP: (A-BACK) (A-TEXT) jump L END: drop ; @@ -347,7 +375,7 @@ header NO-ROUTE push dup (PORT-FOR) if NOWAY \ ( about node port ) R: type 1 (MQ#) a! @ + -MQ-ROOM + -if FULL drop SWAP (MQ!) (ME) a! @ (MQ!) pop (MQ!) \ to, from, type - 0 (MQ!) 0 (MQ!) 0 (MQ!) 4 (MQ!) \ four characters long + 17 (MQ!) 0 (MQ!) 0 (MQ!) 4 (MQ!) \ sixteen nodes may pass it on; four characters long 0 SWAP - (MQ!) \ by that port, kept below zero: this node's own (MQ!) ; \ about FULL: drop (GATE) pop (HDR) 4 !b !b ; @@ -568,7 +596,7 @@ header ABORT \ counted, and the node goes back to waiting. : (RAISED) (QUIET) a! @ if SPEAK - drop (OUT) (OUT^) a! ! (LOST) a! @ 1 + ! jump (IDLE) + drop (OUT) (OUT^) a! ! (LOST) a! @ 1 + ! (MQ-MEND) jump (IDLE) SPEAK: drop NODE-ERROR b! @b -if POS drop 2 jump (DONE) diff --git a/v4/include/v4/node.h b/v4/include/v4/node.h index 43d45163..19ea7f9b 100644 --- a/v4/include/v4/node.h +++ b/v4/include/v4/node.h @@ -45,6 +45,7 @@ #define V4_PORT_ANY V4_PORTS /* not a port: "whichever port has a neighbour writing" */ #define V4_PORT_OFFER (V4_PORTS + 4u) /* not a port: the offer on port 0; the offer on port k is k further (the wait, below) */ #define V4_PORT_WAIT (2u * V4_PORTS + 4u) /* not a port: the wait */ +#define V4_PORT_WAIT1 (2u * V4_PORTS + 5u) /* not a port: the wait for an offer only */ #ifndef V4_NODE_WORDS #define V4_NODE_WORDS 1024u @@ -241,6 +242,13 @@ int v4_node_port_gone(v4_node *n, v4_cell code); * base + V4_PORT_WAIT the wait: a fetch here blocks the node until a * word comes for it on any port, or one of its * offers is taken, whichever is first. + * base + V4_PORT_WAIT1 the wait for an offer only: as the wait, but + * a word that comes for the node does not end + * it, and a writer to the node is not served. + * It is how the words of a message after the + * first are written by a node that must not be + * faulted if its reader is removed. + * A store to the wait withdraws every offer and waits for nothing. * A word that came is fetched as from "any port", and "which port" says * where from. When an offer was taken the fetch gives 0 and "which port" * gives V4_PORTS + k: the offer on port k. When there turns out to be diff --git a/v4/src/fabric.c b/v4/src/fabric.c index 47d6fed5..595c2eb8 100644 --- a/v4/src/fabric.c +++ b/v4/src/fabric.c @@ -147,11 +147,15 @@ static unsigned hand_over_write(v4_fabric *f, unsigned a) static unsigned hand_over_read(v4_fabric *f, unsigned a) { v4_node *n = &f->place[a].node->n; - unsigned first = n->read_port == V4_PORT_ANY ? 0 : n->read_port; - unsigned last = n->read_port == V4_PORT_ANY ? V4_PORTS - 1 : n->read_port; + unsigned first; + unsigned last; unsigned k; v4_cell value; + if (n->read_port > V4_PORT_ANY) return 0; /* the wait for an offer only: it reads no port */ + first = n->read_port == V4_PORT_ANY ? 0 : n->read_port; + last = n->read_port == V4_PORT_ANY ? V4_PORTS - 1 : n->read_port; + for (k = first; k <= last; k++) { const v4_wire *w = &f->place[a].wire[k]; if (w->kind == V4_WIRE_DEVICE && w->device->give && w->device->give(w->device->self, &value)) { @@ -241,7 +245,7 @@ unsigned v4_fabric_step(v4_fabric *f) if (!awake(f, i)) continue; n = &f->place[i].node->n; if ((n->asking && f->place[i].wire[n->ask_port].kind == V4_WIRE_NONE) - || (n->reading && !n->given && n->read_port != V4_PORT_ANY && f->place[i].wire[n->read_port].kind == V4_WIRE_NONE)) + || (n->reading && !n->given && n->read_port < V4_PORTS && f->place[i].wire[n->read_port].kind == V4_WIRE_NONE)) done += (unsigned)v4_node_port_gone(n, f->gone_error); else if (v4_node_in_wait(n)) { /* an offer on a port with nothing on it */ unsigned k; diff --git a/v4/src/node.c b/v4/src/node.c index 22ad0cea..491d31ab 100644 --- a/v4/src/node.c +++ b/v4/src/node.c @@ -99,6 +99,7 @@ void v4_node_store(v4_node *n, v4_cell addr, v4_cell value) n->offers |= 1u << k; return; } + if (port == (int)V4_PORT_WAIT) { n->offers = 0; return; } /* a store to the wait: every offer is withdrawn */ if (port >= 0) { v4_node_fault(n, V4_FAULT_ADDRESS, addr); return; } /* "any", "which port" and the rest are not written to */ } /* The stack registers: a store empties the stack. -1 when not attached. */ @@ -128,7 +129,7 @@ v4_cell v4_node_fetch(v4_node *n, v4_cell addr) if (port == (int)V4_PORTS + 1) return (v4_cell)n->last_from; if (port == (int)V4_PORTS + 2) return (v4_cell)n->writers; if (port == (int)V4_PORTS + 3) return (v4_cell)n->readers; - if (port == (int)V4_PORT_WAIT) { + if (port == (int)V4_PORT_WAIT || port == (int)V4_PORT_WAIT1) { /* the wait: the word that came, or 0 for an offer taken */ if (!n->given) return 0; n->given = 0; @@ -206,18 +207,19 @@ void v4_node_port_status(v4_node *n, unsigned writers, unsigned readers) int v4_node_port_index(const v4_node *n, v4_cell addr) { - if (n->port < 0 || addr < n->port || addr > n->port + (v4_cell)V4_PORT_WAIT) return -1; + if (n->port < 0 || addr < n->port || addr > n->port + (v4_cell)V4_PORT_WAIT1) return -1; return (int)(addr - n->port); } int v4_node_read_ready(v4_node *n, v4_cell addr) { int port = v4_node_port_index(n, addr); - if (port < 0 || (port > (int)V4_PORT_ANY && port != (int)V4_PORT_WAIT)) return 1; + if (port < 0 || (port > (int)V4_PORT_ANY && port != (int)V4_PORT_WAIT && port != (int)V4_PORT_WAIT1)) return 1; if (n->given && (port >= (int)V4_PORT_ANY || (unsigned)port == n->given_port)) return 1; n->reading = 1; - n->waiting = port == (int)V4_PORT_WAIT; /* the wait is a read of any port, with offers standing */ - n->read_port = n->waiting ? V4_PORT_ANY : (unsigned)port; + n->waiting = port >= (int)V4_PORT_WAIT; /* the wait is a read of any port, with offers standing; */ + n->read_port = port == (int)V4_PORT_WAIT ? V4_PORT_ANY /* the wait for an offer only reads no port at all */ + : (unsigned)port; return 0; } @@ -288,7 +290,7 @@ int v4_node_port_gone(v4_node *n, v4_cell code) return 1; } if (n->asking) n->asking = 0; - else if (n->reading && !n->given && n->read_port != V4_PORT_ANY) n->reading = 0; + else if (n->reading && !n->given && n->read_port < V4_PORTS) n->reading = 0; else return 0; v4_node_store(n, n->error_reg, code); /* raises it: P is the node's handler now */ return 1; diff --git a/v4/tests/host_map.h b/v4/tests/host_map.h index 3cd861a7..29c0c8bd 100644 --- a/v4/tests/host_map.h +++ b/v4/tests/host_map.h @@ -73,7 +73,7 @@ #define OWED (BUF0_W - 112) /* those: for each, the node it is owed to and the node the refused message was for */ #define ACL_HOOK (BUF0_W - 6) /* the xt of the access control recheck word, or 0 */ #define LINE_STATUS (BUF0_W - 9) /* how the last line ended: 0 QUIT, 1 completed, 2 an error */ -#define PORT (BUF0_W - 144) /* the node's ports (node.h): V4_PORTS of them, then "any port", "which port", who writes, who reads, an offer for each port, and the wait: 2 * V4_PORTS + 5 cells, between the output buffer and A_FOUND. Port 0 is where its requests go. */ +#define PORT (BUF0_W - 144) /* the node's ports (node.h): V4_PORTS of them, then "any port", "which port", who writes, who reads, an offer for each port, and the two waits: 2 * V4_PORTS + 6 cells, between the output buffer and A_FOUND. Port 0 is where its requests go. */ #define CONSOLE (BUF0_W - 16) /* the node what this one prints is sent to; 0: whoever sent the text being served */ #define ROUTE_COUNT (BUF0_W - 17) /* how many entries the table of ways holds */ #define ROUTE_DEFAULT (BUF0_W - 18) /* the port address for a node not in the table, or 0: there is none */ @@ -87,8 +87,12 @@ #define MQ_TAIL (BUF0_W - 36) /* where the next will go, */ #define MQ_COUNT (BUF0_W - 37) /* and how many cells they take */ #define AWAIT_FROM (BUF0_W - 39) /* the node whose word of how text ended is waited for */ +#define W_GONE (BUF0_W - 122) /* not 0: the port a message was being written to has nothing on it; its other words are let go */ +#define TAKING (BUF0_W - 121) /* not 0: a message is being taken in, and is only partly with the messages waiting; */ +#define T_TAIL (BUF0_W - 120) /* where they ended before it, */ +#define T_COUNT (BUF0_W - 119) /* and how many cells they took */ #define GATE_WORD (BUF0_W - 32) /* the first word of a message that is being offered */ -#define PAY_K (BUF0_W - 123) /* for each port, which refusal owed is offered there, counted from 1; 0: none. V4_PORTS cells */ +#define PAY_K (BUF0_W - 31) /* for each port, which refusal owed is offered there, counted from 1; 0: none. V4_PORTS cells */ #define GATE_PORT (BUF0_W - 38) /* the port address a message is about to be begun on */ #define NEAR (BUF0_W - 64) /* for each port, the number of the node on the other end; 0: not told */ #define MQ_HDR (BUF0_W - 56) /* a message being taken in: its seven words and the port it came on */ @@ -127,7 +131,7 @@ typedef char host_map_ports_fit[(V4_PORTS <= 8u) ? 1 : -1]; /* the messages waiting are above the dictionary */ typedef char host_map_queue_fits[(MQ_W >= DICT_END_W) ? 1 : -1]; /* the ports, with the offers and the wait after them, end below the cells that follow */ -typedef char host_map_port_block_fits[(PORT + 2 * (v4_cell)V4_PORTS + 5 <= PAY_K && PAY_K + (v4_cell)V4_PORTS <= BUF0_W - 115) ? 1 : -1]; +typedef char host_map_port_block_fits[(PORT + 2 * (v4_cell)V4_PORTS + 6 <= W_GONE && PAY_K + (v4_cell)V4_PORTS <= PRINT_TO) ? 1 : -1]; /* How many slots, from slot 0, a branch may sit in on a node this size: those * whose address field reaches every word of it. */ @@ -205,6 +209,11 @@ static int host_load(v4_text *tx, v4_node *n, const char *const *files, unsigned v4_text_constant(tx, "PORTS-1", (v4_cell)V4_PORTS - 1); v4_text_constant(tx, "(OFFER)", PORT + (v4_cell)V4_PORT_OFFER); v4_text_constant(tx, "(WAIT)", PORT + (v4_cell)V4_PORT_WAIT); + v4_text_constant(tx, "(WAIT1)", PORT + (v4_cell)V4_PORT_WAIT1); + v4_text_constant(tx, "(W-GONE)", W_GONE); + v4_text_constant(tx, "(TAKING)", TAKING); + v4_text_constant(tx, "(T-TAIL)", T_TAIL); + v4_text_constant(tx, "(T-COUNT)", T_COUNT); v4_text_constant(tx, "(AWAIT-FROM)", AWAIT_FROM); v4_text_constant(tx, "(MQ)", MQ_W); v4_text_constant(tx, "(MQ-END)", MQ_W + MQ_CELLS); diff --git a/v4/tests/test_fabric.c b/v4/tests/test_fabric.c index a51bba88..042ff1db 100644 --- a/v4/tests/test_fabric.c +++ b/v4/tests/test_fabric.c @@ -60,6 +60,12 @@ static void wait_into(v4_cell at) LIT(PB + (v4_cell)V4_PORT_WAIT); O(BANG_B); O(FETCH_B); LIT(at); O(BANG_A); O(STORE_A); LIT(PB + (v4_cell)V4_PORTS + 1); O(BANG_B); O(FETCH_B); LIT(at + 1); O(BANG_A); O(STORE_A); } +/* the wait for an offer only */ +static void wait1_into(v4_cell at) +{ + LIT(PB + (v4_cell)V4_PORT_WAIT1); O(BANG_B); O(FETCH_B); LIT(at); O(BANG_A); O(STORE_A); + LIT(PB + (v4_cell)V4_PORTS + 1); O(BANG_B); O(FETCH_B); LIT(at + 1); O(BANG_A); O(STORE_A); +} static void done_mark(void) { LIT(1); LIT(OUT + 2); O(BANG_A); O(STORE_A); } static void count_for_ever(void) { @@ -498,6 +504,34 @@ int main(void) CHECK(!v4_node_in_wait(&ND(a)->n) && ND(a)->n.faults == 0 && ND(a)->n.offers == 0 && ND(a)->n.mem[OUT] == 0 && ND(a)->n.mem[OUT + 1] == 2 * (v4_cell)V4_PORTS + 5 && ND(a)->n.mem[OUT + 2] == 1, "one that can take an error is woken and told there is nothing on port 5: no error is raised, and its offer is withdrawn: %ld", (long)ND(a)->n.mem[OUT + 1]); + /* offers are withdrawn by a store to the wait (found by the review of step 6d) */ + fresh(); + a = loaded(0); offer(0, 7); LIT(0); LIT(PB + (v4_cell)V4_PORT_WAIT); O(BANG_A); O(STORE_A); done_mark(); wait_for_ever(); + for (i = 0; i < 50; i++) (void)v4_fabric_step(&f); + CHECK(v4_asm_ok(&as) && ND(a)->n.mem[OUT + 2] == 1 && ND(a)->n.offers == 0 && ND(a)->n.faults == 0, "a node that offers and then stores to the wait has no offer left"); + + /* the wait for an offer only: a word that comes for the node does not end it */ + fresh(); + a = loaded(0); offer(0, 7); wait1_into(OUT); done_mark(); wait_for_ever(); + b = loaded(1); count_for_ever(); + c = loaded(2); LIT(PB + 0); O(BANG_B); LIT(9); O(STORE_B); wait_for_ever(); + CHECK(v4_asm_ok(&as) && v4_fabric_wire(&f, a, 0, b, 3) && v4_fabric_wire(&f, c, 0, a, 2), "a node waits for its offer only, to a node that never reads, while a third writes to it"); + for (i = 0; i < 200; i++) (void)v4_fabric_step(&f); + CHECK(v4_node_in_wait(&ND(a)->n) && ND(a)->n.mem[OUT + 2] == 0 && ND(c)->n.asking && (ND(c)->n.readers & 1u) == 0, "it goes on waiting; the writer is not served, and does not see it as reading"); + CHECK(v4_fabric_remove(&f, b) != 0, "the node offered to is removed"); + v4_fabric_gone_error(&f, 18); + v4_node_error_attach(&ND(a)->n, OUT + 20); + v4_node_fault_attach(&ND(a)->n, 900); + CHECK(v4_fabric_wire_device(&f, a, 7, &sink), "(the port it ends by reading has a device that gives nothing)"); + for (i = 0; i < 100 && ND(a)->n.mem[OUT + 2] == 0; i++) (void)v4_fabric_step(&f); + CHECK(ND(a)->n.mem[OUT + 1] == 2 * (v4_cell)V4_PORTS + 0 && ND(a)->n.faults == 0 && ND(a)->n.offers == 0 && ND(c)->n.asking, "it is told there is nothing on that port; no error is raised; the writer still waits"); + fresh(); + a = loaded(0); offer(0, 7); wait1_into(OUT); done_mark(); wait_for_ever(); + b = loaded(1); LIT(PB + 3); O(BANG_B); O(FETCH_B); LIT(OUT); O(BANG_A); O(STORE_A); wait_for_ever(); + CHECK(v4_asm_ok(&as) && v4_fabric_wire(&f, a, 0, b, 3), "the same, to a node that reads"); + (void)settle(300); + CHECK(ND(b)->n.mem[OUT] == 7 && ND(a)->n.mem[OUT + 1] == (v4_cell)V4_PORTS + 0 && ND(a)->n.mem[OUT + 2] == 1, "its offer is taken, and it is told"); + /* a host with one node, whose devices always take */ fresh(); a = loaded(0); offer(1, 21); offer(3, 23); wait_into(OUT); done_mark(); wait_for_ever(); diff --git a/v4/tests/test_host_mesh.c b/v4/tests/test_host_mesh.c index 41a823b2..bfc8082d 100644 --- a/v4/tests/test_host_mesh.c +++ b/v4/tests/test_host_mesh.c @@ -121,6 +121,28 @@ static int waiting(unsigned id) return n->reading && !n->given && n->read_port == V4_PORT_ANY; } +/* Three nodes in a row once more, 10 at the console, 11, 12: a new fabric, each + * told who it is and the way to the others. For the scenes at the end. */ +static unsigned starforth_node(unsigned k); +static void row_again(unsigned *hera, unsigned *mid, unsigned *far) +{ + unsigned i; + v4_fabric_init(&f, places, 3); + v4_fabric_gone_error(&f, V4_ERROR_NO_ONE); + *hera = starforth_node(0); *mid = starforth_node(1); *far = starforth_node(2); + (void)v4_fabric_wire_device(&f, *hera, 1, &console); + (void)v4_fabric_wire(&f, *hera, 2, *mid, 2); (void)v4_fabric_wire(&f, *mid, 3, *far, 2); + going.count = 0; going_at = 0; + step_cap = 20000000; + for (i = 0; i < 20; i++) (void)v4_fabric_step(&f); + (void)tell(0, "10 (ME) ! 1 (CONSOLE) ! 1 1 ROUTE 0 2 ROUTE"); + (void)tell(0, "11 (ME) ! 1 (CONSOLE) ! 2 DEFAULT-ROUTE 0 3 ROUTE"); + (void)tell(0, "12 (ME) ! 1 (CONSOLE) ! 2 DEFAULT-ROUTE"); + (void)tell(10, "11 2 ROUTE 12 2 ROUTE 11 2 NEIGHBOUR"); + (void)tell(11, "12 3 ROUTE 10 2 NEIGHBOUR"); + (void)tell(12, "11 2 NEIGHBOUR"); +} + int main(void) { unsigned hera, mid, far, i; @@ -487,6 +509,92 @@ int main(void) CHECK(v4_fabric_remove(&f, far) == &pool[2], "node 12 is removed"); CHECK(strcmp(said(10, "1 2 + ."), "3 ") == 0 && pool[0].n.mem[OWED_COUNT] == 0 && waiting(hera) && !v4_node_in_wait(&pool[0].n), "node 10 lets the refusal go and is at rest: \"%s\"", printed); + /* ==== what the review of step 6d found: each scene on a row of three, begun again ==== */ + + /* a node is removed while a message is being passed on to it */ + { + static char line[240]; + unsigned steps = 0, k; + unsigned depth; + row_again(&hera, &mid, &far); + CHECK(strcmp(tell(12, "7 8 * ."), "56 ") == 0, "three nodes in a row again"); + depth = pool[1].n.ds.depth; + memset(line, ' ', 200); memcpy(line, "1 DROP", 6); line[200] = 0; + printed_len = 0; printed[0] = 0; ended = 0; + (void)v4_message_text(&going, 12, CONSOLE_ID, V4_MSG_TEXT, line, 200); going_at = 0; + while (steps < 2000000 && !(pool[1].n.mem[MQ_COUNT] > 0 && pool[1].n.mem[MQ_COUNT] < 40 && pool[2].n.reading && pool[2].n.read_port == 2)) { (void)v4_fabric_step(&f); steps++; } + CHECK(steps < 2000000, "long text for node 12 is on its way through node 11, part written: %ld cells of it still with node 11", (long)pool[1].n.mem[MQ_COUNT]); + CHECK(v4_fabric_remove(&f, far) == &pool[2], "node 12 is removed"); + for (k = 0; k < 3000000 && v4_fabric_step(&f) != 0; k++) { } + CHECK(k < 3000000 && pool[1].n.mem[MQ_COUNT] == 0 && waiting(mid) && pool[1].n.ds.depth == depth, "node 11 comes to rest: it has let the rest go, keeps nothing, and its stack is as it was (%ld cells kept)", (long)pool[1].n.mem[MQ_COUNT]); + CHECK(strcmp(tell(11, "20 22 + ."), "42 ") == 0 && strcmp(tell(10, "1 2 + ."), "3 ") == 0, "and it and node 10 go on"); + } + + /* a node is removed while it is writing a message to its neighbour: the half that came is not kept */ + { + static char line[240]; + unsigned steps = 0, k; + row_again(&hera, &mid, &far); + memset(line, ' ', 200); memcpy(line, "1 DROP", 6); line[200] = 0; + printed_len = 0; printed[0] = 0; ended = 0; + (void)v4_message_text(&going, 12, CONSOLE_ID, V4_MSG_TEXT, line, 200); going_at = 0; + while (steps < 2000000 && !(pool[2].n.mem[MQ_COUNT] > 8 && pool[2].n.reading && pool[2].n.read_port == 2)) { (void)v4_fabric_step(&f); steps++; } + CHECK(steps < 2000000, "node 12 has taken in part of a long text from node 11: %ld cells", (long)pool[2].n.mem[MQ_COUNT]); + CHECK(v4_fabric_remove(&f, mid) == &pool[1], "node 11 is removed"); + for (k = 0; k < 3000000 && v4_fabric_step(&f) != 0; k++) { } + CHECK(k < 3000000 && pool[2].n.mem[MQ_COUNT] == 0 && waiting(far), "node 12 comes to rest, and has not kept the half: %ld cells", (long)pool[2].n.mem[MQ_COUNT]); + CHECK(v4_fabric_wire(&f, hera, 3, far, 3) && is_empty(tell(10, "12 NO-ROUTE 12 3 ROUTE")), "node 12 is wired to node 10 instead"); + (void)tell(12, "NO-ROUTES 1 3 ROUTE 10 3 ROUTE"); + CHECK(strcmp(tell(12, "7 8 * ."), "56 ") == 0, "and does what it is sent"); + } + + /* what a finished text printed, with the way to the console through a stuck node */ + row_again(&hera, &mid, &far); + CHECK(v4_fabric_wire(&f, hera, 3, far, 3) && is_empty(tell(10, "NO-ROUTES 1 1 ROUTE 11 2 ROUTE 12 3 ROUTE")) && strcmp(tell(12, "3 4 + ."), "7 ") == 0, + "node 12 is reached straight from node 10; what it prints still goes back by node 11"); + step_cap = 400000; + CHECK(strcmp(tell(11, ": ST BEGIN 0 UNTIL ; ST"), "(still running)") == 0, "node 11 is stuck in a loop"); + (void)said(10, ": P S\" 65 EMIT\" 12 SEND ; P"); + CHECK(v4_node_in_wait(&pool[2].n) && pool[2].n.mem[MQ_COUNT] > 0, "node 10 sends node 12 text that prints: what it printed, and how it ended, wait with node 12, offered, and it sleeps"); + (void)said(10, ": Q S\" 9 (REFUSED) !\" 12 SEND ; Q"); + (void)said(12, "8 (REFUSED) !"); + CHECK(pool[2].n.mem[REFUSED] == 0 && v4_node_in_wait(&pool[2].n), + "the next text from node 10, and text typed at the console for it, are kept back: what it owes each from the last has not gone (MESH.md 7c.3). It sleeps in the wait"); + { v4_cell kept = pool[2].n.mem[MQ_COUNT]; + (void)said(10, ": R S\" 7 (REFUSED) !\" 12 SEND ; R"); + CHECK(pool[2].n.mem[MQ_COUNT] > kept && v4_node_in_wait(&pool[2].n), "it is not held: it takes in what it is sent, and sleeps again"); } + CHECK(v4_fabric_remove(&f, mid) == &pool[1], "node 11 is removed"); + { unsigned k; for (k = 0; k < 3000000 && v4_fabric_step(&f) != 0; k++) { } + CHECK(k < 3000000 && pool[2].n.mem[REFUSED] == 7 && pool[2].n.mem[MQ_COUNT] == 0 && waiting(far), "what could not go is let go, the texts kept back are done in the order they came, and node 12 is at rest: %ld", (long)pool[2].n.mem[REFUSED]); } + + /* offers left standing when a node goes round to begin text */ + row_again(&hera, &mid, &far); + CHECK(v4_fabric_wire(&f, hera, 3, far, 3) && v4_fabric_wire(&f, hera, 4, far, 4), "nodes 10 and 12 are wired to each other twice over"); + (void)tell(10, "NO-ROUTES 1 1 ROUTE 11 2 ROUTE 12 3 ROUTE 77 3 ROUTE"); + (void)tell(10, ": SLOW 400000 0 DO LOOP ; : Z S\" 1 DROP\" 77 SEND SLOW ;"); + (void)tell(12, ": FWD99 S\" 67 EMIT\" 99 SEND ;"); + (void)tell(12, "NO-ROUTES 10 3 ROUTE 11 2 ROUTE 1 4 ROUTE 99 4 ROUTE"); + CHECK(strcmp(tell(12, "3 4 + ."), "7 ") == 0, "node 12's way to the console, and to 99, is by its other wire to node 10"); + step_cap = 300000; + CHECK(strcmp(tell(11, ": C S\" 1 DROP\" 12 SEND S\" FWD99\" 12 SEND BEGIN 0 UNTIL ; C"), "(still running)") == 0, "node 11 sends node 12 two texts and is stuck"); + step_cap = 30000; + (void)said(10, "Z"); + CHECK(pool[2].n.mem[OWED_COUNT] == 1, "node 10 sends 77 a message by node 12, which has no way, and is then busy: node 12 owes it a refusal, offered on its first wire"); + CHECK(v4_fabric_remove(&f, mid) == &pool[1], "node 11 is removed: node 12 lets its answer go, and begins the text it kept back"); + printed_len = 0; printed[0] = 0; printed_from = -1; + { unsigned k; for (k = 0; k < 20000000 && v4_fabric_step(&f) != 0; k++) { } + CHECK(k < 20000000, "all come to rest"); } + CHECK(strchr(printed, 'C') == NULL, "the text node 12 sent to 99 was not done by node 10: \"%s\" from %ld", printed, (long)printed_from); + CHECK(pool[0].n.mem[REFUSED] == 1 && pool[2].n.mem[OWED_COUNT] == 0, "node 10 was told its message to 77 was refused: %ld", (long)pool[0].n.mem[REFUSED]); + + /* many of a node's own messages waiting for a stuck node */ + row_again(&hera, &mid, &far); + step_cap = 300000; + CHECK(strcmp(tell(11, ": ST BEGIN 0 UNTIL ; ST"), "(still running)") == 0, "node 11 is stuck in a loop"); + { int k, good = 0; + for (k = 1; k <= 12; k++) { (void)said(10, "12 11 GONE"); if (strcmp(said(10, "1 2 + ."), "3 ") == 0) good++; } + CHECK(good == 12 && pool[0].n.mem[MQ_COUNT] == 108, "node 10 is told twelve times to tell it a node is gone, and after each still does what is typed: %d of 12, %ld cells kept", good, (long)pool[0].n.mem[MQ_COUNT]); } + printf(" %d checks, %d failures\n", checks, failures); return failures != 0; }