admin/LithosAnanake
1
1
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

revert(v4.0.0): step 6d, the wait, is backed out -- two reviews found it unsound

Browse Source 
Ruled 2026-10-08.  The engine, the nucleus and their tests are as they
were at dfabfa46, before step 6d; the code of the wait and its tests are
in history at 075385ab..2cf37aab.  The limit of MESH.md 7b.7 stands: a
node that is stuck can hold up its neighbours until Hera kills it.

MESH.md 7c is kept as the record of the design as approved, and 7c.6 says
what was built, what the two reviews found, the cause the findings share
-- a node's message machinery runs on the stacks its text is using, and a
fault abandons whatever was in progress -- and what a second attempt
must settle before anything is built.

Kept from it, in hosted-check: a line that leaves 29 values on the stack,
and WORDS with 26 values on it.  Both hung the products at some commit of
the wait.

make -C v4 test and sanitize at both widths, hosted-check, lint; three
bare-metal boots typing both.  POST 538 of 538, word_count=317,
dict_hash=0xc0769523a47b7dc3 on all six: the hash of step 6c's code.

Co-Authored-By: Claude Opus 5.5 <noreply@anthropic.com>
This commit is contained in:
rajames
2026-10-08 07:31:40 -04:00
co-authored by Claude Opus 5.5
parent 10f5ffd00b
commit 6015c87157
20 changed files with 1108 additions and 1203 deletions
Download Patch File Download Diff File Expand all files Collapse all files
v4/capsule/quit.v4
+93 -256
View File
@@ -48,55 +48,19 @@ 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,
\ stops compiling first; it is always jumped to, never called, by
\ something that has emptied the return stack (or by a fault, which empties
\ it). (LINE-STATUS) keeps how the last text ended.
\ A TEXT MAY LEAVE 28 VALUES ON THE STACK. What a node does between texts
\ -- (IDLE)'s passes over the messages waiting -- needs four cells of it,
\ 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, 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) 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)
(MSG)+1 a! @ (MQ!) (ME) a! @ (MQ!) 3 (MQ!) \ to whoever sent the text, from this node, type 3
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
(LINE-STATUS) a! @ (MQ!) \ how it ended
(LINE-STATUS) b! dup !b
(FLUSH-OUT)
(DONE-PORT) a! @ (GATE) (MSG)+1 a! @ !b \ to whoever sent the text
3 (HDR) 4 !b !b \ a message of type 3, four characters long: 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
@@ -104,194 +68,42 @@ macro R-CLEAR RSTACK-DEPTH b! a !b endmacro
OK: drop 1 jump (FINISH)
GO: drop 0 jump (FINISH)
\ THE MESSAGES WAITING, GONE THROUGH. Three words below go through them
\ all, as (A-QUEUE) does further down: each in turn is taken from the
\ front, its eight cells into (MQ-HDR), and either used up or put at the
\ back, so that those that stay are in the order they were in. (A-LEFT)
\ is how many cells are still to be looked at, and (A-FOUND) what the pass
\ has found.
\ ( -- n ) the next of them is in (MQ-HDR); n is how many words of text
\ it has, which are still at the front
: (MQ-NEXT)
(A-HDR)
(MQ-HDR)+6 a! @ -if SIZED drop 0 jump N
SIZED: 3 + 2/ 2/
N: (A-LEFT) a! @ over 8 + - ! ;
\ ( -- port | 0 ) the port the message in (MQ-HDR) goes by: for one this
\ node made itself, (FINISH), the port kept with it, below zero; for any
\ other, the way to the node it is for
: (FWD-PORT)
(MQ-HDR)+7 a! @ -if THEIRS 0 SWAP - ;
THEIRS: drop (MQ-HDR) a! @ jump (PORT-FOR)
\ ( -- flag ) is the message in (MQ-HDR) one to pass on? One this node
\ made itself is; any other is unless it is for this node, and waits here
\ to be dealt with ((MINE?) holds text back)
: (FWD?)
(MQ-HDR)+7 a! @ -if THEIRS drop -1 ;
THEIRS: drop (MQ-HDR) a! @ (ME) a! @ xor ;
\ ( -- 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 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?)
(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 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 \ 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 it is to this text's sender
HIT: drop drop pop 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! !
(MQ-HDR)+3 a! @ (MSG)+3 a! ! (MQ-HDR)+4 a! @ (MSG)+4 a! ! (MQ-HDR)+5 a! @ (MSG)+5 a! !
(MQ-HDR)+6 a! @ (MSG)+6 a! ! (MQ-HDR)+7 a! @ (REPLY) a! !
TIB 2/ 2/ SWAP if EMPTY
-1 + FOR (MQ@) over a! ! 1 + NEXT
drop jump L
EMPTY: drop drop jump L
KEEP: (A-BACK) (A-TEXT) jump L
END: drop (A-FOUND) a! @ ;
\ ( -- flag ) WHAT IS TO BE PASSED ON IS OFFERED (MESH.md 7c.3): for each
\ message, the first for its port, its first word is offered there, unless
\ a refusal owed is offered there already; (PAY-K) is set to -1 for that
\ port. It stays with the messages waiting until the offer is taken.
\ One that cannot go at all is let go, counted in (LOST), and whoever
\ waits on it is told (core.v4, (TELL-OF)): one with no way known; one
\ whose way is a port with nothing on it; and one that fifteen nodes have
\ passed on already. The flag is not zero if any was let go.
\ A MESSAGE IS PASSED ON BY AT MOST 16 NODES. Its fourth word says how
\ many more may; 0, as a device sends it, is taken for 16.
: (FWD-SET)
0 (A-FOUND) a! !
(MQ#) a! @ (A-LEFT) a! !
L: (A-LEFT) a! @ if END drop
(MQ-NEXT) (A-WORD) a! ! \ its words of text, kept off the stack: this runs between lines
(FWD?) if STAYS drop
(MQ-HDR)+3 a! @ if FRESH jump COUNT
FRESH: drop 16
COUNT: -1 + if REFUSE drop
(FWD-PORT) if REFUSE \ ( port )
dup (THERE) if REFUSE2 drop
(PORT) - dup (PAY-K) + a! @ if FREE \ ( p slot ) p: the port, by its number
drop drop jump KEEP
FREE: drop dup push (MQ-HDR) a! @ SWAP (OFFER) + a! ! \ whom it is to, offered
-1 pop (PAY-K) + a! !
jump KEEP
STAYS: drop
KEEP: (A-BACK) (A-WORD) a! @ (A-TEXT) jump L
REFUSE2: drop
REFUSE: drop
(A-WORD) a! @ if NOTEXT -1 + FOR (MQ@) drop NEXT jump TOLD
NOTEXT: drop
TOLD: (LOST) a! @ 1 + ! 1 (A-FOUND) a! !
(MQ-HDR)+1 a! @ (MQ-HDR) a! @ (MQ-HDR)+2 a! @ (TELL-OF) jump L
END: drop (A-FOUND) a! @ ;
\ ( -- ) 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, (!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! !
L: (A-LEFT) a! @ if END drop
(MQ-NEXT)
(A-FOUND) a! @ if LOOK drop jump KEEP
LOOK: drop
(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! ! (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 + (!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 ;
\ ( -- ) WAITING. A node with nothing to do looks through the messages
\ waiting (core.v4).
\ ONE FOR THIS NODE is dealt with, the oldest first: (MINE?). A message
\ of type 1 is text to interpret: it is done as a line was, and (FINISH)
\ reports how it ended; one that came with a length no message has is
\ error 12. A NACK is counted and a GONE from the node's centre believed.
\ WITH NONE FOR IT, what it has for other nodes, and the refusals it owes,
\ are offered, each on the port it goes by, and the node sleeps in the
\ wait (MESH.md 7c): until one is taken, and then the rest of that one is
\ written; or until a word comes for it, and then that message is taken in
\ and it looks again. A node that is stuck never takes what is offered
\ it, and holds up nothing else.
\ WITH NOTHING WAITING AND NOTHING OWED it is blocked reading its ports
\ (docs/v4.0.0/MESH.md 4.1): it executes nothing until a neighbour writes,
\ and what arrives is taken in as any message is.
\ ( -- ) WAITING. A node with nothing to do deals with the oldest of the
\ messages waiting (core.v4). With none waiting it is blocked reading its
\ ports (docs/v4.0.0/MESH.md 4.1): it executes nothing until a neighbour
\ writes, and what arrives is taken in as any message is, its first word
\ from any port and the rest from the port that came on. The message's
\ text goes into TIB, which holds 1024 characters, the most a message
\ carries; one that came with a length no message has is error 12. A
\ message of type 1 for this node is text to interpret: it is done as a
\ line was, and (FINISH) reports how it ended. A message for another node
\ is passed on, (PASS-ON).
: (IDLE)
L: 1 (QUIET) a! ! \ nothing here is any text's doing: see (RAISED)
(MINE?) if OTHERS drop jump HAVE
OTHERS: drop
(MQ#) a! @ (OWED#) a! @ + if BLOCK drop
(PAY-SET) (FWD-SET) if SET drop jump L \ one was let go: what is owed has changed
SET: drop
(MQ#) a! @ (OWED#) a! @ + if BLOCK drop
(OFFERS) if CAME -if CAME drop \ nothing on a port: what was for it is let go next time round
(GATE-PORT) a! @ (PORT) - (PAY-K) + a! @ \ what was offered on the port it was taken on
-if OWED drop (FWD-GO) jump L
OWED: -1 + (PAY-GO) jump L
CAME: drop jump L
(PAY) \ what refusals can be sent now, are (core.v4)
(MQ#) a! @ if WAIT drop jump HAVE
WAIT: drop (OWED#) a! @ if BLOCK \ with one still owed it does not sleep:
drop (WRITERS) b! @b if L0 \ it takes in whatever is being written to it,
(LOW) (PORT) + dup b! @b (TAKE) jump L
L0: drop jump L \ and tries again
BLOCK: drop (PORT)+8 b! @b (PORT)+9 b! @b (PORT) + dup b! \ ( to port ) B: the port it came on
SWAP (TAKE) jump L
HAVE:
(MQ@) (MSG) a! ! (MQ@) (MSG)+1 a! ! (MQ@) (MSG)+2 a! ! (MQ@) (MSG)+3 a! !
(MQ@) (MSG)+4 a! ! (MQ@) (MSG)+5 a! ! (MQ@) (MSG)+6 a! ! (MQ@) (REPLY) a! !
(MSG)+6 a! @ -if SIZED
drop 0 (MSG)+6 a! ! 0 SPAN a! ! NODE-ERROR b! 12 !b \ no telling what it was
SIZED: drop
TIB 2/ 2/ (MSG)+6 a! @ 3 + 2/ 2/ if EMPTY
-1 + FOR (MQ@) over a! ! 1 + NEXT
drop jump READ
EMPTY: drop drop
READ:
0 (MSG)+6 a! @ TIB + C! \ a zero after the text
(MSG)+6 a! @ SPAN a! !
(MSG)+2 a! @ -1 + if TEXT
(MSG) a! @ (ME) a! @ xor if MINE drop jump (PASS-ON)
MINE: drop
(MSG)+2 a! @ -1 + if TEXT \ for this node, and
-3 + if NACK -1 + if GONE drop jump (IDLE) \ neither text nor these: let go
NACK: drop (REFUSED) a! @ 1 + ! jump (IDLE) \ a message of this node's was refused: counted
GONE: drop (MSG)+6 a! @ -4 + if G4 drop jump (IDLE) \ a node is gone, if its centre says so:
@@ -310,6 +122,25 @@ macro R-CLEAR RSTACK-DEPTH b! a !b endmacro
Q1: (PRINT-PORT) a! !
jump (LINE)
\ ( -- ) A MESSAGE FOR ANOTHER NODE is passed on (MESH.md section 7): all
\ of it, as it came, to the port that leads toward that node. With no way
\ known it is let go, and (LOST) counts it.
: (PASS-ON)
(MSG)+3 a! @ if FRESH jump COUNT \ how many more nodes may pass it on;
FRESH: drop 16 \ from a device, which set none: sixteen
COUNT: -1 + if SPENT (MSG)+3 a! !
(MSG) a! @ (PORT-FOR) if NOWAY
dup (THERE) if NOONE drop
(GATE) (MSG) a! 6 FOR @+ !b UNEXT \ its seven words
(MSG)+6 a! @ 3 + 2/ 2/ if SENT
-1 + TIB 2/ 2/ a! FOR @+ !b UNEXT \ and its text
jump (IDLE)
SENT: drop jump (IDLE)
NOONE: drop \ its way is a port with nothing on it
SPENT: \ it has been passed on as often as it may be
NOWAY: drop (LOST) a! @ 1 + !
(MSG)+1 a! @ (MSG) a! @ (MSG)+2 a! @ (TELL-OF) jump (IDLE) \ whoever waits on it is told (core.v4)
\ ( -- ) THE TEXT, INTERPRETED. It is in TIB with a zero after it and its
\ length in SPAN, and the return stack is empty. It is interpreted with one
\ return entry under it, this word's call of INTERPRET; whatever is on the
@@ -338,8 +169,8 @@ header ROUTE
\ ( node port -- ) the node on the other end of the port, by its number;
\ 0: none, or a device. Whoever wires the node tells it, and tells it again
\ when the wiring changes. It is how a node knows who its centre is
\ ((CENTRE)), from whom alone it believes a GONE.
\ when the wiring changes. It is what lets one of two neighbours, and one
\ only, wait to write to the other (core.v4, (GATE)).
header NEIGHBOUR
: NEIGHBOUR
dup -if POS jump BAD
@@ -367,18 +198,10 @@ header NO-ROUTE
\ ( about node type -- ) send the node a message of one word, `about`:
\ a NACK is type 4, a GONE type 5 (MESH.md 7b). With no way to the node
\ it is error 12. It is put with the messages waiting and goes from
\ (IDLE), or from AWAIT, as how text ended does ((FINISH)): so telling a
\ node that is stuck does not hold up the telling of the next. With no
\ room at all it is offered here.
\ it is error 12.
: (SEND1)
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
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 ;
push dup (PORT-FOR) if NOWAY
(GATE) !b pop (HDR) 4 !b !b ;
NOWAY: drop drop drop pop drop NODE-ERROR b! 12 !b ;
\ ( n node -- ) tell the node that node n is gone. It acts on that only
@@ -393,10 +216,10 @@ header NO-ROUTES
\ ( baddr u node port -- ) send the node u characters of text to
\ interpret, by the port given, by its address. It is on its way when this
\ returns. Its first word is offered until the neighbour takes it
\ (core.v4, (GATE)); the rest is written, each word waiting for it.
\ returns. The write waits for the neighbour to read, and is not begun
\ until it may be (core.v4, (GATE)).
: (SEND-ON)
(GATE) \ to
(GATE) !b \ to
1 (HDR)
dup !b \ length
3 + 2/ 2/ if NONE -1 +
@@ -486,38 +309,52 @@ header SEND-ON
LEFT: drop NODE-ERROR b! 20 !b ;
\ ( node -- how ) WAIT FOR THE NODE'S WORD OF HOW TEXT ENDED: 0 QUIT,
\ 1 completed, 2 an error: a message of type 3 for this node from that
\ node. (AWAIT-FROM) holds the node while it waits, and 0 otherwise.
\ 1 completed, 2 an error. This node is blocked reading its ports until a
\ message of type 3 comes for it from that node; every other message that
\ comes meanwhile is kept with the messages waiting. (AWAIT-FROM) holds the
\ node while it waits, and 0 otherwise.
\ THE WAIT ALSO ENDS, in an error, when the answer is not going to come
\ (MESH.md section 7b): a NACK about that node, error 19, Message refused;
\ or a GONE about it from this node's centre, error 20, Node gone. A NACK
\ about another node is counted, and a GONE about another has its way
\ forgotten, as they would be if this node were not waiting. A GONE is
\ believed only if this node's centre sent it: (CENTRE).
\ WHAT HAS COME ALREADY is looked through first, (A-QUEUE): the answer, a
\ NACK or a GONE may have been taken in before the wait began, while this
\ node was waiting to write, and is then with the messages waiting.
\ AND A LINE FROM THE CONSOLE BREAKS IT (7b.6): text for this node from its
\ console ends the wait in error 21, Interrupted, and is then done as
\ usual. It is the one way to end a wait on a node that is alive and
\ never answers, short of Hera's killing that node.
\ WHILE IT WAITS THE NODE DOES WHAT (IDLE) DOES, but for beginning text:
\ the messages waiting are looked through for what would end the wait,
\ (A-QUEUE); what it has for other nodes and the refusals it owes are
\ offered, and it sleeps in the wait (MESH.md 7c); what comes is taken in
\ and kept, and it looks again. So what passes through a node is not
\ kept back by its waiting, and what it sent before it began to wait --
\ a GONE, say -- goes.
\ console is kept, as any message is, the wait ends in error 21,
\ Interrupted, and the text is then done as usual. It is the one way to
\ end a wait on a node that is alive and never answers, short of Hera's
\ killing that node.
header AWAIT
: AWAIT
(AWAIT-FROM) a! !
L: (A-QUEUE)
(A-FOUND) a! @ if WAIT jump (A-END)
(A-QUEUE)
(A-FOUND) a! @ if WAIT jump (A-END)
WAIT: drop
(PAY-SET) (FWD-SET) if SET drop jump L \ one was let go: this node may have been told so
SET: drop
(OFFERS) if CAME -if CAME drop
(GATE-PORT) a! @ (PORT) - (PAY-K) + a! @
-if OWED drop (FWD-GO) jump L
OWED: -1 + (PAY-GO) jump L
CAME: drop jump L
L: (PORT)+8 b! @b (PORT)+9 b! @b (PORT) + dup b! SWAP (TAKE-HDR)
(MQ-HDR) a! @ (ME) a! @ xor if A1 drop jump KEEP
A1: drop (MQ-HDR)+2 a! @ \ for this node: its type
-1 + if TEXT -2 + if ANSWER -1 + if NACK -1 + if GONE drop jump KEEP
TEXT: drop (A-CONSOLE) (MQ-HDR)+1 a! @ xor if BREAK drop jump KEEP \ text: from the console?
BREAK: drop (TAKE-KEEP) 4 jump (A-END) \ kept, to be done next; and the wait is over
ANSWER: drop (MQ-HDR)+1 a! @ (AWAIT-FROM) a! @ xor if A3 drop jump KEEP
A3: drop (MQ-HDR)+6 a! @ -4 + if A4 drop jump KEEP
A4: drop 0 (AWAIT-FROM) a! ! @b ; \ its one word
NACK: drop (MQ-HDR)+6 a! @ -4 + if N4 drop jump KEEP
N4: drop @b (AWAIT-FROM) a! @ xor if REFUSED \ about the node waited for?
drop (REFUSED) a! @ 1 + ! jump L \ another: counted
REFUSED: drop 2 jump (A-END)
GONE: drop (MQ-HDR)+6 a! @ -4 + if G4 drop jump KEEP
G4: drop @b \ the node that is gone
(CENTRE) if NOC (MQ-HDR)+1 a! @ xor if CENTRE \ only its centre is believed
drop drop jump L
NOC: drop drop jump L
CENTRE: drop dup NO-ROUTE
(AWAIT-FROM) a! @ xor if LEFT drop jump L
LEFT: drop 3 jump (A-END)
KEEP: (TAKE-KEEP) jump L
\ ( w port -- ) write a cell to the port, by its number. It waits until
\ the neighbour has taken it. This is how a node is sent a capsule of F18
@@ -596,7 +433,7 @@ header ABORT
\ counted, and the node goes back to waiting.
: (RAISED)
(QUIET) a! @ if SPEAK
drop (OUT) (OUT^) a! ! (LOST) a! @ 1 + ! (MQ-MEND) jump (IDLE)
drop (OUT) (OUT^) a! ! (LOST) a! @ 1 + ! jump (IDLE)
SPEAK: drop
NODE-ERROR b! @b
-if POS drop 2 jump (DONE)