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/core.v4
+78 -143
View File
@@ -131,22 +131,25 @@ header CMOVE
NONE: drop drop (ROUTE-DEFAULT) a! @ ;
HIT: drop drop @+ pop drop ;
\ BEGINNING A MESSAGE: THE WAIT (MESH.md section 7c). A write waits until
\ the neighbour reads, and a node that is waiting to write reads nothing:
\ two neighbours that each began to write to the other would wait for ever,
\ and a node that wrote to one that was stuck would be stuck with it. So
\ a node does not write the first word of a message. It offers it, (GATE):
\ the word is stored at the port's offer address, and the node then reads
\ the wait, where it sleeps until the offer is taken or a word comes for
\ it, whichever is first. If a word comes, that message is taken in and
\ kept with the messages waiting, and the node offers again. When the
\ offer is taken the neighbour has the first word and reads to the end:
\ the rest is written, each word waiting for it.
\ (OFFER) is the offer address of port 0, and (WAIT) the wait. (READERS)
\ is the node's look at its neighbours, a bit for each port that has one
\ waiting to read, and above those a bit for each port that has anything
\ on it at all. (NEAR) is the number of the node on each port, told by
\ whoever wires it (NEIGHBOUR, quit.v4): it is how a node knows its centre.
\ LOOKING BEFORE WRITING (MESH.md section 7a). A write waits until the
\ neighbour reads, and a node that is waiting to write reads nothing: two
\ neighbours that each began to write to the other would wait for ever. So
\ a node does not begin a message until it has looked, (GATE):
\ - while any neighbour is waiting to write to it, it takes that message
\ in and keeps it with the messages waiting, to deal with when it has
\ nothing else to do;
\ - then, if the neighbour it means to write to is waiting to read, it
\ writes;
\ - and if that neighbour is not, it writes all the same when the
\ neighbour's number is the higher of the two, and otherwise looks
\ again. Of two neighbours one only may wait to write to the other, and
\ it is the lower: so those that wait are waiting on ever higher
\ numbers, and the highest of them is not waiting to write; it is
\ looking, and takes in what is being written to it.
\ (WRITERS) and (READERS) are the node's two looks at its neighbours, a bit
\ for each port. (NEAR) is the number of the node on each port, told by
\ whoever wires it (NEIGHBOUR, quit.v4); a port not told of -- a device's
\ -- is written to only when what is there is waiting to read.
\
\ THE MESSAGES WAITING are kept in (MQ) .. (MQ-END), one after another,
\ going round: for each its seven words, the port it came on, and its text.
@@ -159,6 +162,12 @@ header CMOVE
if Z -1 + FOR 2/ NEXT 1 and ;
Z: drop 1 and ;
\ ( mask -- index ) the lowest port in it; the mask is not zero
: (LOW)
0 push
L: dup 1 and if UP drop drop pop ;
UP: drop 2/ pop 1 + push jump L
\ ( w -- ) one more cell of the messages waiting. B is kept.
: (MQ!)
(MQ-TAIL) a! @ a! !+
@@ -182,7 +191,7 @@ header CMOVE
\ messages in so as to be free to write, where it cannot begin a message
\ of its own: so it notes what it owes, (OWE), in the eight pairs at
\ (OWED) -- whom it is owed to, and the node the message was for -- and
\ sends it when it next has nothing else to do, (PAY-SET). With eight owed
\ sends it when it next has nothing else to do, (PAY). With eight owed
\ already, one more is let go and counted. Nothing is owed for a NACK or
\ for a GONE, type 5: there is no NACK for a NACK. The last 36 cells of
\ the messages waiting are kept for those two types, so that ordinary
@@ -239,76 +248,37 @@ 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 0 (TAKING) a! ! ;
NOTEXT: drop 0 (TAKING) a! ! ;
pop if NOTEXT -1 + FOR @b (MQ!) NEXT ;
NOTEXT: drop ;
FULL: drop if READ -1 + FOR @b drop UNEXT jump LOSE
READ: drop
LOSE: (LOST) a! @ 1 + !
(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 ;
(MQ-HDR)+1 a! @ (MQ-HDR) a! @ (MQ-HDR)+2 a! @ jump (TELL-OF)
\ ( port to -- ) take in a message and keep it
: (TAKE) (TAKE-HDR) jump (TAKE-KEEP)
\ ( -- how ) THE WAIT, once. Whatever has been offered stands until
\ this returns. 0: a word came for this node instead; that whole message
\ has been taken in and kept, (TAKE), and its seven words are still in
\ (MQ-HDR). -1: an offer was taken; B is at the port it was taken on, and
\ (GATE-PORT) holds that port's address. 1: there is nothing on a port
\ that had an offer: no one will ever take it.
: (OFFERS)
(WAIT) b! @b push (PORT)+9 b! @b \ ( which ) R: the word
dup -PORTS + -if TAKEN
drop (PORT) + dup b! pop (TAKE) 0 ; \ a word, from that port: the message's first
TAKEN: dup -PORTS + -if NOONE \ ( which k x ) k: the port, by its number
drop (PORT) + (GATE-PORT) a! ! drop pop drop
(GATE-PORT) a! @ b! -1 ;
NOONE: drop drop drop pop drop 1 ;
\ ( w port -- ) BEGIN A MESSAGE: the word, its first, is offered on the
\ port, by its address, until it is taken; whatever is written to this
\ node meanwhile is taken in. B is left at the port. The two are kept in
\ (GATE-WORD) and (GATE-PORT), not on the stack: (GATE1), which is this
\ with the word already in (GATE-WORD), is run with the stack as full as
\ EMIT may be.
\ TEXT FROM THE CONSOLE for this node, coming while text it is doing waits
\ here, ends that text in error 21, Interrupted (MESH.md 7c.3); it is with
\ the messages waiting and is done next. It is how a node whose text must
\ begin a message to a node that is stuck is typed to. Not while (QUIET)
\ is set: what waits then is no text's doing.
\ With nothing on the port it is error 18.
: (GATE1) ( port -- )
\ ( port -- ) wait until a message may be begun on the port, by its
\ address, taking in whatever is being written to this node meanwhile; and
\ leave B at the port. The port is kept in (GATE-PORT), not on the stack:
\ this is run with the stack as full as EMIT may be.
: (GATE)
(GATE-PORT) a! !
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
(QUIET) a! @ if TEXTS drop jump L
TEXTS: drop
(MQ-HDR) a! @ (ME) a! @ xor if MINE drop jump L
MINE: drop
(MQ-HDR)+2 a! @ -1 + if TEXT drop jump L
TEXT: drop
(CONSOLE) a! @ if C0 jump C1
C0: drop (MSG)+1 a! @ \ no console told of: whoever sent the text being done
C1: (MQ-HDR)+1 a! @ xor if BREAK drop jump L
BREAK: drop NODE-ERROR b! 21 !b ;
: (GATE) ( w port -- ) push (GATE-WORD) a! ! pop jump (GATE1)
L: (WRITERS) b! @b if QUIET
(LOW) (PORT) + dup b! @b (TAKE) jump L
QUIET: drop
(GATE-PORT) a! @ (PORT) - (NEAR) + a! @ if ASK
(ME) a! @ - -if GO jump ASK \ its number less this node's
GO: drop (GATE-PORT) a! @ b! ; \ the neighbour's is the higher
ASK: drop
(READERS) b! @b (GATE-PORT) a! @ (PORT) - (BIT) if NOTYET
drop (GATE-PORT) a! @ b! ; \ it is waiting to read
NOTYET: drop
(READERS) b! @b (GATE-PORT) a! @ (PORT) - -PORTS - (BIT) if NOONE \ is there anything on the port at all?
drop jump L
NOONE: drop NODE-ERROR b! 18 !b ; \ no: what waits here would wait for ever
\ ( type -- ) words 1 to 5 of a message this node sends: from, type, and
\ the three that are carried and not used yet. Its caller has put B at the
@@ -319,30 +289,14 @@ header CMOVE
!b \ type
16 !b 0 !b 0 !b ; \ how many nodes may pass it on (the TTL: MESH.md 7b); ACL tag; sequence
\ PAYING WHAT IS OWED (MESH.md 7c.3). Every refusal owed is offered at
\ once, each on the port it goes by, one to a port, with whatever the node
\ has to pass on (quit.v4, (IDLE)), and the node sleeps in the wait: so
\ one owed to a node that is stuck does not keep back one owed to a node
\ that waits for it, and the node takes in whatever is written to it
\ meanwhile. One there is no way for, or whose way is a
\ port with nothing on it, is let go and counted first. (PAY-K) has a
\ 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! ! ;
\ PAYING WHAT IS OWED does not hold this node up. A refusal is sent if the
\ neighbour it goes by is reading at this moment. If it is not, and its
\ number is the higher, the refusal is written all the same, as any message
\ would be (MESH.md 7a): that neighbour takes it in when it next looks. If
\ its number is the lower, or it has not been told of, the refusal stays
\ owed, and this node goes on with what it has to do and tries again; it
\ does not sleep while it owes one (quit.v4, (IDLE)). One there is no way
\ for, or whose way is a port with nothing on it, is let go and counted.
\ ( k -- ) the k-th refusal owed is done with: the last takes its place
: (PAID)
@@ -350,55 +304,36 @@ header CMOVE
2* (OWED) + a! @+ @
push push 2* (OWED) + a! pop !+ pop ! ;
\ ( k -- ) the k-th refusal owed is let go if it cannot be sent at all
: (PAY-DROP)
dup 2* (OWED) + a! @ \ k to
(PORT-FOR) if NOWAY \ k port
(THERE) if GONE drop drop ;
GONE:
NOWAY: drop (LOST) a! @ 1 + ! jump (PAID)
\ ( k -- ) send the k-th refusal owed, if it can go now
: (PAY1)
dup 2* (OWED) + a! @+ @ \ k to about
over (PORT-FOR) if NOWAY \ k to about port
dup (THERE) if GONE
drop (READERS) b! @b over (PORT) - (BIT) if BUSY
drop
WRITE: b! \ k to about B: the port
SWAP !b 4 (HDR) 4 !b !b \ k to; from, type 4; four characters; about
jump (PAID)
BUSY: drop \ it is not reading:
dup (PORT) - (NEAR) + a! @ if LEAVE \ k to about port near
(ME) a! @ - -if BLIND jump LEAVE \ its number less this node's
BLIND: drop jump WRITE \ the higher: it will take it in
LEAVE: drop drop drop drop drop ;
GONE: drop
NOWAY: drop drop drop (LOST) a! @ 1 + ! jump (PAID)
\ ( k -- ) offer the k-th refusal owed on its port, if nothing is there yet
: (PAY-OFFER)
dup push 2* (OWED) + a! @ \ to R: k (the stack is kept shallow: this runs between lines)
dup (PORT-FOR) (PORT) - \ to n the port, by its number
dup (PAY-K) + a! @ if FREE
drop drop drop pop drop ;
FREE: drop
dup push (OFFER) + a! ! \ the message's first word, whom it is to
pop pop 1 + SWAP (PAY-K) + a! ! ;
\ ( -- ) 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
NONE: drop
CLEAR: (PAY-K) a! PORTS-1 FOR 0 !+ NEXT
(OWED#) a! @ if NONE2
-1 + FOR pop dup push (PAY-OFFER) NEXT ;
NONE2: drop ;
\ ( 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 (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 every refusal this node owes that can go now
: (PAY)
(OWED#) a! @ if NONE -1 +
FOR pop dup push (PAY1) NEXT ;
NONE: drop ;
\ ( -- ) 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
\ lowest. quit.v4 sets those two when text for this node arrives.
: (FLUSH-OUT)
(OUT^) a! @ (OUT) xor if NONE drop
(PRINT-TO) a! @ (GATE-WORD) a! ! (PRINT-PORT) a! @ (GATE1)
(PRINT-PORT) a! @ (GATE) (PRINT-TO) a! @ !b
2 (HDR)
(OUT^) a! @ (OUT) - dup !b
3 + 2/ 2/ -1 + (OUT) a!
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)