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