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

feat(v4.0.0): messages are whole and wait on the wire -- a node keeps none but the one it is doing

Browse Source 
Step 6e, tasks 2 and 3 (docs/v4.0.0/MESH.md 7d).  The nucleus puts, looks
at, takes, moves and drops whole messages through the six addresses after
its ports; its own ring of messages waiting, the refusals owed, (GATE) and
the looking words' use are gone.  SEND, an answer, a NACK and a GONE go or
are refused at once; what a text prints waits for room; a text is not
begun until the wire its answer goes by has room for it, and that room is
kept.  The lone node's host (v4/system/boot.c) keeps its two wires and
does its operations; the test hosts' consoles put and take whole messages
through the fabric.  New: tests/test_host_depth.c, every message path of
a mesh node at every depth of both stacks.

Co-Authored-By: Claude Opus 5.5 <noreply@anthropic.com>
This commit is contained in:
rajames
2026-10-08 15:59:37 -04:00
co-authored by Claude Opus 5.5
parent 83694b18be
commit b1d09af043
12 changed files with 1621 additions and 834 deletions
Download Patch File Download Diff File Expand all files Collapse all files
v4/capsule/quit.v4
+172 -196
View File
@@ -5,10 +5,10 @@
\ the compiler capsule. Rests on all the files before it.
\
\ A NODE IS SENT TEXT (docs/v4.0.0/MESH.md section 6). It does not read its
\ own command line and prints no prompt. A node with nothing to do waits at
\ its ports; a neighbour writes it a message; if that is text for this node
\ it is interpreted; what it printed goes back as a message, and then a
\ message saying how the text ended:
\ own command line and prints no prompt. A node with nothing to do sleeps;
\ a message comes to one of its wires; if that is text for this node it is
\ taken and interpreted; what it printed goes back as a message, and then
\ a message saying how the text ended:
\ 1 it completed a console says " ok"
\ 2 it ended in an error the message is already printed; " ERROR"
\ 0 QUIT nothing is said
@@ -33,8 +33,7 @@
\ Constants the loader supplies:
\ (LINE-STATUS) word address of the variable: how the last text ended
\ (MSG) (REPLY) (ME) (OUT) (OUT^) see core.v4, "what a node prints"
\ (PORT) word address of the node's port 0; (PORT)+8 is "any port" and
\ (PORT)+9 the port the last read from that came on
\ (PORT) word address of the node's port 0
\ (Q) word address of four cells of scratch, which system.v4 and
\ blocks.v4 use too
\ DSTACK-DEPTH RSTACK-DEPTH word addresses of the stack registers
@@ -53,14 +52,27 @@ macro R-CLEAR RSTACK-DEPTH b! a !b endmacro
\ 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.
\ it). (LINE-STATUS) keeps how the last text ended, and is the one word of
\ the message's text.
\ THE ANSWER IS NOT REFUSED HERE: the text was not begun until the wire it
\ goes by had room for it, and that room has been kept, (KEEP), which is
\ let go only now (MESH.md 7d.4). If no one is on that port any more it
\ is counted in (LOST).
\ FOUR CELLS OF THE DATA STACK are tried first: what a node does between
\ texts -- this, passing messages on, taking the next text in -- and the
\ interpreter need that many, so text may leave 28 values on a stack of 32
\ and no more. Text that leaves more ends here, "Stack overflow", with
\ the stack emptied, and not later, in the middle of the text after it.
: (FINISH) ( s -- )
1 (QUIET) a! ! \ from here an error is not this text's: see (RAISED)
(LINE-STATUS) b! dup !b
1 (QUIET) a! ! \ from here nothing is this text's doing
(LINE-STATUS) b! !b
0 0 0 0 drop drop drop drop
(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)
-1 (KEEP) a! !
(MSG)+1 a! @ 3 (HDR) 4 (OUT-HDR)+6 a! ! \ to whoever sent the text: type 3, four characters
(LINE-STATUS) (DONE-PORT) a! @ (PUT-ON) if SENT
drop (LOST) a! @ 1 + ! jump (IDLE)
SENT: drop jump (IDLE)
: (DONE)
if GO -1 + if OK
@@ -68,79 +80,70 @@ macro R-CLEAR RSTACK-DEPTH b! a !b endmacro
OK: drop 1 jump (FINISH)
GO: drop 0 jump (FINISH)
\ ( -- ) 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).
\ ( -- flag ) A GONE has been taken: its seven words are in (IN) and the
\ node it is about in (ONE). It is believed only if this node's centre
\ sent it (MESH.md 7b.4): the way to the node is then forgotten, and the
\ flag is -1. Otherwise nothing is done, and 0.
: (GONE?)
(CENTRE) if NOT (IN)+1 a! @ xor if YES drop 0 ;
NOT: ;
YES: drop (ONE) a! @ NO-ROUTE -1 ;
\ ( -- ) WAITING (MESH.md 7d.4). A node with nothing to do passes on
\ what has come for other nodes, (SERVE), and then goes through what has
\ come for itself, the lowest port first and each wire from its front:
\ text is taken, into TIB, and done: (LINE), and then (FINISH) says
\ how it ended. But not unless the wire its answer goes by --
\ the way to whoever sent it, or with none known the wire it
\ came on -- has room for the answer, 8 cells. If it has not,
\ the text stays on its wire and the node looks further; that
\ room is kept from then until the answer has gone.
\ a NACK is taken and counted in (REFUSED)
\ a GONE is taken, and believed if this node's centre sent it
\ any other is dropped: an answer no one waits for, or what is not as
\ long as its type says.
\ With nothing to begin it sleeps, executing nothing, until a message
\ comes; or, if text is waiting for room for its answer, until that wire
\ has the room or a message comes. Then it does all of this again.
\ It has fetched which wires have a message before it looks at any, and
\ sleeps after: a message that comes while it looks wakes it at once, and
\ one it left on a wire does not keep it awake (MESH.md 7d.3).
\ (KEEP) and (AWAIT-FROM) are put back here every time: whatever was
\ abandoned on the way, a node with nothing to do keeps no room and waits
\ for no one.
: (IDLE)
L: 1 (QUIET) a! ! \ nothing here is any text's doing: see (RAISED)
(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:
-1 (KEEP) a! ! 0 (AWAIT-FROM) a! ! -1 (DEFER) a! !
(SERVE) (MINE0)
M: (MINE) if REST
drop (IN)+2 a! @ -1 + if TEXT -3 + if NACK -1 + if GONE
OTHER: drop 4 (DO) drop jump M \ let go
NACK: drop (IN)+6 a! @ -4 + if N1 jump OTHER
N1: drop (TAKE1) (REFUSED) a! @ 1 + ! jump M \ a message of this node's was refused: counted
GONE: drop (IN)+6 a! @ -4 + if G1 jump OTHER
G1: drop (TAKE1) (GONE?) drop jump M
TEXT: drop
(IN)+1 a! @ (WAY) -if T1 drop (S-WIRE) a! @ \ the way back; with none known, the wire it came on
T1: (DONE-PORT) a! !
8 (DONE-PORT) a! @ (ROOM?) -1 + if FULL drop jump START
FULL: drop (DEFER) a! @ -if LATER drop (DONE-PORT) a! @ (DEFER) a! ! (SKIP) jump M
LATER: drop (SKIP) jump M
REST: drop
(DEFER) a! @ -if ROOM drop 8 (DO) drop jump L
ROOM: (WIRE!) 8 (WIRE-A) b! !b 9 (DO) drop jump L
START:
(S-WIRE) a! @ dup (REPLY) a! ! (WIRE!)
(MSG) (WIRE-A) b! !b TIB 2/ 2/ (WIRE-B) b! !b 2 (DO) drop \ its seven words, and its text
0 (MSG)+6 a! @ TIB + C! \ a zero after the text
(MSG)+6 a! @ SPAN a! !
(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:
G4: drop (CENTRE) if NOT (MSG)+1 a! @ xor if CENTRE drop jump (IDLE)
NOT: drop jump (IDLE)
CENTRE: drop TIB 2/ 2/ a! @ NO-ROUTE jump (IDLE) \ the way to it is forgotten
TEXT: drop
(MSG)+1 a! @ (PORT-FOR) if D0 jump D1 \ the way back to whoever sent it:
D0: drop (REPLY) a! @ \ the port it came on, if no other is known
D1: (DONE-PORT) a! !
(DONE-PORT) a! @ (KEEP) a! ! \ the room for its answer is kept from here
(CONSOLE) a! @ if P0 jump P1 \ where what it prints goes: the console,
P0: drop (MSG)+1 a! @ \ or whoever sent it
P0: drop (MSG)+1 a! @ \ or whoever sent it;
P1: dup (PRINT-TO) a! !
(PORT-FOR) if Q0 jump Q1
Q0: drop (REPLY) a! @
(WAY) -if Q1 drop (REPLY) a! @ \ by the way there, or the wire the text came on
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
@@ -169,8 +172,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 what lets one of two neighbours, and one
\ only, wait to write to the other (core.v4, (GATE)).
\ when the wiring changes. It is how a node knows who its centre is, the
\ one node whose GONE it believes: (CENTRE).
header NEIGHBOUR
: NEIGHBOUR
dup -if POS jump BAD
@@ -197,12 +200,17 @@ header NO-ROUTE
pop a! SWAP !+ ! ;
\ ( 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.
\ a GONE is type 5 (MESH.md 7b). With no way to the node it is error 12.
\ It goes or is refused at once; refused -- no one on the port, or no room
\ on the wire -- it is counted in (LOST) (MESH.md 7d.4).
: (SEND1)
push dup (PORT-FOR) if NOWAY
(GATE) !b pop (HDR) 4 !b !b ;
NOWAY: drop drop drop pop drop NODE-ERROR b! 12 !b ;
push dup (WAY) -if GO
drop drop drop pop drop NODE-ERROR b! 12 !b ;
GO: (W-PORT) a! ! SWAP (ONE) a! !
pop (HDR) 4 (OUT-HDR)+6 a! !
(ONE) (W-PORT) a! @ (PUT-ON) if SENT
drop (LOST) a! @ 1 + ! ;
SENT: drop ;
\ ( n node -- ) tell the node that node n is gone. It acts on that only
\ if this node is its centre: it forgets the way to n, and if it is waiting
@@ -215,25 +223,39 @@ header NO-ROUTES
: NO-ROUTES 0 (ROUTE#) a! ! 0 (ROUTE-DEFAULT) a! ! ;
\ ( 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. The write waits for the neighbour to read, and is not begun
\ until it may be (core.v4, (GATE)).
\ interpret, by the port given, by its number. The text is made ready in
\ (SEND-TEXT), four characters to a word, the message is put on the wire
\ whole, and it is on its way when this returns. IT GOES OR IS REFUSED AT
\ ONCE (MESH.md 7d.1, ruling 3): with no room on the wire it is counted in
\ (REFUSED), as a refusal that came back would be, and is error 19, Message
\ refused; with no one on the port, error 18. Nothing is on a
\ wire until the put, the last thing done. More characters than a message
\ carries, or fewer than none, is error 12.
: (SEND-ON)
(GATE) !b \ to
1 (HDR)
dup !b \ length
push 1 (HDR)
-if POS
BAD: drop drop pop drop NODE-ERROR b! 12 !b ;
LONG: drop jump BAD
POS: dup -1025 + -if LONG
drop dup (OUT-HDR)+6 a! !
(SEND-TEXT) (SEND^) a! !
3 + 2/ 2/ if NONE -1 +
FOR dup C@ over 1 + C@ 8* + over 2 + C@ 8* 8* + over 3 + C@ 8* 8* 8* + !b 4 + NEXT
drop ;
NONE: drop drop ;
FOR dup C@ over 1 + C@ 8* + over 2 + C@ 8* 8* + over 3 + C@ 8* 8* 8* +
(SEND^) b! @b a! !+ a !b 4 + NEXT
drop jump PUT
NONE: drop drop
PUT: (SEND-TEXT) pop (PUT-ON)
if SENT -1 + if FULL drop NODE-ERROR b! 18 !b ;
FULL: drop (REFUSED) a! @ 1 + ! NODE-ERROR b! 19 !b ;
SENT: drop ;
\ ( baddr u node -- ) send the node u characters of text to interpret,
\ by the way this node knows to it. What it prints there goes to that
\ node's console. With no way to the node it is error 12.
header SEND
: SEND
dup (PORT-FOR) if NOWAY jump (SEND-ON)
NOWAY: drop drop drop drop NODE-ERROR b! 12 !b ;
dup (WAY) -if GO drop drop drop drop NODE-ERROR b! 12 !b ;
GO: jump (SEND-ON)
\ ( baddr u node port -- ) the same by a port this node names, by its
\ number, whatever ways it knows: for a neighbour that has no number of
@@ -241,7 +263,7 @@ header SEND
header SEND-ON
: SEND-ON
dup -if POS jump BAD
POS: -PORTS + -if BAD drop (PORT) + jump (SEND-ON)
POS: -PORTS + -if BAD drop jump (SEND-ON)
BAD: drop drop drop drop drop NODE-ERROR b! 12 !b ;
\ ( -- n ) the number of this node's centre: the node on the port that
@@ -251,111 +273,64 @@ header SEND-ON
(ROUTE-DEFAULT) a! @ if NONE (PORT) - (NEAR) + a! @ ;
NONE: ;
\ ( -- n ) the number of this node's console: the one it was told of, or
\ with none told of, whoever sent the text it is doing
: (A-CONSOLE)
(CONSOLE) a! @ if C0 ;
C0: drop (MSG)+1 a! @ ;
\ THE MESSAGES WAITING, LOOKED THROUGH for what would end a wait. Each in
\ turn is taken from the front: its eight cells into (MQ-HDR), (A-HDR). If
\ it is the answer waited for, or a NACK or a believed GONE for this node,
\ it is used up, as it would be had it come during the wait; otherwise it
\ goes to the back, (A-BACK) and (A-TEXT), so that when all have been
\ looked at they are in the order they were in. (A-LEFT) is how many
\ cells are still to be looked at. (A-FOUND) is what was found first: 0
\ nothing, 1 the answer, its word in (A-WORD); 2 a NACK about the node
\ waited for; 3 a GONE about it; 4 text from the console, which stays
\ where it is to be done next.
: (A-HDR) (MQ-HDR) a! 7 FOR a push (MQ@) pop a! !+ NEXT ;
: (A-BACK) (MQ-HDR) a! 7 FOR @+ a push (MQ!) pop a! NEXT ;
: (A-TEXT) if NONE -1 + FOR (MQ@) (MQ!) NEXT ; NONE: drop ;
: (A-QUEUE)
0 (A-FOUND) a! !
(MQ#) a! @ (A-LEFT) a! !
L: (A-LEFT) a! @ if END drop
(A-HDR)
(MQ-HDR)+6 a! @ -if SIZED drop 0 jump N
SIZED: 3 + 2/ 2/
N: (A-LEFT) a! @ over 8 + - ! \ n: its words of text
(A-FOUND) a! @ if LOOK drop jump KEEP \ something is found: the rest only go round
LOOK: drop
(MQ-HDR) a! @ (ME) a! @ xor if MINE drop jump KEEP
MINE: drop
(MQ-HDR)+2 a! @ -1 + if TEXT -2 + if ANS -1 + if NACK -1 + if GONE drop jump KEEP
TEXT: drop (A-CONSOLE) (MQ-HDR)+1 a! @ xor if BRK drop jump KEEP
BRK: drop 4 (A-FOUND) a! ! jump KEEP
ANS: drop (MQ-HDR)+1 a! @ (AWAIT-FROM) a! @ xor if A1 drop jump KEEP
A1: drop dup -1 + if A2 drop jump KEEP
A2: drop drop (MQ@) (A-WORD) a! ! 1 (A-FOUND) a! ! jump L
NACK: drop dup -1 + if N2 drop jump KEEP
N2: drop drop (MQ@) (AWAIT-FROM) a! @ xor if N3 drop (REFUSED) a! @ 1 + ! jump L
N3: drop 2 (A-FOUND) a! ! jump L
GONE: drop dup -1 + if G2 drop jump KEEP
G2: drop (CENTRE) if NOC (MQ-HDR)+1 a! @ xor if G3 drop jump KEEP
NOC: drop jump KEEP
G3: drop drop (MQ@) dup NO-ROUTE (AWAIT-FROM) a! @ xor if G4 drop jump L
G4: drop 3 (A-FOUND) a! ! jump L
KEEP: (A-BACK) (A-TEXT) jump L
END: drop ;
\ ( what -- how | ) the wait is over, by what (A-FOUND) says: the answer's
\ word is left; anything else is an error
\ ( what -- how | ) the wait is over: 1 the answer has come, and its
\ word, in (ONE), is left; 2 refused, error 19; 3 the node is gone, error
\ 20; 4 a line from the console, error 21
: (A-END)
0 (AWAIT-FROM) a! !
-1 + if ANS -1 + if REF -1 + if LEFT drop NODE-ERROR b! 21 !b ;
ANS: drop (A-WORD) a! @ ;
ANS: drop (ONE) a! @ ;
REF: drop NODE-ERROR b! 19 !b ;
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. 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 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.
\ 1 completed, 2 an error. (AWAIT-FROM) holds the node while this node
\ waits, and 0 otherwise. It sleeps, executing nothing, until a message
\ comes; then it passes on what is for other nodes, (SERVE), and goes
\ through what is for itself (MESH.md 7d.4):
\ the answer -- a message of type 3 from that node -- is taken, and the
\ wait is over;
\ a NACK is taken: about that node, the wait ends in error 19, Message
\ refused; about another it is counted, as at any time;
\ a GONE is taken: believed (its centre sent it: (GONE?)) and about that
\ node, the wait ends in error 20, Node gone;
\ text from its console ends the wait in error 21, Interrupted (7b.6).
\ The text is not taken: it stays on its wire and is done when this
\ text has been finished with. 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;
\ anything else stays on its wire, in its order, for when this node has
\ nothing to do.
\ WHAT HAS COME ALREADY is on the wires and is found the first time
\ through: the node looks before it sleeps. A message it left on a wire
\ does not keep it awake.
\ The stack what it does needs is tried first, (ROOM), core.v4: text that
\ has left too little ends "Stack overflow" with nothing taken off a wire.
header AWAIT
: AWAIT
(AWAIT-FROM) a! !
(A-QUEUE)
(A-FOUND) a! @ if WAIT jump (A-END)
WAIT: drop
L: (ROOM) \ before a first word is read: core.v4
(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
(AWAIT-FROM) a! ! 0 (A-SELF) a! !
(ROOM)
L: (SERVE)
(A-SELF) a! @ if SCAN drop 2 jump (A-END) \ this node's own message for that node came back to it
SCAN: drop (MINE0)
M: (MINE) if SLEEP
drop (IN)+2 a! @ -1 + if TEXT -2 + if ANSWER -1 + if NACK -1 + if GONE
KEEP: drop (SKIP) jump M
TEXT: drop (A-CONSOLE) (IN)+1 a! @ xor if BREAK jump KEEP \ text: from the console?
BREAK: drop 4 jump (A-END)
ANSWER: drop (IN)+1 a! @ (AWAIT-FROM) a! @ xor if A1 jump KEEP
A1: drop (IN)+6 a! @ -4 + if A2 jump KEEP
A2: drop (TAKE1) 1 jump (A-END)
NACK: drop (IN)+6 a! @ -4 + if N1 jump KEEP
N1: drop (TAKE1) (ONE) a! @ (AWAIT-FROM) a! @ xor if N2 \ about the node waited for?
drop (REFUSED) a! @ 1 + ! jump M \ another: counted
N2: drop 2 jump (A-END)
GONE: drop (IN)+6 a! @ -4 + if G1 jump KEEP
G1: drop (TAKE1) (GONE?) if M0 \ only its centre is believed
drop (ONE) a! @ (AWAIT-FROM) a! @ xor if G2 drop jump M
G2: drop 3 jump (A-END)
M0: drop jump M
SLEEP: drop 8 (DO) drop 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
@@ -427,11 +402,12 @@ header ABORT
\ its own -- and end the line with ERROR. The return stack has been
\ emptied; the data stack is as the word left it.
\ (QUIET) is 1 while the node is doing something that is no text's doing:
\ paying a refusal, passing a message on, or sending word of how a text
\ ended. An error then has nobody to be told to -- the usual one is that
\ no one is on the port (18) -- and trying to tell it would raise it again
\ without end. So it is not told: what was being sent is let go and
\ counted, and the node goes back to waiting.
\ passing a message on, or sending what a text printed and word of how it
\ ended. An error then has nobody to be told to, and telling it would
\ begin another message for a text that is over. Nothing the nucleus does
\ there raises one as it stands -- with no one on a port it counts what it
\ could not send, and goes on -- so this is a guard: if one is raised, what
\ was being sent is let go and counted, and the node goes back to waiting.
: (RAISED)
(QUIET) a! @ if SPEAK
drop (OUT) (OUT^) a! ! (LOST) a! @ 1 + ! jump (IDLE)