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/core.v4
+244 -210
View File
@@ -105,8 +105,8 @@ header CMOVE
\ to, from, type, heat and TTL, ACL tag, sequence, length in characters
\ The types: 1 text to be interpreted 2 what a node printed 3 how the
\ text ended (one word of text: 0 QUIT, 1 completed, 2 an error).
\ The header of the message being served is in the seven cells (MSG); (REPLY)
\ is the address of the port it came on; (ME) is this node's number.
\ The header of the text being served is in the seven cells (MSG); (REPLY)
\ is the port it came on, by its number; (ME) is this node's number.
\
\ Characters are kept in (OUT), 256 of them, a character to a cell, and sent
\ when it is full and when the text has been done with (quit.v4). (OUT^)
@@ -115,7 +115,7 @@ header CMOVE
\ THE STACK. What prints may be run with the data stack all but full: EMIT
\ has always needed one free cell and no more, and still does -- it keeps
\ the character and A on the return stack while it works. Sending needs
\ two.
\ three.
\ FINDING THE WAY (MESH.md section 7). A node knows its ports and nothing of
\ the shape they are wired in. Whoever wires it tells it, for a node, which
@@ -123,235 +123,269 @@ header CMOVE
\ node's number and a port's address; and (ROUTE-DEFAULT), the port for any
\ node that is not in the table, or 0.
\ ( node -- port | 0 ) the address of the port that leads toward the node
: (PORT-FOR)
\ ( node -- port | -1 ) the port, by its number, that leads toward the node
: (WAY)
(ROUTE#) a! @ if NONE -1 + (ROUTES) a!
FOR dup @+ xor if HIT drop @+ drop NEXT
0
NONE: drop drop (ROUTE-DEFAULT) a! @ ;
HIT: drop drop @+ pop drop ;
NONE: drop drop (ROUTE-DEFAULT) a! @ if NOWAY (PORT) - ;
NOWAY: drop -1 ;
HIT: drop drop @+ pop drop (PORT) - ;
\ 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.
\ WHOLE MESSAGES (MESH.md section 7d). A message waits on a wire, in the
\ fabric, and not in a node: each wire has a queue of whole messages each
\ way. A node asks the fabric to look at one, take it, move it to another
\ wire, drop it, or put one on, by the six addresses after its ports:
\ (WIRE) the port, by its number, that what follows is about
\ (WIRE-A) (WIRE-B) what the operation needs
\ (WIRE-DO) the operation: a store here is the asking
\ (WIRE-HOW) how it went: 0 done, 1 no room, 2 no one on that port,
\ 3 no such message, 4 not a message
\ (WIRE-HAVE) which wires have a message waiting, a bit to a port
\ The operations: 1 look 2 take 3 move 4 drop 5 put 6 first 7 next
\ 8 sleep 9 sleep for room 10 room. Each is whole: all of a message
\ moves or none of it. So a fault or an error in the middle of anything
\ here leaves no message half moved; and nothing here keeps, from one
\ operation to the next, anything a later pass does not set again for
\ itself: every pass over a wire begins by naming the wire and putting its
\ mark at its first message.
\ This replaced a ring of messages waiting in the node's own memory, a
\ list of refusals owed, and messages written and read a word at a time
\ (MESH.md 7a, 7b, 7c.6). The ports themselves are still written a word at
\ a time for the two things that are not messages: a newborn node's
\ nucleus (PORT!, quit.v4) and a node's requests to its kernel.
\
\ 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.
\ (MQ-HEAD) is where the oldest begins, (MQ-TAIL) where the next will go,
\ (MQ#) how many cells are taken. One that there is no room for is read to
\ its end and let go, and (LOST) counts it.
\ THE STACKS. All of this runs on the stacks the node's text is using.
\ (SERVE) and what it calls keep to four cells of the data stack and four
\ entries of the return stack, its own call among them; what they need
\ from one operation to the next is in cells. (ROOM-SERVE) tries that much.
\ ( mask index -- bit )
: (BIT)
if Z -1 + FOR 2/ NEXT 1 and ;
Z: drop 1 and ;
\ ( op -- how ) ask the fabric for the operation, and say how it went
: (DO) (WIRE-DO) b! !b (WIRE-HOW) b! @b ;
\ ( 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
\ ( port -- ) what is asked next is about that port's wire, by its number.
\ A number that is no port's is no wire: every operation then answers 2.
: (WIRE!) (WIRE) b! !b ;
\ ( w -- ) one more cell of the messages waiting. B is kept.
: (MQ!)
(MQ-TAIL) a! @ a! !+
a (MQ-END) xor if WRAP drop a jump SET
WRAP: drop (MQ)
SET: (MQ-TAIL) a! !
(MQ#) a! @ 1 + ! ;
\ ( cells port -- how ) has the port's wire that many cells free? 0: it
\ has; 1: it has not; 2: no one is on that port. Only this node puts
\ messages on the wires that lead from it, so room found stays until it
\ uses it.
: (ROOM?) (WIRE!) (WIRE-A) b! !b 10 jump (DO)
\ ( -- w ) the oldest cell of the messages waiting, which goes
: (MQ@)
(MQ-HEAD) a! @ a! @+
a (MQ-END) xor if WRAP drop a jump SET
WRAP: drop (MQ)
SET: (MQ-HEAD) a! !
(MQ#) a! @ -1 + ! ;
\ REFUSALS (MESH.md section 7b). A message this node has no room for, or
\ no way to pass on, is let go and counted in (LOST); and its sender is
\ told, by a message of type 4, a NACK, whose one word is the node the
\ refused message was for. A node finds it has no room while it is taking
\ 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). 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
\ messages cannot take all the room.
\ ( to about -- ) a refusal is owed to the node `to`, about the node `about`.
\ Owed to this node itself -- its own message came back to it and was let
\ go here -- it is put with the messages waiting, as if it had come by a
\ port, in the room kept for refusals.
: (OWE)
over (ME) a! @ xor if SELF drop
(OWED#) a! @ -8 + -if NOROOM
drop (OWED#) a! @ 2* (OWED) + a!
push !+ pop !
(OWED#) a! @ 1 + ! ;
SELF: drop 1 (MQ#) a! @ + -MQ-ROOM + -if NOROOM
drop push (MQ!) (ME) a! @ (MQ!) 4 (MQ!) 0 (MQ!) 0 (MQ!) 0 (MQ!) 4 (MQ!) 0 (MQ!) pop (MQ!) ;
NOROOM: drop drop drop (LOST) a! @ 1 + ! ;
\ ( from to type -- ) a message of that type, from the one node for the
\ other, has been let go here. Whoever is waiting on it is told: its
\ sender; or, for a node's answer (type 3), the node the answer was for,
\ which is the one that waits. Nothing is owed for a NACK or a GONE.
: (TELL-OF)
dup -4 + if NOT -1 + if NOT drop
-3 + if ANSWER drop jump (OWE) \ to its sender, about whom it was for
ANSWER: drop SWAP jump (OWE) \ to whom it was for, about the node that answered
NOT: drop drop drop drop ;
\ ( port -- flag ) is there anything on that port, by its address?
: (THERE)
(PORT) - -PORTS - (READERS) b! @b SWAP jump (BIT)
\ ( port to -- ) the seven words of a message being taken in, and the
\ port, go into (MQ-HDR). B is at the port, by its address, and `to` is
\ the message's first word, already read from it.
: (TAKE-HDR)
(MQ-HDR) a! !+ 5 FOR @b !+ UNEXT ! ;
\ ( -- ) the message whose seven words are in (MQ-HDR) is kept with the
\ messages waiting: its text is read from the port B is at. A length
\ below zero, or above what a message carries, is kept as -1 with no text:
\ a longer one is read to its end first, so that what follows it is not
\ taken for a message.
: (TAKE-KEEP)
(MQ-HDR)+6 a! @ -if SIZED
drop -1 (MQ-HDR)+6 a! ! 0 jump COUNTED
SIZED: dup -1025 + -if LONG drop 3 + 2/ 2/ jump COUNTED
LONG: drop 3 + 2/ 2/ -1 + FOR @b drop UNEXT -1 (MQ-HDR)+6 a! ! 0
COUNTED: \ ( n ) how many words of text follow
dup (MQ#) a! @ + \ what it would come to
(MQ-HDR)+2 a! @ -4 + if KEPT-FOR -1 + if KEPT-FOR \ a NACK or a GONE may use the room kept for them
drop -MQ-ORDINARY + jump ROOM
KEPT-FOR: drop -MQ-ROOM +
ROOM: -if FULL
drop push
(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 ;
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)
\ ( port to -- ) take in a message and keep it
: (TAKE) (TAKE-HDR) jump (TAKE-KEEP)
\ ( -- ) ROOM TO TAKE A MESSAGE IN. Once a message's first word has been
\ read the rest must be: whoever is writing it waits for that, and a fault
\ in the middle leaves the two out of step. Taking one in and keeping it
\ needs five cells of the data stack and four entries of the return stack.
\ So before a first word is read from within text -- where the stacks may
\ be as deep as the text has made them -- six and four are tried: if they
\ are not there the fault comes here, with nothing read, and the text
\ ends "Stack overflow" as it would have (MESH.md 7c.6).
\ ( -- ) ROOM FOR WHAT A WAIT DOES. A node that waits within text -- for
\ an answer, or for room to print -- passes on meanwhile what comes for
\ other nodes, on the stacks the text has left it: four cells of the data
\ stack and four entries of the return stack, (SERVE)'s. They are tried
\ before anything is taken off a wire or put on one: if they are not there
\ the fault comes here, and the text ends "Stack overflow" with nothing
\ half done (MESH.md 7c.7, 7d.4).
\ (ROOM-SERVE) tries just those, and is what a wait for room does each time
\ a message wakes it. (ROOM), which AWAIT does once before it waits, tries
\ six cells, as it did when a message was read a word at a time: the wait
\ ends in an error that leaves the stack as it is, and the line from the
\ console that broke it is then done on that stack, where printing needs
\ six (MESH.md 7c.7).
: (ROOM-SERVE)
0 0 0 0 drop drop drop drop
0 push 0 push 0 push 0 push pop drop pop drop pop drop pop drop ;
: (ROOM)
0 0 0 0 0 0 drop drop drop drop drop drop
0 push 0 push 0 push 0 push pop drop pop drop pop drop pop drop ;
\ ( 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! !
0 0 0 drop drop drop \ what follows the message's first word needs three cells: tried here, before it goes
L: (WRITERS) b! @b if QUIET
(ROOM) (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
\ port and sent word 0, whom it is to, and sends the length and the text.
\ Each write waits for the neighbour to take it.
\ ( to type -- ) the first six words of a message this node puts, in
\ (OUT-HDR): to, from, type, and the three that are carried: how many nodes
\ may pass it on, sixteen (the TTL: MESH.md 7b.3); ACL tag; sequence.
: (HDR)
(ME) a! @ !b \ from
!b \ type
16 !b 0 !b 0 !b ; \ how many nodes may pass it on (the TTL: MESH.md 7b); ACL tag; sequence
push (OUT-HDR) a! !+ (ME) b! @b !+ pop !+ 16 !+ 0 !+ 0 !+ ;
\ 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.
\ ( text port -- how ) put the message whose seven words are in (OUT-HDR)
\ and whose text is at the word address given on the wire of the port, by
\ its number. How it went is the fabric's answer: 0 it is on the wire.
\ THE ROOM KEPT FOR AN ANSWER. While this node does text, (KEEP) is the
\ port its word of how the text ended will go by, and nothing else it puts
\ on that wire may take the last 8 cells: a message that would is refused
\ here, 1, as if the wire were full. With no text being done (KEEP) is -1.
: (PUT-ON)
push (WIRE-B) b! !b pop
dup (WIRE!)
(KEEP) a! @ xor if KEPT
GO: drop (OUT-HDR) (WIRE-A) b! !b 5 jump (DO)
KEPT: drop (OUT-HDR)+6 a! @ 3 + 2/ 2/ 15 + (WIRE-A) b! !b 10 (DO) if GO ;
\ ( k -- ) the k-th refusal owed is done with: the last takes its place
: (PAID)
(OWED#) a! @ -1 + dup !
2* (OWED) + a! @+ @
push push 2* (OWED) + a! pop !+ pop ! ;
\ REFUSALS (MESH.md 7b, 7d.4). A message this node cannot pass on is
\ dropped and counted in (LOST), and whoever waits on it is told, by a
\ message of type 4, a NACK, whose one word is the node the refused message
\ was for: its sender; or, for a node's answer (type 3), the node the
\ answer was for, which is the one that waits, about the node that
\ answered. The NACK is put at once. If it cannot go -- no way, no one on
\ the port, no room -- it is counted in (LOST) too, and that is the end of
\ it. Nothing is told for a NACK or for a GONE, type 5: there is no NACK
\ for a NACK.
\ ( 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)
\ ( -- ) the message the mark of the wire in (WIRE) is at, whose seven
\ words are in (IN), is refused. A refusal for this node itself -- its own
\ message came back to it -- is counted in (REFUSED) as one that came by a
\ wire would be; or, if it is about the node this one is waiting on,
\ (A-SELF) is set for AWAIT to find (quit.v4).
\ (WIRE) is not what it was afterwards: the NACK went by another.
: (REFUSE)
4 (DO) drop
(LOST) a! @ 1 + !
(IN)+2 a! @ -4 + if NOT -1 + if NOT 2 + if ANSWER
drop (IN) a! @ (ONE) a! ! (IN)+1 a! @ jump TELL \ about whom it was for; to its sender
ANSWER: drop (IN)+1 a! @ (ONE) a! ! (IN) a! @ \ about the node that answered; to whom the answer was for
TELL: dup (ME) a! @ xor if SELF drop
dup 4 (HDR) 4 (OUT-HDR)+6 a! !
(WAY) (ONE) SWAP (PUT-ON) if SENT
drop (LOST) a! @ 1 + ! ;
SENT: drop ;
SELF: drop drop
(AWAIT-FROM) a! @ if COUNT (ONE) a! @ xor if MINE
COUNT: drop (REFUSED) a! @ 1 + ! ;
MINE: drop 1 (A-SELF) a! ! ;
NOT: drop ;
\ ( -- ) send every refusal this node owes that can go now
: (PAY)
(OWED#) a! @ if NONE -1 +
FOR pop dup push (PAY1) NEXT ;
NONE: drop ;
\ ( -- ) A MESSAGE FOR ANOTHER NODE is passed on (MESH.md section 7): the
\ one the mark of the wire in (WIRE) is at, whose seven words are in (IN),
\ is moved, whole, to the wire that leads toward that node. It is refused
\ instead if it has been passed on as often as a message may be; if there
\ is no way, or no one on the port; if that wire has no room for it; or if
\ that wire is the one room is kept on and it would take that room.
\ HOW OFTEN. A message's fourth word is how many more nodes may pass it
\ on; a node sends it with 16, and a move takes one off. The node that
\ finds 1 there refuses it. A device sends it with 0, which is taken for
\ 16: so 0 down to -14 are passed on and -15 is refused. Anything else is
\ nothing a node or a device sent, and is refused.
: (PASS)
(IN)+3 a! @ -if POS
14 + -if OK jump SPENT
POS: if OK -1 + if SPENT -16 + -if SPENT
OK: drop
(IN) a! @ (WAY) dup (P-WAY) a! !
(KEEP) a! @ xor if KEPT
GO: drop (P-WAY) a! @ (WIRE-A) b! !b 3 (DO) if MOVED
SPENT: drop jump (REFUSE)
MOVED: drop ;
KEPT: drop (IN)+6 a! @ 3 + 2/ 2/ 15 + (P-WAY) a! @ (ROOM?)
(S-WIRE) a! @ (WIRE!) if GO jump SPENT
\ ( -- ) ONE PASS OVER EVERY WIRE THAT HAS A MESSAGE. What is for another
\ node is passed on, or refused; what is for this node is left where it
\ is. Fetching (WIRE-HAVE) is what tells the fabric this node has seen
\ what had come: a sleep after this is woken only by what comes later
\ (MESH.md 7d.3). (S-HAVE) keeps which wires they were, for whoever then
\ looks for what is this node's own, (MINE).
: (SERVE)
(WIRE-HAVE) b! @b dup (S-HAVE) a! ! (S-MASK) a! !
0 (S-WIRE) a! !
W: (S-MASK) a! @ if END
dup 2/ ! 1 and if NEXTW
drop (S-WIRE) a! @ (WIRE!) 6 (DO) drop
M: (S-WIRE) a! @ (WIRE!) (IN) (WIRE-A) b! !b 1 (DO) if LOOKED jump NEXTW
LOOKED: drop
(IN) a! @ (ME) a! @ xor if MINE drop (PASS) jump M
MINE: drop 7 (DO) drop jump M
NEXTW: drop (S-WIRE) a! @ 1 + ! jump W
END: drop ;
\ WHAT IS FOR THIS NODE is gone through after (SERVE), a message at a time:
\ (MINE0) begins, and each (MINE) puts the mark of a wire at the next
\ message for this node and its seven words in (IN). Whoever asked then
\ takes or drops that message -- the mark is then at the one that followed
\ -- or leaves it and goes past it, (SKIP). The wire is (S-WIRE).
\ ( -- ) begin with the wires (SERVE) found a message on
: (MINE0) (S-HAVE) a! @ (S-MASK) a! ! -1 (S-WIRE) a! ! 0 (S-ON) a! ! ;
\ ( -- flag ) the next message for this node; 0: there are no more
: (MINE)
L: (S-ON) a! @ if WIRE
drop (S-WIRE) a! @ (WIRE!) (IN) (WIRE-A) b! !b 1 (DO) if LOOKED
drop 0 (S-ON) a! ! jump L \ this wire has no more
LOOKED: drop (IN) a! @ (ME) a! @ xor if HIT
drop 7 (DO) drop jump L
HIT: drop -1 ;
WIRE: drop (S-WIRE) a! @ 1 + ! \ the next wire that had one
(S-MASK) a! @ if NONE
dup 2/ ! 1 and if NOT
drop (S-WIRE) a! @ (WIRE!) 6 (DO) drop 1 (S-ON) a! ! jump L
NOT: drop jump L
NONE: ;
\ ( -- ) go past the message (MINE) found: it stays on its wire
: (SKIP) (S-WIRE) a! @ (WIRE!) 7 (DO) drop ;
\ ( -- ) take the message (MINE) found, which has one word of text: its
\ seven words stay in (IN), and its word goes to (ONE)
: (TAKE1) (S-WIRE) a! @ (WIRE!) (IN) (WIRE-A) b! !b (ONE) (WIRE-B) b! !b 2 (DO) drop ;
\ ( -- 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! @ ;
\ ( -- ) A LINE FROM THE CONSOLE BREAKS A WAIT FOR ROOM (MESH.md 7d.4).
\ If text for this node from its console is on a wire, the text being
\ done ends in error 21, Interrupted; the text from the console stays
\ where it is, to be done when this one has been finished with. Only
\ text that is still being done is broken: not once it has ended in an
\ error -- NODE-ERROR holds the code from then until the next text begins
\ -- or been finished with, (QUIET), when what waits for room is only what
\ it printed and the word of how it ended.
: (BREAK?)
(QUIET) a! @ if TEXT drop ;
TEXT: drop NODE-ERROR b! @b if CLEAN drop ;
CLEAN: drop (MINE0)
L: (MINE) if NO
drop (IN)+2 a! @ -1 + if T
KEEP: drop (SKIP) jump L
T: drop (A-CONSOLE) (IN)+1 a! @ xor if BRK jump KEEP
BRK: drop NODE-ERROR b! 21 !b ;
NO: drop ;
\ ( -- how ) WAIT UNTIL THE WIRE of the port (W-PORT) has (W-NEED) cells
\ free. 0: it has. 2: no one is on that port. The node sleeps until
\ there is room or a message comes; woken by a message it passes on what
\ is for other nodes, (SERVE), and sleeps again. It is the one thing a
\ node waits to put: what a text prints (MESH.md 7d.1, ruling 3).
: (WAIT-ROOM)
L: (W-PORT) a! @ (WIRE!) (W-NEED) a! @ (WIRE-A) b! !b 9 (DO)
if DONE -1 + if WOKEN drop 2 ;
WOKEN: drop (ROOM-SERVE) (SERVE) (BREAK?) jump L
DONE: ;
\ ( -- ) 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.
\ (PRINT-PORT): a message of type 2, its characters four to a word, the
\ first lowest. quit.v4 sets those two when text for this node arrives.
\ It waits for room on the wire, and for the 8 cells kept as well when the
\ wire is the one the answer goes by. The characters are made ready in
\ (OUT-TEXT), not where they are: until the message is on the wire the
\ buffer is as it was, and a fault on the way leaves it to be sent again.
\ The three cells and two return entries this needs are tried first.
\ WITH NO ONE ON THE PORT what was printed cannot be sent. While the text
\ is being done that is its error, 18; once it has been finished with
\ there is no one to tell: it is let go and counted in (LOST).
: (FLUSH-OUT)
(OUT^) a! @ (OUT) xor if NONE drop
(PRINT-PORT) a! @ (GATE) (PRINT-TO) a! @ !b
2 (HDR)
(OUT^) a! @ (OUT) - dup !b
3 + 2/ 2/ -1 + (OUT) a!
FOR @+ @+ 8* + @+ 8* 8* + @+ 8* 8* 8* + !b NEXT
(OUT) (OUT^) a! ! ;
0 0 0 drop drop drop 0 push 0 push pop drop pop drop
(OUT^) a! @ (OUT) - 3 + 2/ 2/ 7 +
(PRINT-PORT) a! @ (KEEP) a! @ xor if SAME drop jump NEED
SAME: drop 8 +
NEED: (W-NEED) a! ! (PRINT-PORT) a! @ (W-PORT) a! !
(WAIT-ROOM) if ROOM
drop (QUIET) a! @ if TELL
LOSE: drop (OUT) (OUT^) a! ! (LOST) a! @ 1 + ! ;
TELL: drop NODE-ERROR b! 18 !b ;
ROOM: drop
(PRINT-TO) a! @ 2 (HDR)
(OUT^) a! @ (OUT) - dup (OUT-HDR)+6 a! !
3 + 2/ 2/ -1 + push (OUT-TEXT) pop (OUT) a!
FOR @+ @+ 8* + @+ 8* 8* + @+ 8* 8* 8* + over b! !b 1 + NEXT
drop
(OUT-TEXT) (PRINT-PORT) a! @ (PUT-ON) if SENT jump LOSE
SENT: drop (OUT) (OUT^) a! ! ;
NONE: drop ;
\ EMIT puts the character with what has been printed. Everything the node
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)