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
capsules/v4/nucleus-64.f18
BIN
View File
Binary file not shown.
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)
v4/include/v4/boot.h
+5 -5
View File
@@ -71,8 +71,8 @@ typedef struct {
int v4_boot_run(const v4_boot *b);
/* Hand the node a line and run it to its end, sending what it prints to
* `out`. The line is sent to the node as a message and what it prints
* comes back as messages (message.h). Returns how it ended -- V4_TEXT_QUIT,
* `out`. The line is put on the node's wire as a message, whole, and what
* it prints comes back as messages (message.h; docs/v4.0.0/MESH.md 7d.5). Returns how it ended -- V4_TEXT_QUIT,
* V4_TEXT_COMPLETED or V4_TEXT_ERROR -- or one of these: */
#define V4_BOOT_LINE_TOO_LONG (-1) /* more than the node's input buffer holds; nothing was run */
#define V4_BOOT_LINE_STOPPED (-2) /* the node stopped on a fault, or never finished */
@@ -81,12 +81,12 @@ int v4_boot_run(const v4_boot *b);
int v4_boot_line(const v4_boot *b, const char *text, unsigned len);
/* A LINE THAT WAITS (docs/v4.0.0/MESH.md 7b.6). V4_BOOT_LINE_WAITING means
* the line has not ended: the node is waiting at its ports for an answer,
* the line has not ended: the node is asleep, waiting for an answer,
* and here there is no one but the console to end that. The host reads the
* next line and hands it over as usual: that breaks the wait, and what is
* returned is how the line that was waiting ended -- in an error,
* Interrupted. The node has kept the line just handed over; the host then
* calls v4_boot_line with no text (0, 0) to have it done, and that returns
* Interrupted. The line just handed over is still on the node's wire; the host
* then calls v4_boot_line with no text (0, 0) to have it done, and that returns
* how it ended, which may be V4_BOOT_LINE_WAITING again. */
/* The dictionary hash of a node started from `im`. */
v4/include/v4/image.h
+2 -2
View File
@@ -27,8 +27,8 @@ typedef struct {
unsigned cell_bits, node_words, data_ring, ret_ring;
/* Where the nucleus waits for a message (v4/capsule/quit.v4, (IDLE)):
* the node's P is there, blocked reading its ports, when it has nothing
* to do. */
* a node that has taken the nucleus in begins there, and with nothing
* to do it is asleep at a wire inside it (operation 8, MESH.md 7d.3). */
v4_cell idle;
v4_cell fault_table; /* (FAULTS): where a fault goes */
v4_cell port; /* word address of the node's port (node.h) */
v4/system/boot.c
+169 -47
View File
@@ -8,6 +8,7 @@
#include "v4/blocks.h"
#include "v4/boot.h"
#include "v4/message.h"
#include "v4/wire.h"
#include "starkernel/capsule.h"
#include "starkernel/capsule_generated.h"
#include "starkernel/capsule_sig.h"
@@ -80,10 +81,11 @@ static uint32_t word_count(const v4_node *n, const v4_image *im)
/* ---- handing the node a line ---------------------------------------------- */
/* The boot is the node's neighbour on two of its ports. On port 0 it is
* the kernel: the node writes the number of a request there (ENGINE.md
* 3.3) -- for a block (blocks.h), or for one of the host's words. On port
* 1 it is the console: it writes the node a message of text and reads back
* messages of what the node printed and of how the text ended (message.h). */
* the kernel: the node writes the number of a request there, a word
* (ENGINE.md 3.3) -- for a block (blocks.h), or for one of the host's
* words. On port 1 it is the console: it puts a message of text on the
* node's wire and takes off it the messages of what the node printed and
* of how the text ended (message.h). */
#define KERNEL_PORT 0u
#define CONSOLE_PORT 1u
#define CONSOLE_ID 1 /* the console's number as a sender; the node's is 0 until it is given one */
@@ -91,23 +93,165 @@ static uint32_t word_count(const v4_node *n, const v4_image *im)
/* What the kernel keeps of the node's block window (blocks.h). */
static v4_blocks boot_blocks;
/* THE WIRES (docs/v4.0.0/MESH.md 7d.5). The lone node has no fabric: the
* boot keeps the queues of its two wires, a queue each way (wire.h), and
* does what the node asks of them, as a fabric does for a node of a mesh
* (fabric.c). Every other port has no one on it. The kernel's wire has
* its queues as any wire has; the kernel puts nothing on it and takes
* nothing off: its requests are words, not messages. */
static v4_wire_queue boot_wire[2][2]; /* by port: [0] to the node, [1] from it */
#define TO_NODE(port) (&boot_wire[port][0])
#define FROM_NODE(port) (&boot_wire[port][1])
/* 1 if `count` words from `addr` are the node's memory and not its ports
* or the addresses after them: they may be copied to and from. */
static int span_ok(const v4_node *n, v4_cell addr, unsigned count)
{
if (count == 0) return 1;
if (count > V4_NODE_WORDS || addr < 0 || (v4_ucell)addr > (v4_ucell)(V4_NODE_WORDS - count)) return 0;
if (n->port >= 0 && addr <= n->port + (v4_cell)V4_PORT_HAVE && addr + (v4_cell)count > n->port) return 0;
return 1;
}
static int boot_arrived(void)
{
return TO_NODE(KERNEL_PORT)->arrived || TO_NODE(CONSOLE_PORT)->arrived;
}
/* The node is blocked at an operation on a wire (node.h, v4_node_doing):
* do it, whole, and let the node go on; the operations and their answers
* are MESH.md 7d.3's, as fabric.c does them. Returns 0 if the node sleeps
* on: it asked to sleep (8), and no message has come since it last asked
* which wires have one; or for room (9) that is not there. */
static int boot_do(const v4_boot *bt)
{
v4_node *n = bt->n;
v4_wire_queue *rx = n->wire <= CONSOLE_PORT ? TO_NODE(n->wire) : 0, *tx = n->wire <= CONSOLE_PORT ? FROM_NODE(n->wire) : 0;
v4_cell a = n->wire_a, b = n->wire_b, h[V4_WIRE_HEADER], how = V4_WIRE_NO_ONE;
unsigned cells;
switch (n->do_op) {
case 1: /* look */
if (!rx) break;
if (rx->mark >= rx->used) how = V4_WIRE_NO_MESSAGE;
else how = span_ok(n, a, V4_WIRE_HEADER) ? v4_wire_look(rx, &n->mem[a]) : V4_WIRE_NOT_A_MESSAGE;
break;
case 2: /* take */
if (!rx) break;
if (v4_wire_look(rx, h) != V4_WIRE_DONE) { how = V4_WIRE_NO_MESSAGE; break; }
cells = v4_wire_cells(h[6]) - V4_WIRE_HEADER;
if (!span_ok(n, a, V4_WIRE_HEADER) || !span_ok(n, b, cells)) how = V4_WIRE_NOT_A_MESSAGE;
else how = v4_wire_take(rx, &n->mem[a], cells ? &n->mem[b] : &n->mem[0], cells);
break;
case 3: /* move */
if (!rx) break;
if (rx->mark >= rx->used) how = V4_WIRE_NO_MESSAGE;
else how = a >= 0 && a <= (v4_cell)CONSOLE_PORT ? v4_wire_move(rx, FROM_NODE((unsigned)a)) : V4_WIRE_NO_ONE;
break;
case 4: /* drop */
if (rx) how = v4_wire_drop(rx);
break;
case 5: /* put */
if (!tx) break;
cells = span_ok(n, a, V4_WIRE_HEADER) ? v4_wire_cells(n->mem[a + 6]) : 0;
if (cells == 0 || !span_ok(n, b, cells - V4_WIRE_HEADER)) how = V4_WIRE_NOT_A_MESSAGE;
else how = v4_wire_put(tx, &n->mem[a], cells > V4_WIRE_HEADER ? &n->mem[b] : &n->mem[0]);
break;
case 6: /* first */
if (rx) { v4_wire_first(rx); how = V4_WIRE_DONE; }
break;
case 7: /* next */
if (rx) how = v4_wire_next(rx);
break;
case 8: /* sleep */
if (!boot_arrived()) return 0;
how = V4_WIRE_DONE;
break;
case 9: /* sleep for room */
if (!tx) break;
if (a < 0 || a > (v4_cell)V4_WIRE_CELLS) { how = V4_WIRE_NO_ROOM; break; }
if (v4_wire_room(tx, (unsigned)a) == V4_WIRE_DONE) { how = V4_WIRE_DONE; break; }
if (!boot_arrived()) return 0;
how = V4_WIRE_NO_ROOM;
break;
case 10: /* room */
if (!tx) break;
how = a < 0 ? V4_WIRE_NOT_A_MESSAGE : a <= (v4_cell)V4_WIRE_CELLS ? v4_wire_room(tx, (unsigned)a) : V4_WIRE_NO_ROOM;
break;
default: /* not an operation */
how = V4_WIRE_NOT_A_MESSAGE;
break;
}
v4_node_done(n, how);
return 1;
}
/* The node is told which of its wires have a message and executes one
* instruction word; if it fetched which wires have one, it has seen what
* had come. The first half of a fabric's step (fabric.c). */
static void boot_exec(const v4_boot *b)
{
v4_node *n = b->n;
v4_node_have(n, (TO_NODE(KERNEL_PORT)->used ? 1u << KERNEL_PORT : 0u) | (TO_NODE(CONSOLE_PORT)->used ? 1u << CONSOLE_PORT : 0u));
(void)v4_exec_step_word(n, b->es, b->h);
if (n->have_fetched) {
TO_NODE(KERNEL_PORT)->arrived = 0;
TO_NODE(CONSOLE_PORT)->arrived = 0;
n->have_fetched = 0;
}
}
/* Time passes for the node, in the order a fabric's step has: that, and
* then what it asked of a wire is done. Returns 0 if it is asleep at a
* wire and sleeps on. */
static int boot_step(const v4_boot *b)
{
boot_exec(b);
return v4_node_doing(b->n) ? boot_do(b) : 1;
}
/* Hand the node a line and run it to its end. What it prints goes to the
* console; or, if `keep` is given, into `keep`, at most `cap` characters,
* and none of it is shown: *printed is then how many it printed in all. */
* and none of it is shown: *printed is then how many it printed in all.
* The console takes every message off the node's wire each time round, so
* what the node prints never waits for room for long. */
static int run_line(const v4_boot *b, const char *text, unsigned len, char *keep, unsigned cap, unsigned *printed)
{
static v4_message out, in; /* one line at a time: the boot is not re-entered */
static v4_message out; /* one line at a time: the boot is not re-entered */
static v4_cell in[V4_WIRE_HEADER], in_text[V4_MSG_MAX_CHARS / 4u];
v4_node *n = b->n;
uint64_t steps = 0;
unsigned sent = 0, i;
unsigned i;
if (!text) out.count = 0; /* no new line: the node has one it kept (boot.h) */
else if (!v4_message_text(&out, 0, CONSOLE_ID, V4_MSG_TEXT, text, len)) return V4_BOOT_LINE_TOO_LONG;
in.count = 0;
if (text) { /* with none, the node has a line waiting on its wire (boot.h) */
if (!v4_message_text(&out, 0, CONSOLE_ID, V4_MSG_TEXT, text, len)) return V4_BOOT_LINE_TOO_LONG;
if (v4_wire_put(TO_NODE(CONSOLE_PORT), out.word, out.word + V4_MSG_HEADER) != V4_WIRE_DONE) return V4_BOOT_LINE_STOPPED;
}
for (;;) {
(void)v4_exec_step_word(n, b->es, b->h);
int awake = boot_step(b);
if (n->stopped) return V4_BOOT_LINE_STOPPED;
v4_wire_first(FROM_NODE(CONSOLE_PORT)); /* what the node has sent its console, in the order it was sent */
while (v4_wire_take(FROM_NODE(CONSOLE_PORT), in, in_text, V4_MSG_MAX_CHARS / 4u) == V4_WIRE_DONE) {
if (in[2] == V4_MSG_OUTPUT) {
for (i = 0; i < (unsigned)in[6]; i++) {
char c = (char)(((v4_ucell)in_text[i / 4u] >> (8u * (i % 4u))) & 0xFFu);
if (!keep) b->out(&c, 1);
else { if (*printed < cap) keep[*printed] = c; (*printed)++; }
}
} else if (in[2] == V4_MSG_DONE) {
/* The text has ended. The node goes on to where it next asks something of a wire, with
* nothing of its own on either stack: whoever called may then look at its stacks, or
* empty them. */
for (i = 0; i < 4096u && !v4_node_doing(n) && !n->stopped && !n->asking; i++) boot_exec(b);
return (int)in_text[0];
}
}
if (!awake) {
if (n->do_op == 9) continue; /* waiting for room, which the console has just made */
return V4_BOOT_LINE_WAITING; /* waiting for an answer: only the console can end that */
}
if (n->asking && n->ask_port == KERNEL_PORT) { /* a request: the kernel's turn */
if (v4_blocks_serve(&boot_blocks, n, n->request)) { /* a block, as for any node */
v4_node_port_served(n);
@@ -122,36 +266,12 @@ static int run_line(const v4_boot *b, const char *text, unsigned len, char *keep
}
continue;
}
if (n->asking && n->ask_port == CONSOLE_PORT) { /* a word of a message from the node */
v4_cell word = n->request;
v4_node_port_served(n);
if (v4_message_word(&in, word)) {
unsigned chars = v4_message_length(&in);
if (v4_message_type(&in) == V4_MSG_OUTPUT) {
for (i = 0; i < chars; i++) {
char c = v4_message_char(&in, i);
if (!keep) b->out(&c, 1);
else { if (*printed < cap) keep[*printed] = c; (*printed)++; }
}
} else if (v4_message_type(&in) == V4_MSG_DONE) {
return (int)in.word[V4_MSG_HEADER];
}
in.count = 0;
}
continue;
}
if (n->asking) { /* a port with no one on it: an error on the node */
if (n->asking) { /* a word written to a port with no one on it: an error on the node */
if (!v4_node_port_gone(n, V4_ERROR_NO_ONE)) return V4_BOOT_LINE_STOPPED;
continue;
}
if (n->reading && !n->given) {
if (sent < out.count && (n->read_port == CONSOLE_PORT || n->read_port == V4_PORT_ANY)) {
v4_node_port_give(n, CONSOLE_PORT, out.word[sent++]); /* a word of the message to the node */
continue;
}
if (n->read_port != CONSOLE_PORT && n->read_port != KERNEL_PORT && v4_node_port_gone(n, V4_ERROR_NO_ONE)) continue; /* reading one port, with no one on it */
if (n->read_port == V4_PORT_ANY) return V4_BOOT_LINE_WAITING; /* waiting for an answer: only the console can end that */
if (n->reading && !n->given) { /* a word read from a port: no one here writes one */
if (n->read_port != V4_PORT_ANY && v4_node_port_gone(n, V4_ERROR_NO_ONE)) continue;
return V4_BOOT_LINE_STOPPED; /* waiting for what will not come */
}
if (v4_image_waiting(n, b->im)) { /* the text is reading the keyboard */
@@ -310,10 +430,14 @@ static int load_nucleus(const v4_boot *b)
if (!p || cap->length % CELL_BYTES != 0) { say(b, "V4: capsule " NUCLEUS_NAME " is not whole words\n"); return 0; }
words = cap->length / CELL_BYTES;
/* until it has taken every word and is waiting for a message: reading
* its ports again, but from its memory now and not from the port */
while (at < words || !(n->reading && !n->given && n->p != b->im->port + (v4_cell)V4_PORT_ANY)) {
(void)v4_exec_step_word(n, b->es, b->h);
/* until it has taken every word and is where the nucleus waits for a
* message: asleep, no message having come */
for (;;) {
if (!boot_step(b)) {
if (at >= words && n->do_op == 8) break;
say(b, "V4: the node did not take the nucleus in\n");
return 0;
}
if (n->stopped || n->asking || ++steps > STEP_LIMIT) {
say(b, "V4: the node did not take the nucleus in\n");
return 0;
@@ -322,7 +446,6 @@ static int load_nucleus(const v4_boot *b)
v4_ucell word = 0;
unsigned i;
if (at >= words) {
if (n->p != b->im->port + (v4_cell)V4_PORT_ANY) break; /* it is waiting for a message */
say(b, "V4: the node wants more than the nucleus holds\n");
return 0;
}
@@ -351,10 +474,9 @@ int v4_boot_run(const v4_boot *b)
say(b, "V4: the nucleus is not for this build of the engine\nPARITY:FAIL\nPOST: FAILED\n");
return 0;
}
/* what is on its two ports, the kernel and the console, takes a word
* when it is written: the node need never wait before writing to them
* (node.h, v4_node_port_status) */
v4_node_port_status(b->n, 0, (1u << KERNEL_PORT | 1u << CONSOLE_PORT) * (1u + (1u << V4_PORTS))); /* each of them there, and taking */
/* its two wires, the kernel's and the console's, with nothing on them */
v4_wire_reset(TO_NODE(KERNEL_PORT)); v4_wire_reset(FROM_NODE(KERNEL_PORT));
v4_wire_reset(TO_NODE(CONSOLE_PORT)); v4_wire_reset(FROM_NODE(CONSOLE_PORT));
v4_blocks_init(&boot_blocks, b->im->block_window);
if (!load_nucleus(b)) { say(b, "PARITY:FAIL\nPOST: FAILED\n"); return 0; }
v4/tests/host_map.h
+58 -39
View File
@@ -65,12 +65,7 @@
#define SRC (BVARS + 8)
#define SRC_HOOK (BVARS + 9)
#define QUIET (BUF0_W - 10) /* 1 while the node does something that is no text's doing: an error then is not told (quit.v4, (RAISED)) */
#define A_WORD (BUF0_W - 113) /* AWAIT's look through the messages waiting: the answer's word, */
#define A_LEFT (BUF0_W - 114) /* how many cells are still to be looked at, */
#define A_FOUND (BUF0_W - 115) /* and what was found */
#define REFUSED (BUF0_W - 7) /* how many of this node's messages it has been told were refused */
#define OWED_COUNT (BUF0_W - 8) /* how many refusals this node owes and has not sent yet, at most 8 */
#define OWED (BUF0_W - 112) /* those: for each, the node it is owed to and the node the refused message was for */
#define ACL_HOOK (BUF0_W - 6) /* the xt of the access control recheck word, or 0 */
#define LINE_STATUS (BUF0_W - 9) /* how the last line ended: 0 QUIT, 1 completed, 2 an error */
#define PORT (BUF0_W - 140) /* the node's ports (node.h): V4_PORTS of them, then "any port", "which port" and the rest as far as V4_PORT_HAVE. Port 0 is where its requests go. */
@@ -79,24 +74,42 @@
#define ROUTE_DEFAULT (BUF0_W - 18) /* the port address for a node not in the table, or 0: there is none */
#define LOST (BUF0_W - 19) /* how many messages have been let go for want of a way */
#define PRINT_TO (BUF0_W - 20) /* where what the text being served prints is to go: the node, */
#define WRITERS (PORT + (v4_cell)V4_PORTS + 2) /* which ports have a neighbour waiting to write to this node (node.h) */
#define READERS (PORT + (v4_cell)V4_PORTS + 3) /* and which have one waiting to read from it */
#define PRINT_PORT (BUF0_W - 33) /* and the port address that leads there */
#define DONE_PORT (BUF0_W - 34) /* the port address that leads back to whoever sent the text being served */
#define MQ_HEAD (BUF0_W - 35) /* the messages waiting to be dealt with: where the oldest begins, */
#define MQ_TAIL (BUF0_W - 36) /* where the next will go, */
#define MQ_COUNT (BUF0_W - 37) /* and how many cells they take */
#define PRINT_PORT (BUF0_W - 33) /* and the port, by its number, that leads there */
#define DONE_PORT (BUF0_W - 34) /* the port, by its number, that leads back to whoever sent the text being served */
/* WHOLE MESSAGES (MESH.md 7d.4; core.v4). A node keeps no message but the one it is doing: these are what it
* builds one in and looks at one with, and where it has got to in going through its wires. */
#define WIRE (PORT + (v4_cell)V4_PORT_WIRE) /* the six addresses after the ports (node.h): the wire an operation is about, */
#define WIRE_A (PORT + (v4_cell)V4_PORT_A) /* what it needs, */
#define WIRE_B (PORT + (v4_cell)V4_PORT_B)
#define WIRE_DO (PORT + (v4_cell)V4_PORT_DO) /* the operation, */
#define WIRE_HOW (PORT + (v4_cell)V4_PORT_HOW) /* how it went, */
#define WIRE_HAVE (PORT + (v4_cell)V4_PORT_HAVE) /* and which wires have a message */
#define S_HAVE (BUF0_W - 35) /* which wires had a message when the node last asked, */
#define S_MASK (BUF0_W - 36) /* those of them still to be gone through, */
#define S_WIRE (BUF0_W - 37) /* the one being gone through, */
#define S_ON (BUF0_W - 38) /* and whether its mark has been put at its first message */
#define KEEP (BUF0_W - 40) /* the port the answer to the text being done goes by, on whose wire 8 cells are kept for it; -1: none */
#define DEFER (BUF0_W - 41) /* a port whose wire had no room for the answer to text that waits to be begun; -1: none */
#define IN_HDR (BUF0_W - 56) /* the seven words of the message a wire's mark is at */
#define ONE (BUF0_W - 49) /* the one word of text of a NACK, a GONE or an answer, coming or going */
#define OUT_HDR (BUF0_W - 112) /* the seven words of a message this node is putting on a wire */
#define W_NEED (BUF0_W - 105) /* the wait for room: how many cells, */
#define W_PORT (BUF0_W - 104) /* and on which port's wire */
#define P_WAY (BUF0_W - 103) /* the port a message being passed on goes by */
#define A_SELF (BUF0_W - 102) /* 1: a message of this node's own, for the node it waits on, came back and was let go here */
#define SEND_PTR (BUF0_W - 101) /* where the next word of a text being made ready to send goes */
#define OUT_TEXT (OUT_W - 64) /* what was printed, four characters to a cell, as it goes on the wire: 64 cells */
#define SEND_TEXT (OUT_W - 400) /* the text of a message SEND is putting, four characters to a cell: 256 cells */
/* FREE, plain memory: BUF0_W - 8; - 32 .. - 21; - 100 .. - 97; - 115 .. - 113; and OUT_W - 144 .. OUT_W - 65. They and
* the cells above held the messages waiting, the refusals owed and what went with them (MESH.md 7a, 7b), which a
* node no longer keeps. */
#define AWAIT_FROM (BUF0_W - 39) /* the node whose word of how text ended is waited for */
#define GATE_PORT (BUF0_W - 38) /* the port address a message is about to be begun on */
#define NEAR (BUF0_W - 64) /* for each port, the number of the node on the other end; 0: not told */
#define MQ_HDR (BUF0_W - 56) /* a message being taken in: its seven words and the port it came on */
#define MQ_W (OUT_W - 400) /* the messages waiting: each is its seven words, the port it came on, its text */
#define MQ_CELLS 400
#define ROUTES (BUF0_W - 96) /* the table of ways: 16 entries of a node and the port address that leads to it */
#define ROUTE_MAX 16
#define ME (BUF0_W - 13) /* this node's number: a message is for it when its first word is this */
#define OUT_PTR (BUF0_W - 14) /* where the next character printed goes: a cell of the output buffer */
#define REPLY (BUF0_W - 15) /* the address of the port the message being served came on */
#define REPLY (BUF0_W - 15) /* the port, by its number, the text being served came on */
#define MSG (BUF0_W - 48) /* the header of the message being served, 7 cells */
#define OUT_W (BUF0_W - 400) /* the output buffer: 256 cells, a character to a cell */
#define OUT_CELLS 256
@@ -106,12 +119,12 @@
#define BOOT_CELLS (BVARS + 14) /* (BOOT): DP and LATEST as the loader left them, 2 cells */
#define BUF0_W (BVARS - (v4_cell)(V4_BLOCK_SLOTS * V4_BLOCK_CELLS)) /* the block window: the kernel's slots, 256 cells each (v4/blocks.h) */
/* The ports and the addresses after them, through V4_PORT_HAVE (node.h, MESH.md 7d.3), are not memory and must be where
* no variable is: after the output buffer, which ends at BUF0_W - 144, and before A_FOUND, the first variable above it.
* no variable is: after the output buffer, which ends at BUF0_W - 144, and before OUT_HDR, the first variable above it.
* With 8 ports that is 18 addresses, BUF0_W - 140 to BUF0_W - 123. (They were once among the variables, and what was
* stored to the variables was stored to ports.) */
typedef char host_map_ports_fit[(PORT >= OUT_W + OUT_CELLS && PORT + (v4_cell)V4_PORT_HAVE < A_FOUND) ? 1 : -1];
/* Nothing printed and no message waiting: a node's variables for them, as at switch-on. */
#define HOST_MESSAGES_EMPTY(n) do { (n)->mem[OUT_PTR] = OUT_W; (n)->mem[MQ_HEAD] = MQ_W; (n)->mem[MQ_TAIL] = MQ_W; (n)->mem[MQ_COUNT] = 0; } while (0)
typedef char host_map_ports_fit[(PORT >= OUT_W + OUT_CELLS && PORT + (v4_cell)V4_PORT_HAVE < OUT_HDR) ? 1 : -1];
/* Nothing printed: a node's variable for it, as at switch-on. */
#define HOST_MESSAGES_EMPTY(n) do { (n)->mem[OUT_PTR] = OUT_W; } while (0)
#define QVARS (BUF0_W - 4) /* (Q): quit.v4, system.v4 and blocks.v4, 4 cells */
#define WBUF (WBUF_W * 4)
#define TIB (TIB_W * 4)
@@ -125,8 +138,8 @@ typedef char host_map_ports_fit[(PORT >= OUT_W + OUT_CELLS && PORT + (v4_cell)V4
#ifndef DICT_END_W
#define DICT_END_W ((v4_cell)13824) /* 512 cells lower than it was: the block window is four slots now */
#endif
/* the messages waiting are above the dictionary */
typedef char host_map_queue_fits[(MQ_W >= DICT_END_W) ? 1 : -1];
/* the texts made ready for the wire are above the dictionary */
typedef char host_map_texts_fit[(SEND_TEXT >= DICT_END_W && SEND_TEXT + 256 <= OUT_TEXT && OUT_TEXT + 64 == OUT_W) ? 1 : -1];
/* How many slots, from slot 0, a branch may sit in on a node this size: those
* whose address field reaches every word of it. */
@@ -194,27 +207,33 @@ static int host_load(v4_text *tx, v4_node *n, const char *const *files, unsigned
v4_text_constant(tx, "(PRINT-PORT)", PRINT_PORT);
v4_text_constant(tx, "(DONE-PORT)", DONE_PORT);
v4_text_constant(tx, "(ROUTES)", ROUTES);
v4_text_constant(tx, "(WRITERS)", WRITERS);
v4_text_constant(tx, "(READERS)", READERS);
v4_text_constant(tx, "-PORTS", -(v4_cell)V4_PORTS);
v4_text_constant(tx, "(NEAR)", NEAR);
v4_text_constant(tx, "(GATE-PORT)", GATE_PORT);
v4_text_constant(tx, "(AWAIT-FROM)", AWAIT_FROM);
v4_text_constant(tx, "(MQ)", MQ_W);
v4_text_constant(tx, "(MQ-END)", MQ_W + MQ_CELLS);
v4_text_constant(tx, "-MQ-ORDINARY", -(v4_cell)(MQ_CELLS - 7 - 36)); /* the same for a message that is not a refusal or a GONE: 36 cells are kept for those */
v4_text_constant(tx, "(WIRE)", WIRE);
v4_text_constant(tx, "(WIRE-A)", WIRE_A);
v4_text_constant(tx, "(WIRE-B)", WIRE_B);
v4_text_constant(tx, "(WIRE-DO)", WIRE_DO);
v4_text_constant(tx, "(WIRE-HOW)", WIRE_HOW);
v4_text_constant(tx, "(WIRE-HAVE)", WIRE_HAVE);
v4_text_constant(tx, "(S-HAVE)", S_HAVE);
v4_text_constant(tx, "(S-MASK)", S_MASK);
v4_text_constant(tx, "(S-WIRE)", S_WIRE);
v4_text_constant(tx, "(S-ON)", S_ON);
v4_text_constant(tx, "(KEEP)", KEEP);
v4_text_constant(tx, "(DEFER)", DEFER);
v4_text_constant(tx, "(IN)", IN_HDR);
v4_text_constant(tx, "(ONE)", ONE);
v4_text_constant(tx, "(OUT-HDR)", OUT_HDR);
v4_text_constant(tx, "(W-NEED)", W_NEED);
v4_text_constant(tx, "(W-PORT)", W_PORT);
v4_text_constant(tx, "(P-WAY)", P_WAY);
v4_text_constant(tx, "(A-SELF)", A_SELF);
v4_text_constant(tx, "(SEND^)", SEND_PTR);
v4_text_constant(tx, "(OUT-TEXT)", OUT_TEXT);
v4_text_constant(tx, "(SEND-TEXT)", SEND_TEXT);
v4_text_constant(tx, "(QUIET)", QUIET);
v4_text_constant(tx, "(A-WORD)", A_WORD);
v4_text_constant(tx, "(A-LEFT)", A_LEFT);
v4_text_constant(tx, "(A-FOUND)", A_FOUND);
v4_text_constant(tx, "(REFUSED)", REFUSED);
v4_text_constant(tx, "(OWED#)", OWED_COUNT);
v4_text_constant(tx, "(OWED)", OWED);
v4_text_constant(tx, "-MQ-ROOM", -(v4_cell)(MQ_CELLS - 7)); /* cells taken + a text's words + this is below zero while the message fits */
v4_text_constant(tx, "(MQ-HEAD)", MQ_HEAD);
v4_text_constant(tx, "(MQ-TAIL)", MQ_TAIL);
v4_text_constant(tx, "(MQ#)", MQ_COUNT);
v4_text_constant(tx, "(MQ-HDR)", MQ_HDR);
v4_text_constant(tx, "(OUT^)", OUT_PTR);
v4_text_constant(tx, "(REPLY)", REPLY);
v4_text_constant(tx, "(MSG)", MSG);
v4/tests/test_host_depth.c
+341
View File
@@ -0,0 +1,341 @@
/* test_host_depth.c -- every message path of a node on a mesh, at every
* depth of both stacks. docs/v4.0.0/MESH.md 7d.7, acceptance 7; 7c.6.
*
* console --1 [10] 2--2 [11] 3--2 [12]
*
* A node's message code runs on the stacks its text is using. The first
* attempt at step 6d was tested on a shallow stack with every node there,
* and hung on a deep one. Here node 11 does each thing a node does with a
* message -- print, SEND, SEND with no way, AWAIT answered, AWAIT ended by a
* GONE, pass a message on while its own text waits for room -- with its data
* stack holding 20 to 32 values, and from 20 to 32 calls deep. After each,
* every node must answer, and node 11's stack must be as deep as the text
* made it, or its text must have ended in an error it reported. It may
* refuse; it may not hang, and it may not swallow a line.
*/
#include "v4/image.h"
#include "v4/fabric.h"
#include "v4/message.h"
#include "v4/text.h"
#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#include "host_map.h"
static int failures = 0, checks = 0;
#define CHECK(c,...) do{checks++; if(!(c)){failures++; printf("FAIL %s:%d: ",__FILE__,__LINE__); printf(__VA_ARGS__); printf("\n");}}while(0)
static v4_text tx;
static v4_node nucleus; /* one node with the nucleus in it: what every node here starts as */
static v4_cell w_idle, w_fault;
static v4_fabric_node pool[3];
static v4_place places[3];
static v4_fabric f;
#define QUEUES 12u /* two for each wire there may be: the console's, 10-11, 11-12, 10-12, and two wires to spare */
static v4_wire_queue queues[QUEUES];
/* ---- the console: a device on a port ---- */
#define CONSOLE_ID 1
static const v4_device console = { 0, 0, 0, 0 }; /* it takes and gives no words: only whole messages */
static unsigned hera, mid, far; /* where the three nodes are: 10, 11, 12 */
static char printed[32768]; /* what has come back since the console last sent */
static unsigned printed_len;
static v4_cell printed_from; /* which node the last of it came from */
static int ended; /* how many messages of how text ended have come, */
static v4_cell ended_from, ended_how; /* and the last of them */
static unsigned ended_at; /* and how much had been printed when it came */
static int nacks; /* how many NACKs have come to the console, */
static v4_cell nack_from, nack_about; /* and the last of them: who refused, and the node the refused message was for */
/* Everything the node at the console has put on the console's wire is taken, in order. How many messages. */
static unsigned console_takes(void)
{
static v4_cell hd[V4_WIRE_HEADER], text[V4_MSG_MAX_CHARS / 4u];
unsigned took = 0, i;
while (v4_fabric_device_take(&f, hera, 1, hd, text, V4_MSG_MAX_CHARS / 4u) == V4_WIRE_DONE) {
took++;
if (hd[2] == V4_MSG_OUTPUT) {
for (i = 0; i < (unsigned)hd[6] && printed_len + 1 < sizeof printed; i++) printed[printed_len++] = (char)(((v4_ucell)text[i / 4u] >> (8u * (i % 4u))) & 0xFFu);
printed[printed_len] = 0;
printed_from = hd[1];
} else if (hd[2] == V4_MSG_DONE) {
ended++; ended_from = hd[1]; ended_how = text[0]; ended_at = printed_len;
} else if (hd[2] == V4_MSG_NACK) {
nacks++; nack_from = hd[1]; nack_about = text[0];
}
}
return took;
}
static int is_empty(const char *s) { return s[0] == 0; }
/* 1 if the node is asleep (operation 8): it executes nothing until a message comes. */
static int asleep(unsigned id)
{
const v4_fabric_node *x = v4_fabric_node_at(&f, id);
return x && x->n.doing && x->n.do_op == 8;
}
static unsigned step_cap = 20000000; /* how long a line may take before it is given up on */
static unsigned stuck; /* bit k: the node at place k is known to be going round for ever, and is not waited for */
static void (*watch)(void); /* called after every step, if set */
static unsigned long steps_run;
static void show_stuck(const char *text)
{
unsigned k, q;
if (!getenv("V4_MESH_STUCK")) return;
for (k = 0; k < 3; k++) if (v4_fabric_node_at(&f, k)) { const v4_node *n = &pool[k].n;
printf(" stuck after \"%.40s\": node %ld p=%ld doing=%d op=%ld how=%ld wire=%u asking=%d d=%u r=%u await=%ld keep=%ld lost=%ld refused=%ld fault=%u@%ld err=%ld\n", text, (long)n->mem[ME], (long)n->p, n->doing, (long)n->do_op, (long)n->how, n->wire,
n->asking, (unsigned)n->ds.depth, (unsigned)n->rs.depth, (long)n->mem[AWAIT_FROM], (long)n->mem[KEEP], (long)n->mem[LOST], (long)n->mem[REFUSED], n->fault_kind, (long)n->fault_addr, (long)n->mem[NODE_ERROR]);
for (q = 0; q < V4_PORTS; q++) if (places[k].wire[q].rx) printf(" port %u: %u cells coming, %u going\n", q, places[k].wire[q].rx->used, places[k].wire[q].tx->used); }
}
/* Let everything that follows from what has been put happen: until nothing can, or -- with a node known to be
* stuck -- until every other node has been asleep, and the console has been sent nothing, for a while. */
static int run(void)
{
unsigned steps = 0, quiet = 0, k;
while (steps < step_cap) {
unsigned did = v4_fabric_step(&f), took = console_takes(), awake = 0, running = 0;
steps++; steps_run++;
if (watch) watch();
/* a step in which a node only faulted counts nothing done (exec.h): it goes on from its handler at the next */
for (k = 0; k < 3; k++) if (v4_fabric_node_at(&f, k) && !pool[k].n.doing && !pool[k].n.asking && !pool[k].n.stopped && !(pool[k].n.reading && !pool[k].n.given)) running = 1;
if (did == 0 && took == 0 && !running) return 1;
for (k = 0; k < 3; k++) if (v4_fabric_node_at(&f, k) && !(stuck & 1u << k) && !(pool[k].n.doing && (pool[k].n.do_op == 8 || pool[k].n.do_op == 9))) awake = 1;
quiet = (stuck && !awake && took == 0) ? quiet + 1 : 0;
if (quiet >= 400000) return 1;
}
return 0;
}
/* The console sends text to a node: the message is put on the wire to the node the console is on. */
static int put_text(v4_cell node, const char *text)
{
static v4_message m;
if (!v4_message_text(&m, node, CONSOLE_ID, V4_MSG_TEXT, text, (unsigned)strlen(text))) return 0;
return v4_fabric_device_put(&f, hera, 1, m.word, m.word + V4_MSG_HEADER) == V4_WIRE_DONE;
}
static void forget(void)
{
printed_len = 0; printed[0] = 0; printed_from = -1;
ended = 0; ended_from = -1; ended_how = -1; ended_at = 0;
}
/* Send text to a node and let everything that follows from it happen. */
static const char *tell(v4_cell node, const char *text)
{
forget();
if (!put_text(node, text)) return "(not put)";
if (!run()) { show_stuck(text); return "(still running)"; }
return printed;
}
/* A StarForth node in the fabric: born, then given the nucleus and the
* registers the nucleus expects, waiting for a message. */
static unsigned starforth_node(unsigned k)
{
int id = v4_fabric_add(&f, &pool[k], PORT);
v4_node *n = &pool[k].n;
memcpy(n->mem, nucleus.mem, sizeof n->mem);
v4_node_stack_regs_attach(n, DSTACK_REG, RSTACK_REG);
v4_node_error_attach(n, NODE_ERROR);
v4_node_fault_attach(n, w_fault);
n->p = w_idle;
return (unsigned)id;
}
/* Three nodes that know nothing, in a row, the console on the first. */
static int fresh(void)
{
unsigned i;
int ok;
v4_fabric_init(&f, places, 3);
v4_fabric_queues(&f, queues, QUEUES);
v4_fabric_gone_error(&f, V4_ERROR_NO_ONE);
hera = starforth_node(0);
mid = starforth_node(1);
far = starforth_node(2);
ok = v4_fabric_wire_device(&f, hera, 1, &console) && v4_fabric_wire(&f, hera, 2, mid, 2) && v4_fabric_wire(&f, mid, 3, far, 2);
stuck = 0; watch = 0; nacks = 0; step_cap = 20000000;
forget();
for (i = 0; i < 200; i++) (void)v4_fabric_step(&f);
return ok && asleep(hera) && asleep(mid) && asleep(far);
}
static int told(v4_cell node, const char *text) { return is_empty(tell(node, text)) && ended == 1 && ended_how == V4_TEXT_COMPLETED; }
/* The same, told who they are, the way to each other, and who is on each port:
* console --1 [10] 2--2 [11] 3--2 [12] */
static int row(void)
{
return fresh()
&& told(0, "10 (ME) ! 1 (CONSOLE) ! 1 1 ROUTE 0 2 ROUTE")
&& told(0, "11 (ME) ! 1 (CONSOLE) ! 2 DEFAULT-ROUTE 0 3 ROUTE")
&& told(0, "12 (ME) ! 1 (CONSOLE) ! 2 DEFAULT-ROUTE")
&& told(10, "0 NO-ROUTE 11 2 ROUTE 12 2 ROUTE 11 2 NEIGHBOUR") && told(11, "0 NO-ROUTE 12 3 ROUTE 10 2 NEIGHBOUR 12 3 NEIGHBOUR") && told(12, "11 2 NEIGHBOUR");
}
/* ---- the sweep ---- */
static unsigned runs, bad;
/* what the last path watches for: node 11 asleep for room, and, while it is, a message it has passed on to
* the wire to node 12 */
static unsigned saw_room_wait, saw_passed;
static void watch_mid(void)
{
if (pool[mid].n.doing && pool[mid].n.do_op == 9) { saw_room_wait++; if (places[mid].wire[3].tx && places[mid].wire[3].tx->used > 0) saw_passed++; }
}
/* words that push 1, 2, 4, 8 and 16 values and call nothing while they do */
static void fill(char *text, size_t cap, unsigned count)
{
size_t at = 0;
unsigned bit;
text[0] = 0;
for (; count >= 16; count -= 16) at += (size_t)snprintf(text + at, cap - at, "P16 ");
for (bit = 8; bit; bit >>= 1) if (count >= bit) { at += (size_t)snprintf(text + at, cap - at, "P%u ", bit); count -= bit; }
}
/* A row made afresh for one path; node 11 is given the word ACT that takes it, and the words that fill the
* stack and that call each other. */
static int made(unsigned path)
{
static const char *const act[] = {
": ACT 600 0 DO 65 EMIT LOOP ;",
": ACT S\" 1 DROP\" 12 SEND ;",
": ACT S\" 1 DROP\" 99 SEND ;",
": ACT S\" 1 DROP\" 12 SEND 12 AWAIT DROP ;",
": ACT 12 AWAIT DROP ;",
": ACT 1200 0 DO I . LOOP ;",
};
char line[64];
unsigned k;
if (!row() || !told(11, act[path]) || !told(11, ": P1 7 ; : P2 7 7 ; : P4 7 7 7 7 ; : P8 7 7 7 7 7 7 7 7 ;") || !told(11, ": P16 P8 P8 ;")) return 0;
if (!told(11, ": N1 ACT ;")) return 0;
for (k = 2; k <= V4_RET_DEPTH + 1u; k++) {
snprintf(line, sizeof line, ": N%u N%u ;", k, k - 1u);
if (!told(11, line)) return 0;
}
if (path == 2 && !told(11, "NO-ROUTES 1 2 ROUTE 10 2 ROUTE 12 3 ROUTE")) return 0; /* no way for any node it has not been told of */
if (path == 4 && !told(12, ": LL 400000 0 DO LOOP ;")) return 0;
if (path == 5 && !told(10, ": SLOW 500000 0 DO LOOP ; : BUSY SLOW S\" 1 DROP\" 12 SEND SLOW ;")) return 0;
return 1;
}
/* Node 11 takes the path with `text`; `values` is how many values the text leaves on its stack if it completes. */
static int one(unsigned path, const char *what, unsigned depth, const char *text, unsigned values)
{
static const char *const name[] = { "a text that prints", "SEND", "SEND with no way", "AWAIT answered", "AWAIT ended by a GONE", "passing on while its text waits for room" };
const char *why = 0;
int how11;
unsigned left;
runs++;
forget();
step_cap = 60000000;
if (path == 4) { /* node 12 is busy for a long while and sends no answer; node 11 waits; its centre says 12 is gone */
stuck = 1u << far;
if (!put_text(12, "LL") || !put_text(11, text) || !run()) why = "it did not come to wait";
else if (!put_text(10, "12 11 GONE") || !run()) why = "the GONE was not done";
stuck = 0;
if (!why && !run()) why = "the nodes did not come to rest";
} else if (path == 5) { /* node 10, by which node 11 prints, is busy, and sends node 12 a message by node 11 meanwhile */
saw_room_wait = 0; saw_passed = 0; watch = watch_mid;
if (!put_text(11, text) || !put_text(10, "BUSY") || !run()) why = "the nodes did not come to rest";
watch = 0;
} else {
if (!put_text(11, text) || !run()) why = "the nodes did not come to rest";
}
how11 = (int)pool[mid].n.mem[LINE_STATUS];
left = (unsigned)pool[mid].n.ds.depth;
if (!why && !(asleep(hera) && asleep(mid) && asleep(far))) why = "a node is not asleep";
if (!why && ended < 1) why = "node 11's text was not answered";
if (!why && how11 == V4_TEXT_COMPLETED && left != values) why = "its stack is not as deep as the text made it";
if (!why && how11 == V4_TEXT_ERROR && !(strstr(printed, "overflow") || strstr(printed, "Argument out of range") || strstr(printed, "Node gone") || strstr(printed, "Message refused")))
why = "its text ended in an error it did not report";
if (!why && how11 != V4_TEXT_COMPLETED && how11 != V4_TEXT_ERROR) why = "its text ended neither way";
if (!why && path == 0 && how11 == V4_TEXT_COMPLETED && printed_len != 600) why = "not all it printed arrived";
if (!why && path == 5 && how11 == V4_TEXT_COMPLETED && !strstr(printed, " 1199 ")) why = "not all it printed arrived";
if (!why && path == 5 && how11 == V4_TEXT_COMPLETED && !(saw_room_wait > 0 && saw_passed > 0)) why = "it did not wait for room, or passed nothing on while it did";
/* every node comes back */
if (!why && !(strcmp(tell(11, "ABORT"), "") == 0 && ended == 1 && pool[mid].n.ds.depth == 0)) why = "node 11 did not answer ABORT";
if (!why && path == 4 && !told(11, "12 3 ROUTE")) why = "node 11 did not take the way to 12 again";
if (!why && strcmp(tell(11, "1 2 + ."), "3 ") != 0) why = "node 11 did not answer";
if (!why && strcmp(tell(10, "1 2 + ."), "3 ") != 0) why = "node 10 did not answer";
if (!why && strcmp(tell(12, "1 2 + ."), "3 ") != 0) why = "node 12 did not answer";
if (!why && !(asleep(hera) && asleep(mid) && asleep(far))) why = "a node is not asleep afterwards";
checks++;
if (why) {
failures++; bad++;
printf("FAIL %s, %s %u: %s: \"%.60s\"\n", name[path], what, depth, why, printed);
show_stuck(text);
(void)made(path); /* the next begins on a row that is whole */
}
return how11;
}
int main(void)
{
unsigned path, k;
char text[160];
printf("v4 mesh depth tests: V4_CELL_BITS=%d, V4_NODE_WORDS=%u\n", V4_CELL_BITS, (unsigned)V4_NODE_WORDS);
{
static const char *const files[] = { "core.v4", "input.v4", "dict.v4", "codegen.v4", "compile.v4", "quit.v4", "forth.v4",
"numout.v4", "words.v4", "system.v4", "qmath.v4", "blocks.v4", "log.v4", "acl.v4" };
CHECK(host_load(&tx, &nucleus, files, 14), "the nucleus assembles");
}
CHECK(v4_text_finish(&tx), "everything is defined: %s", v4_text_error(&tx));
if (failures) { printf(" %d checks, %d failures\n", checks, failures); return 1; }
w_idle = v4_text_word(&tx, "(IDLE)");
w_fault = v4_text_word(&tx, "(FAULTS)");
nucleus.mem[DP] = DICT_W * 4; /* the variables, as at switch-on (tools/mkimage.c) */
nucleus.mem[LATEST] = v4_text_latest(&tx);
nucleus.mem[CFP] = CFS_W;
nucleus.mem[BASE] = 10;
nucleus.mem[FENCE] = DICT_W;
nucleus.mem[BOOT_CELLS] = nucleus.mem[DP];
nucleus.mem[BOOT_CELLS + 1] = nucleus.mem[LATEST];
nucleus.mem[LOG_LEVEL] = 2;
nucleus.mem[CONTEXT] = LATEST;
nucleus.mem[CURRENT] = LATEST;
nucleus.mem[SRC] = TIB;
nucleus.mem[LINE_STATUS] = 1;
HOST_MESSAGES_EMPTY(&nucleus);
for (path = 0; path < 6; path++) {
unsigned before = bad, done = 0, errors = 0;
CHECK(made(path), "a row for path %u", path);
if (failures > (int)bad) break;
/* the data stack at every depth from 20 to full */
for (k = V4_DATA_DEPTH - 12u; k <= V4_DATA_DEPTH; k++) {
size_t at;
fill(text, sizeof text, k);
at = strlen(text);
snprintf(text + at, sizeof text - at, "ACT");
if (one(path, "values on the stack", k, text, k) == V4_TEXT_COMPLETED) done++; else errors++;
}
/* and from every depth of calls from 20 to past the end of the return stack */
for (k = V4_RET_DEPTH - 12u; k <= V4_RET_DEPTH + 1u; k++) {
snprintf(text, sizeof text, "N%u", k);
(void)one(path, "calls deep", k, text, 0);
}
printf(" path %u: with %u to %u values on the stack, %u completed and %u ended in an error reported; %u failures\n", path, (unsigned)(V4_DATA_DEPTH - 12u), (unsigned)V4_DATA_DEPTH, done, errors, bad - before);
}
/* ---- between texts: node 11 passes on, and refuses, with as many values waiting on its stack as a text
* may leave (MESH.md 7d.4: the rule of 28). Not one fault. ---- */
CHECK(row() && told(11, ": P1 7 ; : P2 7 7 ; : P4 7 7 7 7 ; : P8 7 7 7 7 7 7 7 7 ;") && told(11, ": P16 P8 P8 ;") && told(11, "77 5 ROUTE")
&& told(12, ": S77 S\" 1 DROP\" 77 SEND ;"), "a row; node 11's way to 77 is a port with no one on it");
for (k = V4_DATA_DEPTH - 12u; k + 4u <= V4_DATA_DEPTH; k++) {
unsigned faults;
v4_cell lost = pool[mid].n.mem[LOST], refused = pool[far].n.mem[REFUSED];
fill(text, sizeof text, k);
CHECK(told(11, text) && pool[mid].n.ds.depth == k, "node 11's text leaves %u values on its stack", k);
faults = pool[mid].n.faults;
CHECK(strcmp(tell(12, "1 2 + ."), "3 ") == 0 && ended == 1, "with %u values waiting it passes text on to node 12, and what comes back", k);
CHECK(told(12, "S77") && pool[mid].n.mem[LOST] == lost + 1 && pool[far].n.mem[REFUSED] == refused + 1, "and refuses a message it has no way for, and tells node 12");
CHECK(pool[mid].n.faults == faults && pool[mid].n.ds.depth == k && asleep(mid), "without a fault, its stack as it was: %u values", (unsigned)pool[mid].n.ds.depth);
CHECK(strcmp(tell(11, "ABORT"), "") == 0 && strcmp(tell(11, "1 2 + ."), "3 ") == 0, "and it goes on");
}
printf(" %u runs; %u in which a node did not come back\n", runs, bad);
printf(" %d checks, %d failures\n", checks, failures);
return failures != 0;
}
v4/tests/test_host_mesh.c
+432 -225
View File
@@ -7,8 +7,12 @@
* Each node is the nucleus (v4/capsule/ *.v4) and nothing else. They start
* alike, numbered 0 and knowing no way anywhere; everything they come to
* know they are told by text sent from the console, as whoever wires a node
* tells it. The console is a device on a port and speaks messages
* (v4/include/v4/message.h).
* tells it. The console is a device on a port and speaks whole messages
* (v4/include/v4/message.h): it puts them on the wire to its node and
* takes them off the wire from it, through the fabric (MESH.md 7d.2).
*
* Each scene after the first is played on a row made afresh, row(), so
* that none depends on what an earlier one left.
*/
#include "v4/image.h"
#include "v4/fabric.h"
@@ -29,72 +33,120 @@ static v4_cell w_idle, w_fault;
static v4_fabric_node pool[3];
static v4_place places[3];
static v4_fabric f;
#define QUEUES 12u /* two for each wire there may be: the console's, 10-11, 11-12, 10-12, and two wires to spare */
static v4_wire_queue queues[QUEUES];
/* ---- the console: a device on a port ---- */
#define CONSOLE_ID 1
static v4_message going, coming;
static unsigned going_at;
static char printed[8192]; /* what has come back since the console last sent */
static const v4_device console = { 0, 0, 0, 0 }; /* it takes and gives no words: only whole messages */
static unsigned hera, mid, far; /* where the three nodes are: 10, 11, 12 */
static char printed[32768]; /* what has come back since the console last sent */
static unsigned printed_len;
static v4_cell printed_from; /* which node the last of it came from */
static int ended; /* how many messages of how text ended have come, */
static v4_cell ended_from, ended_how; /* and the last of them */
static unsigned ended_at; /* and how much had been printed when it came */
static int nacks; /* how many NACKs have come to the console, */
static v4_cell nack_from, nack_about; /* and the last of them: who refused, and the node the refused message was for */
static int console_give(void *self, v4_cell *value)
/* Everything the node at the console has put on the console's wire is taken, in order. How many messages. */
static unsigned console_takes(void)
{
(void)self;
if (going_at >= going.count) return 0;
*value = going.word[going_at++];
return 1;
}
static int console_take(void *self, v4_cell value)
{
(void)self;
if (v4_message_word(&coming, value)) {
if (v4_message_type(&coming) == V4_MSG_OUTPUT) {
unsigned i, chars = v4_message_length(&coming);
for (i = 0; i < chars && printed_len + 1 < sizeof printed; i++) printed[printed_len++] = v4_message_char(&coming, i);
static v4_cell hd[V4_WIRE_HEADER], text[V4_MSG_MAX_CHARS / 4u];
unsigned took = 0, i;
while (v4_fabric_device_take(&f, hera, 1, hd, text, V4_MSG_MAX_CHARS / 4u) == V4_WIRE_DONE) {
took++;
if (hd[2] == V4_MSG_OUTPUT) {
for (i = 0; i < (unsigned)hd[6] && printed_len + 1 < sizeof printed; i++) printed[printed_len++] = (char)(((v4_ucell)text[i / 4u] >> (8u * (i % 4u))) & 0xFFu);
printed[printed_len] = 0;
printed_from = v4_message_from(&coming);
} else if (v4_message_type(&coming) == V4_MSG_DONE) {
ended++;
ended_from = v4_message_from(&coming);
ended_how = coming.word[V4_MSG_HEADER];
} else if (v4_message_type(&coming) == V4_MSG_NACK) {
nacks++;
nack_from = v4_message_from(&coming);
nack_about = coming.word[V4_MSG_HEADER];
printed_from = hd[1];
} else if (hd[2] == V4_MSG_DONE) {
ended++; ended_from = hd[1]; ended_how = text[0]; ended_at = printed_len;
} else if (hd[2] == V4_MSG_NACK) {
nacks++; nack_from = hd[1]; nack_about = text[0];
}
coming.count = 0;
}
return 1;
return took;
}
static int console_pending(void *self) { (void)self; return going_at < going.count; }
static const v4_device console = { console_take, console_give, 0, console_pending };
static int is_empty(const char *s) { return s[0] == 0; }
/* 1 if the node is asleep (operation 8): it executes nothing until a message comes. */
static int asleep(unsigned id)
{
const v4_fabric_node *x = v4_fabric_node_at(&f, id);
return x && x->n.doing && x->n.do_op == 8;
}
/* 1 if it is asleep waiting for room on a wire (operation 9). */
static int waits_for_room(unsigned id)
{
const v4_fabric_node *x = v4_fabric_node_at(&f, id);
return x && x->n.doing && x->n.do_op == 9;
}
/* the queue of messages going from a node's port, and coming to it */
static const v4_wire_queue *going_from(unsigned id, unsigned port) { return places[id].wire[port].tx; }
static const v4_wire_queue *coming_to(unsigned id, unsigned port) { return places[id].wire[port].rx; }
static unsigned step_cap = 20000000; /* how long a line may take before it is given up on */
static unsigned stuck; /* bit k: the node at place k is known to be going round for ever, and is not waited for */
static void (*watch)(void); /* called after every step, if set */
static unsigned long steps_run;
static unsigned between_data, between_ret; /* the most of each stack any node has used while doing nothing that is a text's (QUIET), */
static int was_quiet[3], clean[3]; /* after a text that left nothing on the data stack */
static void show_stuck(const char *text)
{
unsigned k, q;
if (!getenv("V4_MESH_STUCK")) return;
for (k = 0; k < 3; k++) if (v4_fabric_node_at(&f, k)) { const v4_node *n = &pool[k].n;
printf(" stuck after \"%.40s\": node %ld p=%ld doing=%d op=%ld how=%ld wire=%u asking=%d d=%u r=%u await=%ld keep=%ld lost=%ld refused=%ld fault=%u@%ld err=%ld\n", text, (long)n->mem[ME], (long)n->p, n->doing, (long)n->do_op, (long)n->how, n->wire,
n->asking, (unsigned)n->ds.depth, (unsigned)n->rs.depth, (long)n->mem[AWAIT_FROM], (long)n->mem[KEEP], (long)n->mem[LOST], (long)n->mem[REFUSED], n->fault_kind, (long)n->fault_addr, (long)n->mem[NODE_ERROR]);
for (q = 0; q < V4_PORTS; q++) if (places[k].wire[q].rx) printf(" port %u: %u cells coming, %u going\n", q, places[k].wire[q].rx->used, places[k].wire[q].tx->used); }
}
/* Let everything that follows from what has been put happen: until nothing can, or -- with a node known to be
* stuck -- until every other node has been asleep, and the console has been sent nothing, for a while. */
static int run(void)
{
unsigned steps = 0, quiet = 0, k;
while (steps < step_cap) {
unsigned did = v4_fabric_step(&f), took = console_takes(), awake = 0, running = 0;
steps++; steps_run++;
if (watch) watch();
for (k = 0; k < 3; k++) if (v4_fabric_node_at(&f, k)) {
int quiet_now = pool[k].n.mem[QUIET] == 1;
if (quiet_now && !was_quiet[k]) clean[k] = pool[k].n.ds.depth <= 1; /* its text has ended: did it leave anything? (how it ended may still be there) */
was_quiet[k] = quiet_now;
if (!quiet_now || !clean[k]) continue;
if (pool[k].n.ds.depth > between_data) between_data = (unsigned)pool[k].n.ds.depth;
if (pool[k].n.rs.depth > between_ret) between_ret = (unsigned)pool[k].n.rs.depth;
}
/* a step in which a node only faulted counts nothing done (exec.h): it goes on from its handler at the next */
for (k = 0; k < 3; k++) if (v4_fabric_node_at(&f, k) && !pool[k].n.doing && !pool[k].n.asking && !pool[k].n.stopped && !(pool[k].n.reading && !pool[k].n.given)) running = 1;
if (did == 0 && took == 0 && !running) return 1;
for (k = 0; k < 3; k++) if (v4_fabric_node_at(&f, k) && !(stuck & 1u << k) && !(pool[k].n.doing && (pool[k].n.do_op == 8 || pool[k].n.do_op == 9))) awake = 1;
quiet = (stuck && !awake && took == 0) ? quiet + 1 : 0;
if (quiet >= 400000) return 1;
}
return 0;
}
/* The console sends text to a node: the message is put on the wire to the node the console is on. */
static int put_text(v4_cell node, const char *text)
{
static v4_message m;
if (!v4_message_text(&m, node, CONSOLE_ID, V4_MSG_TEXT, text, (unsigned)strlen(text))) return 0;
return v4_fabric_device_put(&f, hera, 1, m.word, m.word + V4_MSG_HEADER) == V4_WIRE_DONE;
}
static void forget(void)
{
printed_len = 0; printed[0] = 0; printed_from = -1;
ended = 0; ended_from = -1; ended_how = -1; ended_at = 0;
}
/* Send text to a node and let everything that follows from it happen. */
static const char *tell(v4_cell node, const char *text)
{
unsigned steps = 0;
printed_len = 0; printed[0] = 0; printed_from = -1;
ended = 0; ended_from = -1; ended_how = -1;
if (!v4_message_text(&going, node, CONSOLE_ID, V4_MSG_TEXT, text, (unsigned)strlen(text))) return "(too long)";
going_at = 0;
while (steps < step_cap && v4_fabric_step(&f) != 0) steps++;
if (steps >= step_cap) {
if (getenv("V4_MESH_STUCK")) {
unsigned k;
for (k = 0; k < 3; k++) if (v4_fabric_node_at(&f, k)) { const v4_node *n = &pool[k].n;
printf(" stuck after \"%s\": node %ld p=%ld asking=%d port=%u reading=%d rport=%u mq=%ld owed=%ld lost=%ld fault=%u@%ld\n", text, (long)n->mem[ME], (long)n->p, n->asking, n->ask_port, n->reading, n->read_port,
(long)n->mem[MQ_COUNT], (long)n->mem[OWED_COUNT], (long)n->mem[LOST], n->fault_kind, (long)n->fault_addr); }
}
return "(still running)";
}
forget();
if (!put_text(node, text)) return "(not put)";
if (!run()) { show_stuck(text); return "(still running)"; }
return printed;
}
@@ -112,15 +164,54 @@ static unsigned starforth_node(unsigned k)
return (unsigned)id;
}
static int waiting(unsigned id)
/* Three nodes that know nothing, in a row, the console on the first. */
static int fresh(void)
{
const v4_node *n = &v4_fabric_node_at(&f, id)->n;
return n->reading && !n->given && n->read_port == V4_PORT_ANY;
unsigned i;
int ok;
v4_fabric_init(&f, places, 3);
v4_fabric_queues(&f, queues, QUEUES);
v4_fabric_gone_error(&f, V4_ERROR_NO_ONE);
hera = starforth_node(0);
mid = starforth_node(1);
far = starforth_node(2);
ok = v4_fabric_wire_device(&f, hera, 1, &console) && v4_fabric_wire(&f, hera, 2, mid, 2) && v4_fabric_wire(&f, mid, 3, far, 2);
stuck = 0; watch = 0; nacks = 0; step_cap = 20000000;
was_quiet[0] = was_quiet[1] = was_quiet[2] = 0; clean[0] = clean[1] = clean[2] = 0;
forget();
for (i = 0; i < 200; i++) (void)v4_fabric_step(&f);
return ok && asleep(hera) && asleep(mid) && asleep(far);
}
static int told(v4_cell node, const char *text) { return is_empty(tell(node, text)) && ended == 1 && ended_how == V4_TEXT_COMPLETED; }
/* The same, told who they are, the way to each other, and who is on each port:
* console --1 [10] 2--2 [11] 3--2 [12] */
static int row(void)
{
return fresh()
&& told(0, "10 (ME) ! 1 (CONSOLE) ! 1 1 ROUTE 0 2 ROUTE")
&& told(0, "11 (ME) ! 1 (CONSOLE) ! 2 DEFAULT-ROUTE 0 3 ROUTE")
&& told(0, "12 (ME) ! 1 (CONSOLE) ! 2 DEFAULT-ROUTE")
&& told(10, "0 NO-ROUTE 11 2 ROUTE 12 2 ROUTE 11 2 NEIGHBOUR") && told(11, "0 NO-ROUTE 12 3 ROUTE 10 2 NEIGHBOUR 12 3 NEIGHBOUR") && told(12, "11 2 NEIGHBOUR");
}
/* And with the far node wired straight to the one at the console as well, port 3 to port 3; node 10 reaches
* 12 by that wire, and 12 reaches everything by it but 11. */
static int triangle(void)
{
return row() && v4_fabric_wire(&f, hera, 3, far, 3)
&& told(10, "12 NO-ROUTE 12 3 ROUTE 12 3 NEIGHBOUR") && told(12, "NO-ROUTES 3 DEFAULT-ROUTE 11 2 ROUTE 10 3 NEIGHBOUR");
}
static v4_uheat_t clock_of(unsigned id) { return pool[id].es.anticlock; }
/* what a scene watches for while it runs */
static unsigned saw_room_wait, saw_full;
static void watch_far_waits(void)
{
if (waits_for_room(far)) { saw_room_wait++; if (going_from(far, 3) && going_from(far, 3)->used == V4_WIRE_CELLS - 8u) saw_full++; }
}
int main(void)
{
unsigned hera, mid, far, i;
unsigned i;
printf("v4 mesh tests: V4_CELL_BITS=%d, V4_NODE_WORDS=%u\n", V4_CELL_BITS, (unsigned)V4_NODE_WORDS);
{
@@ -146,15 +237,7 @@ int main(void)
nucleus.mem[LINE_STATUS] = 1;
HOST_MESSAGES_EMPTY(&nucleus);
v4_fabric_init(&f, places, 3);
hera = starforth_node(0);
mid = starforth_node(1);
far = starforth_node(2);
CHECK(v4_fabric_wire_device(&f, hera, 1, &console), "the console is wired to one node's port 1");
CHECK(v4_fabric_wire(&f, hera, 2, mid, 2) && v4_fabric_wire(&f, mid, 3, far, 2), "and the three nodes in a row");
going.count = 0; going_at = 0;
for (i = 0; i < 20; i++) (void)v4_fabric_step(&f);
CHECK(waiting(hera) && waiting(mid) && waiting(far), "all three wait at their ports");
CHECK(fresh(), "the console is wired to one node's port 1, the three nodes are in a row, and all three sleep");
/* ---- they are told who they are and the way to each other, by text ---- */
CHECK(is_empty(tell(0, "10 (ME) ! 1 (CONSOLE) ! 1 1 ROUTE 0 2 ROUTE")) && ended == 1 && ended_how == V4_TEXT_COMPLETED && ended_from == 10,
@@ -176,7 +259,7 @@ int main(void)
"each node has its own dictionary: a word defined on one is not on another");
{
const char *all = tell(12, "WORDS");
CHECK(strlen(all) > 1000 && printed_from == 12 && ended == 1, "more than a message holds comes back in several: %u characters", (unsigned)strlen(all));
CHECK(strlen(all) > 1000 && printed_from == 12 && ended == 1 && ended_at == printed_len, "more than a message holds comes back in several, and then how it ended: %u characters", (unsigned)strlen(all));
}
{
static char line[1100];
@@ -192,6 +275,9 @@ int main(void)
"text one node SENDs another is done there, and what that prints goes to its console: \"%s\" from %ld", printed, (long)printed_from);
CHECK(strstr(tell(10, ": NOWAY S\" 1\" 99 SEND ; NOWAY"), "Argument out of range") != NULL && ended_how == V4_TEXT_ERROR,
"SEND to a node there is no way to is an error");
CHECK(strstr(tell(10, ": LONG PAD 1025 12 SEND ; LONG"), "Argument out of range") != NULL && strstr(tell(10, ": SHORT PAD -1 12 SEND ; SHORT"), "Argument out of range") != NULL
&& strcmp(tell(10, "DEPTH ."), "0 ") == 0, "and so is more text than a message carries, or less than none; nothing is left on the stack");
CHECK(strstr(tell(10, ": P5 S\" 1\" 0 5 SEND-ON ; P5"), "No one on that port") != NULL && ended_how == V4_TEXT_ERROR, "SEND-ON by a port with no one on it is an error that says so");
/* ---- no way ---- */
nacks = 0;
@@ -203,26 +289,23 @@ int main(void)
/* ---- waiting ---- */
{
v4_uheat_t c0 = pool[0].es.anticlock, c1 = pool[1].es.anticlock, c2 = pool[2].es.anticlock;
v4_uheat_t c0 = clock_of(0), c1 = clock_of(1), c2 = clock_of(2);
for (i = 0; i < 100; i++) (void)v4_fabric_step(&f);
CHECK(waiting(hera) && waiting(mid) && waiting(far), "with nothing to do, all three wait at their ports");
CHECK(pool[0].es.anticlock == c0 && pool[1].es.anticlock == c1 && pool[2].es.anticlock == c2, "and execute nothing");
CHECK(asleep(hera) && asleep(mid) && asleep(far), "with nothing to do, all three sleep");
CHECK(clock_of(0) == c0 && clock_of(1) == c1 && clock_of(2) == c2, "and execute nothing");
}
/* ---- the ways are forgotten and told again: the wiring has changed ---- */
CHECK(v4_fabric_wire(&f, hera, 3, far, 3), "the far node is wired straight to the one at the console as well");
CHECK(is_empty(tell(10, "NO-ROUTES 1 1 ROUTE 11 2 ROUTE 12 3 ROUTE")) && is_empty(tell(12, "NO-ROUTES 3 DEFAULT-ROUTE")), "and both are told");
{
v4_uheat_t before = pool[1].es.anticlock;
CHECK(strcmp(tell(12, "5 5 + ."), "10 ") == 0 && pool[1].es.anticlock == before, "text for it no longer passes through the middle node, which executes nothing");
v4_uheat_t before = clock_of(1);
CHECK(strcmp(tell(12, "5 5 + ."), "10 ") == 0 && clock_of(1) == before, "text for it no longer passes through the middle node, which executes nothing");
}
/* ---- two neighbours with something for each other at the same moment ----
* A write blocks until the neighbour reads, and a node that is writing
* is not reading: so a node looks before it begins a message, and of
* two neighbours only the one with the lower number may wait to write
* to the other (v4/capsule/core.v4, (GATE); docs/v4.0.0/MESH.md 7a).
* Each node is told who is on each of its ports. */
* Each puts its message on the wire to the other, whole, and neither waits for the other (MESH.md 7d.2).
* Each node is told who is on each of its ports: it is how it knows its centre. */
CHECK(is_empty(tell(10, "NO-ROUTES 1 1 ROUTE 11 2 ROUTE 12 2 ROUTE")) && is_empty(tell(12, "NO-ROUTES 2 DEFAULT-ROUTE")), "the row of three again");
CHECK(is_empty(tell(10, "11 2 NEIGHBOUR 0 3 NEIGHBOUR")) && is_empty(tell(11, "10 2 NEIGHBOUR 12 3 NEIGHBOUR")) && is_empty(tell(12, "11 2 NEIGHBOUR 0 3 NEIGHBOUR")),
"each is told who is on the other end of its ports");
@@ -233,194 +316,318 @@ int main(void)
* text and answers the far one: the two messages meet on one wire */
CHECK(strcmp(tell(12, ": HI S\" 72 EMIT\" 11 SEND ; HI"), "H") == 0 && printed_from == 11 && ended == 1 && ended_from == 12,
"from the far end to the middle, with the answers crossing: \"%s\" from %ld", printed, (long)printed_from);
CHECK(waiting(hera) && waiting(mid) && waiting(far), "and all three are waiting again");
CHECK(asleep(hera) && asleep(mid) && asleep(far), "and all three are asleep again");
/* every node sends every other a number of messages, all at once: each
* counts what it is sent */
CHECK(is_empty(tell(10, "VARIABLE GOT : HIT 1 GOT +! ; VARIABLE WHO VARIABLE SENT : BURST WHO ! 0 DO S\" HIT\" WHO @ SEND 1 SENT +! LOOP ;")) &&
is_empty(tell(11, "VARIABLE GOT : HIT 1 GOT +! ; VARIABLE WHO VARIABLE SENT : BURST WHO ! 0 DO S\" HIT\" WHO @ SEND 1 SENT +! LOOP ;")) &&
is_empty(tell(12, "VARIABLE GOT : HIT 1 GOT +! ; VARIABLE WHO VARIABLE SENT : BURST WHO ! 0 DO S\" HIT\" WHO @ SEND 1 SENT +! LOOP ;")), "each node is given a word to count with and one to send with");
#define COUNTING "VARIABLE GOT : HIT 1 GOT +! ; VARIABLE WHO VARIABLE SENT VARIABLE TRIED : BURST WHO ! 0 DO 1 TRIED +! S\" HIT\" WHO @ SEND 1 SENT +! LOOP ;"
CHECK(is_empty(tell(10, COUNTING)) && is_empty(tell(11, COUNTING)) && is_empty(tell(12, COUNTING)), "each node is given a word to count with and one to send with");
{
const char *r = tell(10, ": GO S\" 6 10 BURST 6 12 BURST\" 11 SEND S\" 6 11 BURST 6 10 BURST\" 12 SEND 6 11 BURST 6 12 BURST ; GO");
CHECK(is_empty(r), "six messages from each node to each other, all at once: \"%s\"", r);
CHECK(waiting(hera) && waiting(mid) && waiting(far), "all three come to rest");
CHECK(asleep(hera) && asleep(mid) && asleep(far), "all three come to rest");
CHECK(strcmp(tell(10, "GOT @ . (LOST) @ ."), "12 1 ") == 0 && strcmp(tell(11, "GOT @ . (LOST) @ ."), "12 0 ") == 0 && strcmp(tell(12, "GOT @ . (LOST) @ ."), "12 0 ") == 0,
"every one of them arrived, and none was let go: \"%s\"", printed);
}
/* ---- more than a node has room to keep ----
* A node that takes messages in while it waits to write keeps them, and
* when it has no room for one more it lets that one go and counts it.
* Far more are sent here than the nodes can keep. */
/* ---- THE FLOOD: more than the wires hold (MESH.md 7d.6, acceptance 2) ----
* 800 messages among three nodes, all at once. A SEND the wire has no room for is refused at once: the
* word that sends ends there, error 19, and the refusal is counted. A message a middle node has no room
* to pass on is let go there, counted, and its sender told. Nothing waits, and it comes to rest. */
{
long got = 0, lost = 0, sent = 0, v;
unsigned k;
long got = 0, lost = 0, refused = 0, sent = 0, tried = 0, v;
unsigned k, q, left = 0;
static const v4_cell who[3] = { 10, 11, 12 };
const char *r;
CHECK(is_empty(tell(10, "0 GOT ! 0 SENT !")) && is_empty(tell(11, "0 GOT ! 0 SENT !")) && is_empty(tell(12, "0 GOT ! 0 SENT !")), "the counts begin again");
CHECK(is_empty(tell(10, "0 GOT ! 0 SENT ! 0 TRIED !")) && is_empty(tell(11, "0 GOT ! 0 SENT ! 0 TRIED !")) && is_empty(tell(12, "0 GOT ! 0 SENT ! 0 TRIED !")), "the counts begin again");
r = tell(10, ": GO2 S\" 200 10 BURST 200 12 BURST\" 11 SEND S\" 200 11 BURST 200 10 BURST\" 12 SEND 200 11 BURST 200 12 BURST ; GO2");
CHECK(strcmp(r, "(still running)") != 0, "two hundred from each to each: it ends");
CHECK(waiting(hera) && waiting(mid) && waiting(far), "and all three come to rest, none waiting to write");
CHECK(asleep(hera) && asleep(mid) && asleep(far), "and all three come to rest, asleep");
for (k = 0; k < 3; k++) for (q = 0; q < V4_PORTS; q++) if (coming_to(k, q)) left += coming_to(k, q)->used;
CHECK(left == 0, "with nothing left on any wire: %u cells", left);
for (k = 0; k < 3; k++) {
r = tell(who[k], "GOT @ .");
v = strtol(r, NULL, 10); got += v;
CHECK(v > 0 && v <= 400, "node %ld took %ld of the 400 for it", (long)who[k], v);
r = tell(who[k], "(LOST) @ .");
lost += strtol(r, NULL, 10);
r = tell(who[k], "SENT @ .");
sent += strtol(r, NULL, 10);
CHECK(pool[k].n.mem[MQ_COUNT] == 0, "node %ld has none left waiting", (long)who[k]);
v = strtol(tell(who[k], "GOT @ ."), NULL, 10); got += v;
CHECK(v >= 0 && v <= 400, "node %ld did %ld of the messages for it", (long)who[k], v);
sent += strtol(tell(who[k], "SENT @ ."), NULL, 10);
tried += strtol(tell(who[k], "TRIED @ ."), NULL, 10);
lost += pool[k].n.mem[LOST];
refused += pool[k].n.mem[REFUSED];
}
lost -= 1; /* the one for node 99, earlier */
/* what is let go is of every kind: the text that would have set a
* node sending, the answers to text, as well as what was sent */
printf(" of %ld messages the nodes sent each other at once %ld arrived; %ld messages of all kinds were let go for want of room\n", sent, got, lost);
CHECK(lost > 0, "there was not room for all of them");
CHECK(got <= sent && got + lost >= sent, "every message sent either arrived or was counted: %ld sent, %ld arrived, %ld let go", sent, got, lost);
printf(" the flood: %ld sends tried, %ld on a wire, %ld refused at once; %ld done; (LOST) %ld, (REFUSED) %ld in all\n", tried, sent, tried - sent, got, lost, refused);
CHECK(tried > sent && sent >= got && got > 0, "there was not room for all of them: some were refused at once");
/* Every message that got on a wire and was let go on its way is counted exactly twice: once in (LOST)
* where it was let go, and once where its NACK ended -- in (REFUSED) at the node it was for, or in
* (LOST) if it could not go either. Every SEND refused at once is counted once, in (REFUSED). So
* (LOST) + (REFUSED) - the refused at once is twice the messages let go; and those are the messages
* the nodes sent each other that were not done, and answers to them. */
CHECK((lost + refused - (tried - sent)) % 2 == 0 && lost + refused - (tried - sent) >= 2 * (sent - got),
"every message sent was done or was counted: %ld on a wire, %ld done; (LOST) + (REFUSED) %ld, of which %ld were refused at once", sent, got, lost + refused, tried - sent);
CHECK(strcmp(tell(12, "7 8 * ."), "56 ") == 0 && printed_from == 12, "and the nodes go on as before");
CHECK(pool[0].n.mem[OWED_COUNT] == 0 && pool[1].n.mem[OWED_COUNT] == 0 && pool[2].n.mem[OWED_COUNT] == 0 && waiting(hera) && waiting(mid) && waiting(far),
"every refusal a node owed has been sent, and all three are at rest");
CHECK(pool[0].n.mem[REFUSED] + pool[1].n.mem[REFUSED] + pool[2].n.mem[REFUSED] > 0, "senders were told of what was refused: %ld %ld %ld",
(long)pool[0].n.mem[REFUSED], (long)pool[1].n.mem[REFUSED], (long)pool[2].n.mem[REFUSED]);
}
/* ---- refusals and waits (docs/v4.0.0/MESH.md 7b) ---------------------------
* No message is lost without its sender being told, and no node waits
* for ever. */
/* no way: the refusal travels back to the node that sent the message */
/* ---- acceptance 2 and 3: REFUSED AT ONCE, and a stuck node holds up no one ---- */
CHECK(row(), "a row made afresh");
{
v4_cell refused = pool[2].n.mem[REFUSED], lost = pool[0].n.mem[LOST];
v4_cell r0;
char text[64];
CHECK(told(10, ": F 0 DO S\" HIT\" 11 SEND LOOP ;"), "node 10 is given a word that sends node 11 short texts");
stuck = 1u << mid;
(void)tell(11, ": C BEGIN 0 UNTIL ; C");
CHECK(ended == 0 && !asleep(mid) && coming_to(mid, 2)->used == 0, "node 11 is stuck in a loop that never ends; it took the text that stuck it");
r0 = pool[hera].n.mem[REFUSED];
snprintf(text, sizeof text, "%u F", (unsigned)(V4_WIRE_CELLS / 8u));
CHECK(is_empty(tell(10, text)) && ended == 1 && ended_how == V4_TEXT_COMPLETED && pool[hera].n.mem[REFUSED] == r0 && going_from(hera, 2)->used == V4_WIRE_CELLS,
"as many as the wire holds are taken, and none is refused: the wire is full, %u cells", going_from(hera, 2)->used);
for (i = 1; i <= 5; i++) {
const char *r = tell(10, "1 F");
CHECK(strstr(r, "Message refused") != NULL && ended == 1 && ended_how == V4_TEXT_ERROR && pool[hera].n.mem[REFUSED] == r0 + (v4_cell)i,
"one more is refused at once, and counted: the line ends, having waited for nothing: \"%s\", %ld", r, (long)(pool[hera].n.mem[REFUSED] - r0));
CHECK(strcmp(tell(10, "1 2 + ."), "3 ") == 0, "node 10 answers");
}
CHECK(asleep(hera) && asleep(far) && pool[hera].n.mem[LOST] == 0, "nothing waits: nodes 10 and 12 are asleep, and nothing was let go");
/* text for node 12, beyond the stuck one */
{
static char line[1100];
v4_cell lost = pool[hera].n.mem[LOST];
memset(line, ' ', 1024); memcpy(line, "1 DROP", 6); line[1024] = 0;
nacks = 0;
(void)tell(12, line);
CHECK(nacks == 1 && nack_from == 10 && nack_about == 12 && pool[hera].n.mem[LOST] == lost + 1 && ended == 0,
"text for node 12, beyond the stuck node, is refused at node 10, whose wire to 11 is full, and the console is sent the NACK: %d from %ld about %ld", nacks, (long)nack_from, (long)nack_about);
CHECK(strcmp(tell(10, "1 2 + ."), "3 ") == 0 && asleep(hera), "node 10 answers, and sleeps");
}
}
/* ---- a refusal owed to a stuck node ---- */
CHECK(triangle(), "a row made afresh, with nodes 10 and 12 wired straight to each other");
{
v4_cell lost = pool[far].n.mem[LOST];
v4_uheat_t c;
CHECK(told(12, "NO-ROUTES 1 3 ROUTE 10 3 ROUTE 11 2 ROUTE") && told(11, "55 3 ROUTE"), "node 12 has no way for 55; node 11 is told the way to 55 is by node 12");
stuck = 1u << mid;
(void)tell(11, ": C1 S\" 1 DROP\" 55 SEND BEGIN 0 UNTIL ; C1");
CHECK(ended == 0 && pool[far].n.mem[LOST] == lost + 1, "node 11 sends 55 a message by node 12 and is then stuck in a loop: node 12 has let the message go");
CHECK(going_from(far, 2)->used == 8 && coming_to(far, 2)->used == 0, "its NACK is on the wire to node 11, which does not take it: %u cells", going_from(far, 2)->used);
c = clock_of(far);
for (i = 0; i < 500; i++) (void)v4_fabric_step(&f);
CHECK(asleep(far) && clock_of(far) == c, "node 12 is asleep, not going round: it owes nothing");
CHECK(strcmp(tell(12, "7 8 * ."), "56 ") == 0 && printed_from == 12 && strcmp(tell(10, "1 2 + ."), "3 ") == 0, "and it and node 10 answer: \"%s\"", printed);
}
/* ---- acceptance 5: PRINTING IS NOT LOST ---- */
CHECK(triangle(), "the same made afresh");
{
static char want[32768];
size_t at = 0;
for (i = 0; i < 3000; i++) at += (size_t)snprintf(want + at, sizeof want - at, "%u ", i);
CHECK(told(12, ": P 3000 0 DO I . LOOP ;") && told(10, ": SLOW 600000 0 DO LOOP ;"), "node 12 has a word that prints 3000 numbers, and node 10 one that takes a while");
forget();
saw_room_wait = 0; watch = watch_far_waits;
CHECK(put_text(12, "P") && put_text(10, "SLOW") && put_text(10, "SLOW") && put_text(10, "SLOW") && put_text(10, "SLOW") && run(),
"node 12 prints them while node 10, by which they go to the console, is busy with one line after another");
watch = 0;
CHECK(saw_room_wait > 0, "the wire to node 10 filled, and node 12 slept for room on it");
CHECK(strcmp(printed, want) == 0, "every number arrived, in order: %u characters of %u", printed_len, (unsigned)strlen(want));
CHECK(ended == 5 && pool[far].n.mem[LOST] == 0 && pool[hera].n.mem[LOST] == 0 && pool[far].n.mem[LINE_STATUS] == 1, "and then how the text ended; nothing was let go");
CHECK(strcmp(tell(12, "7 8 * ."), "56 ") == 0 && asleep(hera) && asleep(mid) && asleep(far), "and all three go on");
}
/* ---- printing held by a stuck node (MESH.md 7d.6) ---- */
CHECK(triangle(), "the same made afresh");
{
v4_cell lost, refused;
v4_uheat_t c;
CHECK(told(12, ": P 3000 0 DO I . LOOP ;") && told(12, "NO-ROUTES 2 DEFAULT-ROUTE 10 3 ROUTE") && told(10, "77 3 ROUTE : X S\" 1 DROP\" 77 SEND ;"),
"node 12's way to the console is by node 11; node 10 is told the way to 77 is by node 12");
stuck = 1u << mid;
(void)tell(11, ": C BEGIN 0 UNTIL ; C");
(void)tell(12, "P");
CHECK(ended == 0 && waits_for_room(far) && going_from(far, 2)->used > V4_WIRE_CELLS - 8u - 71u && going_from(far, 2)->used <= V4_WIRE_CELLS - 8u,
"node 12 prints until the wire to the stuck node is full but for the room kept for its answer, and sleeps for room: %u cells", going_from(far, 2)->used);
c = clock_of(far);
for (i = 0; i < 500; i++) (void)v4_fabric_step(&f);
CHECK(waits_for_room(far) && clock_of(far) == c, "executing nothing");
lost = pool[far].n.mem[LOST]; refused = pool[hera].n.mem[REFUSED];
/* its way for 77 is the full wire: while one more fits beside the room kept it is passed on, and
* after that it is refused and node 10 told. It is never kept. */
for (i = 0; i < 12 && pool[far].n.mem[LOST] == lost; i++) {
unsigned before = going_from(far, 2)->used;
CHECK(is_empty(tell(10, "X")) && ended == 1 && ended_from == 10, "node 10 sends a message for node 77 by node 12");
CHECK(coming_to(far, 3)->used == 0 && waits_for_room(far), "node 12, woken, does not keep it, and sleeps for room again");
CHECK((going_from(far, 2)->used == before + 9u && pool[far].n.mem[LOST] == lost) || (going_from(far, 2)->used == before && pool[far].n.mem[LOST] == lost + 1),
"it is passed on, or it is refused: %u cells then, %u now", before, going_from(far, 2)->used);
}
CHECK(pool[far].n.mem[LOST] == lost + 1 && pool[hera].n.mem[REFUSED] == refused + 1 && going_from(far, 2)->used <= V4_WIRE_CELLS - 8u,
"when one more would take the room kept for the answer it is refused, and node 10 told: the 8 cells are still there (%u used)", going_from(far, 2)->used);
CHECK(strcmp(tell(10, "1 2 + ."), "3 ") == 0, "node 10 answers meanwhile");
lost = pool[far].n.mem[LOST];
CHECK(v4_fabric_remove(&f, mid) == &pool[1], "node 11 is removed");
stuck = 0;
CHECK(run() && asleep(far) && pool[far].n.mem[NODE_ERROR] == 18 && pool[far].n.mem[LINE_STATUS] == 2 && pool[far].n.mem[OUT_PTR] == OUT_W,
"node 12's text ends in error 18, No one on that port, and it sleeps: error %ld, ended %ld", (long)pool[far].n.mem[NODE_ERROR], (long)pool[far].n.mem[LINE_STATUS]);
CHECK(pool[far].n.mem[LOST] == lost + 2, "the error's message and the word of how the text ended had no one to go to, and are counted: %ld", (long)(pool[far].n.mem[LOST] - lost));
(void)tell(12, "NO-ROUTES 3 DEFAULT-ROUTE");
CHECK(strcmp(tell(12, "7 8 * ."), "56 ") == 0 && printed_from == 12 && asleep(far) && asleep(hera), "told another way to the console, it goes on: \"%s\"", printed);
}
/* ---- a line from the console breaks a wait for room (MESH.md 7d.4) ---- */
CHECK(triangle(), "the same made afresh");
{
CHECK(told(12, ": P 3000 0 DO I . LOOP ;") && told(12, "NO-ROUTES 2 DEFAULT-ROUTE 10 3 ROUTE"), "node 12's way to the console is by node 11 again");
stuck = 1u << mid;
(void)tell(11, ": C BEGIN 0 UNTIL ; C");
(void)tell(12, "P");
CHECK(ended == 0 && waits_for_room(far) && pool[far].n.mem[NODE_ERROR] == 0, "node 11 is stuck, and node 12 sleeps for room to print");
(void)tell(11, "1 DROP");
(void)tell(10, ": T12 S\" 1 DROP\" 12 SEND ; T12");
CHECK(waits_for_room(far) && pool[far].n.mem[NODE_ERROR] == 0 && coming_to(far, 3)->used == 9,
"text for node 12 from another node does not break the wait: it is left on the wire, and node 12 sleeps on: %u cells", coming_to(far, 3)->used);
(void)tell(12, "65 EMIT");
CHECK(pool[far].n.mem[NODE_ERROR] == 21 && waits_for_room(far) && coming_to(far, 3)->used == 18,
"text for it from its console does: the text it was doing ends in error 21, Interrupted; the line that broke it stays on the wire: error %ld, %u cells",
(long)pool[far].n.mem[NODE_ERROR], coming_to(far, 3)->used);
(void)tell(12, "66 EMIT");
CHECK(pool[far].n.mem[NODE_ERROR] == 21 && waits_for_room(far) && coming_to(far, 3)->used == 27 && pool[far].n.mem[OUT_PTR] <= OUT_W + OUT_CELLS,
"its message has still to wait for the room, and is not broken a second time: MESH.md 7d.6");
CHECK(strcmp(tell(10, "1 2 + ."), "3 ") == 0, "node 10 answers meanwhile");
}
/* ---- Review Focus 4: THE ANSWER HAS ROOM KEPT ----
* Node 11 sends the console 127 short messages by way of node 12, which passes them on to the wire to
* node 10 while node 10 is busy: that wire is then full but for 8 cells. Node 10 has sent node 12 text
* that prints. Node 12 begins it -- there is room for its answer -- and its printing waits for room, since
* it may not take the 8 cells kept; when node 10 takes what is on the wire, the printing goes and then
* the answer, which node 10 is waiting for. */
CHECK(triangle(), "the same made afresh");
{
CHECK(told(11, "1 3 ROUTE : F1 0 DO S\" HIT\" 1 SEND LOOP ;") && told(10, ": WAIT 60000 0 DO LOOP ;")
&& told(10, ": G S\" 127 F1\" 11 SEND WAIT S\" 65 EMIT\" 12 SEND WAIT WAIT 12 AWAIT . ;"), "nodes 11 and 10 are given their words");
saw_room_wait = 0; saw_full = 0; watch = watch_far_waits;
(void)tell(10, "G");
watch = 0;
CHECK(saw_full > 0, "node 12 slept for room to print with the wire to node 10 holding exactly the 8 cells kept for its answer (%u, %u)", saw_room_wait, saw_full);
CHECK(strcmp(printed, "A1 ") == 0 && pool[far].n.mem[LOST] == 0 && pool[hera].n.mem[LOST] == 0,
"what it printed arrived, and then how the text ended, which node 10 waited for: the answer was not refused: \"%s\"", printed);
CHECK(asleep(hera) && asleep(mid) && asleep(far) && pool[far].n.mem[KEEP] == -1, "all three sleep, and node 12 keeps no room");
}
/* ---- Review Focus 2 and 3: LEFT FOR ITSELF ----
* Node 10 waits for node 12's answer. On the one wire, from node 11, there then come: text for node 10
* itself; a message for the console; and node 12's answer. */
CHECK(row(), "a row made afresh");
{
v4_uheat_t c;
CHECK(told(12, ": LL 400000 0 DO LOOP ;") && told(11, ": S1 S\" 66 EMIT\" 10 SEND ;"), "node 12 has a word that takes a long while, node 11 one that sends node 10 text");
forget();
stuck = 1u << far; /* it is busy, not stuck: it is not waited for */
CHECK(put_text(10, ": Q S\" LL\" 12 SEND 12 AWAIT . ; Q") && run() && pool[hera].n.mem[AWAIT_FROM] == 12 && asleep(hera) && ended == 0,
"node 10 sends node 12 text that takes a long while, and waits for its answer, asleep");
CHECK(is_empty(tell(11, "S1")) && ended == 1 && ended_from == 11, "node 11 sends node 10 text, and then word of how its own text ended, for the console: that is passed on by node 10");
CHECK(coming_to(hera, 2)->used == 9 && pool[hera].n.mem[AWAIT_FROM] == 12 && asleep(hera), "the text for node 10 itself is left on the wire, in front, and node 10 waits on, asleep: %u cells", coming_to(hera, 2)->used);
c = clock_of(hera);
for (i = 0; i < 2000; i++) (void)v4_fabric_step(&f);
CHECK(clock_of(hera) == c && asleep(hera), "with a message for itself on a wire it executes nothing until another comes: it does not go round");
stuck = 0;
forget();
CHECK(run() && strcmp(printed, "1 B") == 0 && ended == 1 && ended_at == 2 && pool[hera].n.mem[AWAIT_FROM] == 0,
"node 12's answer comes behind it and ends the wait; and then the text that was left is done: \"%s\"", printed);
CHECK(asleep(hera) && asleep(mid) && asleep(far) && coming_to(hera, 2)->used == 0, "all three sleep, with nothing left on the wire");
}
/* ---- acceptance 8: ORDER ---- */
CHECK(triangle(), "a row made afresh, with nodes 10 and 12 wired straight to each other");
CHECK(told(11, "12 2 ROUTE") && told(12, ": SLOW 30000 0 DO LOOP ;"), "node 11 is told the way to node 12 is by node 10; node 12 is given a word that takes a while");
CHECK(strcmp(tell(11, ": TRIO S\" SLOW 68 EMIT\" 12 SEND S\" 69 EMIT\" 12 SEND S\" 70 EMIT\" 12 SEND ; TRIO"), "DEF") == 0,
"it sends node 12 three texts, the first slow to do: the other two wait on the wire, and they are done in the order they were sent: \"%s\"", printed);
CHECK(strcmp(tell(12, ": TWO 65 EMIT 66 EMIT NOSUCHWORD ; 67 EMIT"), "UNKNOWN WORD: 'NOSUCHWORD'\n") == 0 && ended == 1 && ended_at == printed_len,
"what a text prints, and then how it ended, reach the console in that order");
/* ---- AWAIT's endings (MESH.md 7b) ---- */
CHECK(row(), "a row made afresh");
/* refused: a NACK about the node waited for */
{
v4_cell refused = pool[far].n.mem[REFUSED], lost = pool[hera].n.mem[LOST];
CHECK(is_empty(tell(12, ": N77 S\" 1 DROP\" 77 SEND ; N77")) && ended_how == V4_TEXT_COMPLETED, "node 12 sends text to node 77: it has a way for everything, toward 11");
CHECK(pool[0].n.mem[LOST] == lost + 1, "node 10, two away, has no way to 77 and counts the message");
CHECK(pool[2].n.mem[REFUSED] == refused + 1, "and node 12 is told: its count of refusals is one more");
CHECK(pool[hera].n.mem[LOST] == lost + 1 && pool[far].n.mem[REFUSED] == refused + 1, "node 10, two away, has no way to 77 and counts the message; node 12 is told, and counts the refusal");
CHECK(strstr(tell(12, ": W77 S\" 1 DROP\" 77 SEND 77 AWAIT . ; W77"), "Message refused") != NULL && ended == 1 && ended_how == V4_TEXT_ERROR && ended_from == 12,
"a node that sends to 77 and waits for its answer: the wait ends, with an error that says the message was refused: \"%s\"", printed);
CHECK(strcmp(tell(12, "7 8 * ."), "56 ") == 0 && pool[far].n.mem[AWAIT_FROM] == 0 && pool[far].n.mem[REFUSED] == refused + 1, "and it goes on to its next line, waiting for no one");
/* the refusal came before the wait began: it is on the wire, and is found there */
CHECK(strstr(tell(12, ": QF S\" 1 DROP\" 77 SEND 3000 0 DO LOOP 77 AWAIT . ; QF"), "Message refused") != NULL && ended_how == V4_TEXT_ERROR && pool[far].n.mem[AWAIT_FROM] == 0 && asleep(far),
"node 12 sends to 77, is busy a while, and then waits: the refusal is on its wire already, and the wait ends at once: \"%s\"", printed);
/* a NACK about another node does not end it, and is counted */
refused = pool[far].n.mem[REFUSED];
(void)tell(12, ": QO S\" 1 DROP\" 77 SEND 11 AWAIT . ; QO");
CHECK(ended == 0 && pool[far].n.mem[AWAIT_FROM] == 11 && pool[far].n.mem[REFUSED] == refused + 1 && asleep(far), "waiting on node 11, it is told its message for 77 was refused: that is counted, and it waits on");
}
/* a sender that is waiting for the answer stops waiting */
CHECK(strstr(tell(12, ": W77 S\" 1 DROP\" 77 SEND 77 AWAIT . ; W77"), "Message refused") != NULL && ended == 1 && ended_how == V4_TEXT_ERROR && ended_from == 12,
"a node that sends to 77 and waits for its answer: the wait ends, with an error that says the message was refused: \"%s\"", printed);
CHECK(strcmp(tell(12, "7 8 * ."), "56 ") == 0 && pool[2].n.mem[AWAIT_FROM] == 0, "and it goes on to its next line, waiting for no one");
/* no room: a node that is waiting keeps what it is sent, and has room for only so much */
/* gone: a GONE from its centre, and not from another */
{
v4_cell lost = pool[1].n.mem[LOST], refused = pool[0].n.mem[REFUSED], got, not_taken;
CHECK(is_empty(tell(11, "0 GOT !")) && is_empty(tell(11, "12 AWAIT .")) && ended == 0 && pool[1].n.mem[AWAIT_FROM] == 12, "node 11 waits for an answer from 12, which is not going to send one");
CHECK(is_empty(tell(10, ": F 49 0 DO S\" HIT\" 11 SEND LOOP ; F")) && ended == 1 && ended_from == 10, "node 10 sends it 49 messages meanwhile");
CHECK(pool[1].n.mem[MQ_COUNT] > 300 && pool[1].n.mem[MQ_COUNT] <= MQ_CELLS - 36, "node 11 has kept what it has room for, and left the room that is kept for refusals: %ld cells", (long)pool[1].n.mem[MQ_COUNT]);
CHECK(pool[1].n.mem[OWED_COUNT] == 8, "it owes a refusal for each of the rest, as many as it can owe: %ld", (long)pool[1].n.mem[OWED_COUNT]);
CHECK(pool[0].n.mem[REFUSED] == refused, "and has sent none yet: it is still waiting");
/* one from its centre ends the wait */
CHECK(is_empty(tell(10, "12 NO-ROUTE")), "node 10 forgets the way to 12");
CHECK(strstr(tell(10, "12 11 GONE"), "Node gone") != NULL && printed_from == 11 && ended_from != -1, "node 10, its centre, tells it 12 is gone: its wait ends with an error that says so: \"%s\"", printed);
CHECK(pool[1].n.mem[AWAIT_FROM] == 0 && waiting(mid), "it is waiting for no one, and is back at its ports");
got = strtol(tell(11, "GOT @ ."), NULL, 10);
not_taken = 49 - got;
CHECK(got >= 30 && not_taken > 8, "it then did every message it had kept: %ld of the 49", (long)got);
CHECK(pool[0].n.mem[REFUSED] == refused + 8, "and sent the eight refusals it owed: node 10 was told of %ld", (long)(pool[0].n.mem[REFUSED] - refused));
CHECK(pool[1].n.mem[LOST] == lost + not_taken + (not_taken - 8), "it counted each message it did not take, and each refusal it could not owe: %ld for %ld not taken",
(long)(pool[1].n.mem[LOST] - lost), (long)not_taken);
/* the way to 12 is forgotten: what is sent there now is refused */
refused = pool[1].n.mem[REFUSED];
CHECK(is_empty(tell(11, ": P12 S\" 1 DROP\" 12 SEND ; P12")) && pool[1].n.mem[REFUSED] == refused + 1, "having forgotten the way to 12, what node 11 sends there goes toward its centre, which has no way either, and is refused");
CHECK(is_empty(tell(10, "12 2 ROUTE")) && is_empty(tell(11, "12 3 ROUTE")) && strcmp(tell(12, "7 8 * ."), "56 ") == 0, "told the way again, they reach 12 as before");
v4_cell ways = pool[far].n.mem[ROUTE_COUNT];
CHECK(told(11, "44 3 ROUTE"), "node 11 is given a way");
ways = pool[mid].n.mem[ROUTE_COUNT];
CHECK(is_empty(tell(11, "44 AWAIT .")) && ended == 0 && pool[mid].n.mem[AWAIT_FROM] == 44, "node 11 waits for an answer from a node 44");
CHECK(is_empty(tell(10, ": G12 44 11 GONE ;")) && told(10, "12 2 ROUTE"), "(node 10 is given a word)");
/* node 12 is still waiting on 11: a line from the console ends that */
CHECK(strstr(tell(12, "1 DROP"), "Interrupted") != NULL, "(node 12's wait is ended from the console)");
CHECK(told(12, "44 11 GONE") && pool[mid].n.mem[AWAIT_FROM] == 44 && pool[mid].n.mem[ROUTE_COUNT] == ways,
"node 12 tells it that 44 is gone: node 12 is not its centre, and it goes on waiting, its ways as they were");
CHECK(strstr(tell(10, "G12"), "Node gone") != NULL && printed_from == 11 && pool[mid].n.mem[AWAIT_FROM] == 0 && pool[mid].n.mem[ROUTE_COUNT] == ways - 1,
"node 10, its centre, tells it: the wait ends with an error that says so, and the way is forgotten: \"%s\"", printed);
CHECK(asleep(mid) && coming_to(mid, 3)->used == 0 && coming_to(mid, 2)->used == 0, "it sleeps; the GONE it did not believe was not kept");
(void)tell(11, "33 AWAIT .");
CHECK(ended == 0 && told(10, "44 11 GONE") && pool[mid].n.mem[AWAIT_FROM] == 33 && asleep(mid), "a GONE from its centre about another node does not end a wait");
}
/* a line from the console breaks a wait (MESH.md 7b.6) */
CHECK(is_empty(tell(10, "12 AWAIT .")) && ended == 0 && pool[0].n.mem[AWAIT_FROM] == 12 && waiting(hera), "node 10 waits for an answer from 12, which is not going to send one");
CHECK(is_empty(tell(11, "20 22 + .")) && ended == 0 && pool[0].n.mem[AWAIT_FROM] == 12, "text from the console for node 11 comes to node 10 on its way: node 10 keeps it, and goes on waiting");
/* interrupted: text from the console */
CHECK(row(), "a row made afresh");
{
const char *r = tell(10, "65 EMIT");
CHECK(strstr(r, "Interrupted\n") != NULL && pool[0].n.mem[AWAIT_FROM] == 0, "text from the console for node 10 itself ends its wait, with an error that says so: \"%s\"", r);
CHECK(strstr(r, "A") != NULL && strstr(r, "42 ") != NULL && ended == 3, "the line is then done as usual, and so is what was kept for node 11: \"%s\", %d ended", r, ended);
CHECK(strstr(r, "Interrupted\n") < strstr(r, "A"), "the wait ends before the line that ended it is done");
}
CHECK(strcmp(tell(10, "1 2 + ."), "3 ") == 0 && waiting(hera) && waiting(mid) && waiting(far), "and all three go on as before");
CHECK(strstr(tell(10, "5 NO-ROUTE"), "ERROR") == NULL && strcmp(tell(11, "20 22 + ."), "42 ") == 0, "forgetting the way to a node there was no way to changes nothing");
/* ---- what the review of step 6c found (MESH.md step 6c) ------------------- */
step_cap = 3000000;
v4_cell ways11 = 0;
/* a GONE is believed only from the node's centre: not by another port, and not from another node by the centre's port */
CHECK(is_empty(tell(10, "12 NO-ROUTE 12 3 ROUTE 12 3 NEIGHBOUR")) && is_empty(tell(12, "NO-ROUTES 3 DEFAULT-ROUTE 11 2 ROUTE 10 3 NEIGHBOUR")),
"node 12 is reached straight from node 10 now, and has its own wire to 11");
CHECK(is_empty(tell(11, "12 AWAIT .")) && ended == 0 && pool[1].n.mem[AWAIT_FROM] == 12, "node 11 waits for node 12's answer");
ways11 = pool[1].n.mem[ROUTE_COUNT];
CHECK(is_empty(tell(12, "12 11 GONE")) && ended == 1 && ended_from == 12 && pool[1].n.mem[AWAIT_FROM] == 12 && pool[1].n.mem[ROUTE_COUNT] == ways11,
"node 12 tells it, by the wire between them, that 12 is gone: that is not by its centre's port, and it goes on waiting");
CHECK(is_empty(tell(12, "11 NO-ROUTE 12 11 GONE")) && ended == 1 && ended_from == 12 && pool[1].n.mem[AWAIT_FROM] == 12 && pool[1].n.mem[ROUTE_COUNT] == ways11,
"node 12 says it again by way of node 10: it comes by the centre's port but is not from the centre, and node 11 goes on waiting, its ways as they were");
CHECK(strstr(tell(10, "12 11 GONE"), "Node gone") != NULL && pool[1].n.mem[AWAIT_FROM] == 0, "node 10, its centre, says it: the wait ends: \"%s\"", printed);
CHECK(is_empty(tell(11, "12 3 ROUTE")) && is_empty(tell(12, "11 2 ROUTE")), "the ways are told again");
/* an answer that came before the wait began is in the messages waiting, and is found there */
CHECK(strstr(tell(12, ": QF S\" 1 DROP\" 77 SEND 3000 0 DO LOOP S\" 1 DROP\" 10 SEND 77 AWAIT . ; QF"), "Message refused") != NULL && ended_how == V4_TEXT_ERROR
&& pool[2].n.mem[AWAIT_FROM] == 0 && waiting(far),
"node 12 sends to 77, is busy a while, sends another message -- taking in the refusal as it does -- and then waits for 77's answer: the wait ends at once: \"%s\"", printed);
CHECK(strcmp(tell(12, "7 8 * ."), "56 ") == 0, "and it goes on");
/* a waiting sender whose message found no room */
{
CHECK(is_empty(tell(11, "0 GOT !")) && is_empty(tell(11, "12 AWAIT .")) && pool[1].n.mem[AWAIT_FROM] == 12, "node 11 waits on 12 again");
CHECK(is_empty(tell(10, ": F40 40 0 DO S\" HIT\" 11 SEND LOOP ; F40")) && pool[1].n.mem[OWED_COUNT] == 0, "node 10 sends it as many messages as it has room for");
(void)tell(10, ": ONE S\" HIT\" 11 SEND 12 NO-ROUTE 12 11 GONE 11 AWAIT . ; ONE");
CHECK(strstr(printed, "Message refused") != NULL && pool[0].n.mem[AWAIT_FROM] == 0,
"it sends one more, for which there is no room, ends node 11's wait, and waits for node 11's answer: its own wait ends, the message refused: \"%s\"", printed);
CHECK(strtol(tell(11, "GOT @ ."), NULL, 10) == 40 && is_empty(tell(10, "12 3 ROUTE")) && is_empty(tell(11, "12 3 ROUTE")), "node 11 did the forty it had kept; the ways are told again");
const char *r;
CHECK(is_empty(tell(10, "12 AWAIT .")) && ended == 0 && pool[hera].n.mem[AWAIT_FROM] == 12 && asleep(hera), "node 10 waits for an answer from 12, which is not going to send one");
CHECK(strcmp(tell(11, "20 22 + ."), "42 ") == 0 && ended == 1 && pool[hera].n.mem[AWAIT_FROM] == 12 && asleep(hera),
"text from the console for node 11 comes to node 10 on its way: node 10 passes it on, and what comes back, and goes on waiting");
r = tell(10, "65 EMIT");
CHECK(strcmp(r, "Interrupted\nA") == 0 && ended == 2 && pool[hera].n.mem[AWAIT_FROM] == 0, "text from the console for node 10 itself ends its wait, with an error that says so, and is then done: \"%s\"", r);
CHECK(strcmp(tell(10, "1 2 + ."), "3 ") == 0 && asleep(hera) && asleep(mid) && asleep(far), "and all three go on as before");
CHECK(strstr(tell(10, "5 NO-ROUTE"), "ERROR") == NULL && strcmp(tell(11, "20 22 + ."), "42 ") == 0, "forgetting the way to a node there was no way to changes nothing");
}
/* an answer that is refused on its way back is told to the node that waits for it, not to the node that answered */
/* ---- an answer refused on its way back; a message that would go round for ever ---- */
CHECK(triangle(), "a row made afresh, with nodes 10 and 12 wired straight to each other");
{
v4_cell r12 = pool[2].n.mem[REFUSED];
CHECK(is_empty(tell(12, "10 2 ROUTE")), "node 12 is told the way to node 10 is by node 11");
CHECK(is_empty(tell(11, "0 GOT !")) && is_empty(tell(11, "55 AWAIT .")) && pool[1].n.mem[AWAIT_FROM] == 55, "node 11 waits on a node there is not");
CHECK(is_empty(tell(10, "F40")) && pool[1].n.mem[OWED_COUNT] == 0, "node 10 sends it as many messages as it has room for");
(void)tell(10, ": RA S\" 1 DROP\" 12 SEND 3000 0 DO LOOP 55 11 GONE 12 AWAIT . ; RA");
CHECK(strstr(printed, "Message refused") != NULL && pool[0].n.mem[AWAIT_FROM] == 0,
"node 10 sends node 12 text; its answer comes back by node 11, which has no room for it; node 10 then ends node 11's wait and waits for the answer: it is told the message was refused: \"%s\"", printed);
CHECK(pool[2].n.mem[REFUSED] == r12, "node 12, which answered, is told nothing");
CHECK(strtol(tell(11, "GOT @ ."), NULL, 10) == 40 && is_empty(tell(12, "10 3 ROUTE")) && strcmp(tell(12, "7 8 * ."), "56 ") == 0, "node 11 did the forty it had kept; the way is told again");
}
/* a message that would go round for ever is refused after 16 nodes have passed it on */
{
v4_cell refused = pool[0].n.mem[REFUSED], l10 = pool[0].n.mem[LOST], l11 = pool[1].n.mem[LOST];
CHECK(is_empty(tell(10, "66 2 ROUTE")), "node 10 is told the way to 66 is by node 11, whose way for everything it has not been told of is back by node 10");
v4_cell refused, l10, l11, r12;
/* a message that would go round for ever is refused after 16 nodes have passed it on */
refused = pool[hera].n.mem[REFUSED]; l10 = pool[hera].n.mem[LOST]; l11 = pool[mid].n.mem[LOST];
CHECK(told(10, "66 2 ROUTE"), "node 10 is told the way to 66 is by node 11, whose way for everything it has not been told of is back by node 10");
CHECK(is_empty(tell(10, ": H66 S\" 1 DROP\" 66 SEND ; H66")) && ended == 1 && ended_how == V4_TEXT_COMPLETED, "node 10 sends 66 a message: it comes to rest");
CHECK(pool[0].n.mem[LOST] + pool[1].n.mem[LOST] == l10 + l11 + 1 && pool[0].n.mem[REFUSED] == refused + 1,
"one of the two let it go when it had been passed on 16 times, and node 10 was told it was refused");
CHECK(is_empty(tell(10, "66 NO-ROUTE")) && waiting(hera) && waiting(mid) && waiting(far), "the way is forgotten, and all three are at rest");
CHECK(pool[hera].n.mem[LOST] + pool[mid].n.mem[LOST] == l10 + l11 + 1 && pool[hera].n.mem[REFUSED] == refused + 1,
"one of the two let it go when it had been passed on as often as a message may be, and node 10 was told it was refused");
nacks = 0;
CHECK(is_empty(tell(66, "1 DROP")) && nacks == 1 && nack_about == 66, "the same from the console, which sends it with no count: it too is let go, and the console told");
CHECK(strstr(tell(10, ": W66 S\" 1 DROP\" 66 SEND 66 AWAIT . ; W66"), "Message refused") != NULL && ended_how == V4_TEXT_ERROR && pool[hera].n.mem[AWAIT_FROM] == 0,
"and waiting for 66's answer, node 10 is the one that lets its own message go when it comes back the last time: its wait ends, the message refused: \"%s\"", printed);
CHECK(told(10, "66 NO-ROUTE") && asleep(hera) && asleep(mid) && asleep(far), "the way is forgotten, and all three are at rest");
/* An answer that cannot be passed on: the NACK is for the node the answer was for, not the node that
* answered. Here it cannot go either -- it has the answer's own way to go -- and whoever waits is
* not told: MESH.md 7d.6. That wait is ended from the console. */
r12 = pool[far].n.mem[REFUSED]; l11 = pool[mid].n.mem[LOST];
CHECK(told(12, "10 2 ROUTE") && told(11, "10 4 ROUTE"), "node 12 is told the way to node 10 is by node 11, which is told it is by a port with no one on it");
(void)tell(10, ": RA S\" 1 DROP\" 12 SEND 12 AWAIT . ; RA");
CHECK(ended == 0 && pool[hera].n.mem[AWAIT_FROM] == 12 && pool[mid].n.mem[LOST] == l11 + 2,
"node 10 sends node 12 text and waits; the answer comes back by node 11, which cannot pass it on, nor the NACK for it: both are counted: %ld", (long)(pool[mid].n.mem[LOST] - l11));
CHECK(pool[far].n.mem[REFUSED] == r12 && asleep(far), "node 12, which answered, is told nothing: the NACK was not for it");
CHECK(strcmp(tell(10, "1 2 + ."), "Interrupted\n3 ") == 0 && asleep(hera), "node 10's wait is ended from the console: \"%s\"", printed);
}
/* a node that owes a refusal to a node that is stuck is not stuck itself */
CHECK(is_empty(tell(12, "NO-ROUTES 1 3 ROUTE 10 3 ROUTE 11 2 ROUTE")) && is_empty(tell(11, "55 3 ROUTE")), "node 12 has no way for 55; node 11 is told the way to 55 is by node 12");
CHECK(strcmp(tell(11, ": C1 S\" 1 DROP\" 55 SEND BEGIN 0 UNTIL ; C1"), "(still running)") == 0, "node 11 sends 55 a message and is then stuck in a loop");
CHECK(pool[2].n.mem[OWED_COUNT] == 1, "node 12 owes node 11 a refusal, and cannot give it: node 11 is not reading");
(void)tell(12, "7 8 * .");
CHECK(strcmp(printed, "56 ") == 0 && printed_from == 12, "node 12 goes on doing what it is sent: \"%s\"", printed);
/* a node that is waiting to write to a node finds out when that node is removed */
(void)tell(12, ": TO11 S\" 1 DROP\" 11 SEND 65 EMIT ; TO11");
CHECK(ended == 0, "node 12 sends node 11 a message: node 11 is not reading, and node 12 waits to write to it");
CHECK(v4_fabric_remove(&f, mid) == &pool[1], "node 11 is removed");
(void)tell(10, "1 DROP");
CHECK(strstr(printed, "No one on that port") != NULL && strstr(printed, "A") == NULL, "node 12's line ends in an error that says no one is there: \"%s\"", printed);
step_cap = 20000000;
CHECK(strcmp(tell(12, "7 8 * ."), "56 ") == 0 && pool[2].n.mem[OWED_COUNT] == 0 && waiting(far) && waiting(hera),
"it goes on, the refusal it owed node 11 let go: it owes nothing and is at rest");
/* THE LIMIT (MESH.md 7b.7): a refusal owed to a neighbour whose number is the higher is written
* without looking, as any message to it is, so a node that is stuck holds up a neighbour that owes
* it one -- until it is removed */
step_cap = 3000000;
CHECK(is_empty(tell(12, "55 3 ROUTE")), "node 12 is told the way to 55 is by node 10, which has none");
CHECK(strcmp(tell(12, ": C2 S\" 1 DROP\" 55 SEND BEGIN 0 UNTIL ; C2"), "(still running)") == 0 && pool[0].n.asking && pool[0].n.mem[OWED_COUNT] == 1,
"node 12 sends 55 a message and is then stuck in a loop: node 10 owes it a refusal, writes it, and is blocked");
v4_fabric_gone_error(&f, V4_ERROR_NO_ONE);
CHECK(v4_fabric_remove(&f, far) == &pool[2], "node 12 is removed");
step_cap = 20000000;
CHECK(strcmp(tell(10, "1 2 + ."), "3 ") == 0 && pool[0].n.mem[OWED_COUNT] == 0 && waiting(hera), "node 10 is let go, lets the refusal go, and goes on: \"%s\"", printed);
/* ---- the stacks, between texts (MESH.md 7c.6, 7d.4) ----
* After a text that left nothing on the data stack, what a node's stacks hold while it does nothing that
* is a text's is what the nucleus uses: passing on, refusing, taking in, and sending what a text printed and
* how it ended. It is looked at once an instruction word, so it is the least that was used; that 28
* values may wait is measured in test_host_quit.c and, for passing on and refusing, in test_host_depth.c.
* The return stack is empty when a text ends; (FINISH)'s wait for room goes seven deep on it. */
printf(" between texts the nucleus used at most %u cells of the data stack and %u entries of the return stack\n", between_data, between_ret);
CHECK(between_data <= 4 && between_ret <= 7, "between texts: four cells of the data stack, and seven return entries");
printf(" %d checks, %d failures\n", checks, failures);
return failures != 0;
v4/tests/test_host_quit.c
+90 -36
View File
@@ -42,6 +42,7 @@
*/
#include "v4/text.h"
#include "v4/message.h"
#include "v4/wire.h"
#include "v4/testcode.h"
#include <stdint.h>
#include <stdio.h>
@@ -63,7 +64,6 @@ static v4_heat h;
static v4_text tx;
static v4_cell w_key, w_key_end, w_fault, capsule_latest;
static v4_cell w_idle; /* (IDLE): where the node waits for a message */
static v4_cell w_idle_end; /* (PASS-ON): the word after it */
static char out[V4_CONSOLE_CAP + 1];
/* STORAGE (MESH.md section 8). The node asks its kernel for its blocks, and
@@ -190,17 +190,81 @@ static const char *node_name(v4_cell xt)
static char typed[8192]; /* typed and not yet taken */
static unsigned typed_len;
static int line_open; /* a line has been sent and has not ended */
static v4_message to_node, from_node; /* the message going in, and the one coming out */
static unsigned to_sent; /* how many words of to_node the node has taken */
static v4_message to_node; /* the message going in */
static char shown[V4_CONSOLE_CAP]; /* what the node has printed since the console last looked */
static unsigned shown_len;
static int shown_dropped;
static int text_ended; /* how the text ended, when it has */
/* 1 if the node is where it waits for a message, with nothing given it. */
/* THE WIRES (MESH.md 7d.5). The node is alone and has no fabric: these
* tests keep the queues of its console's wire, do what it asks of them, and
* are what is on the other end, as v4/system/boot.c is for the products.
* Every other port has no one on it. */
static v4_wire_queue wire_in, wire_out; /* to the node from its console, and from it */
static int span_ok(v4_cell addr, unsigned count)
{
if (count == 0) return 1;
if (addr < 0 || (v4_ucell)addr > (v4_ucell)(V4_NODE_WORDS - count)) return 0;
return !(addr <= PORT + (v4_cell)V4_PORT_HAVE && addr + (v4_cell)count > PORT);
}
/* Do the operation the node is blocked at. 0: it sleeps on. */
static int wire_do(void)
{
v4_wire_queue *rx = n.wire == CONSOLE_PORT ? &wire_in : 0, *tx = n.wire == CONSOLE_PORT ? &wire_out : 0;
v4_cell a = n.wire_a, b = n.wire_b, hd[V4_WIRE_HEADER], how = V4_WIRE_NO_ONE;
unsigned cells;
switch (n.do_op) {
case 1: if (rx) how = span_ok(a, V4_WIRE_HEADER) || rx->mark >= rx->used ? v4_wire_look(rx, span_ok(a, V4_WIRE_HEADER) ? &n.mem[a] : hd) : V4_WIRE_NOT_A_MESSAGE; break;
case 2:
if (!rx) break;
if (v4_wire_look(rx, hd) != V4_WIRE_DONE) { how = V4_WIRE_NO_MESSAGE; break; }
cells = v4_wire_cells(hd[6]) - V4_WIRE_HEADER;
how = span_ok(a, V4_WIRE_HEADER) && span_ok(b, cells) ? v4_wire_take(rx, &n.mem[a], cells ? &n.mem[b] : hd, cells) : V4_WIRE_NOT_A_MESSAGE;
break;
case 3: if (rx) how = rx->mark >= rx->used ? V4_WIRE_NO_MESSAGE : a == (v4_cell)CONSOLE_PORT ? v4_wire_move(rx, &wire_out) : V4_WIRE_NO_ONE; break;
case 4: if (rx) how = v4_wire_drop(rx); break;
case 5:
if (!tx) break;
cells = span_ok(a, V4_WIRE_HEADER) ? v4_wire_cells(n.mem[a + 6]) : 0;
how = cells && span_ok(b, cells - V4_WIRE_HEADER) ? v4_wire_put(tx, &n.mem[a], cells > V4_WIRE_HEADER ? &n.mem[b] : hd) : V4_WIRE_NOT_A_MESSAGE;
break;
case 6: if (rx) { v4_wire_first(rx); how = V4_WIRE_DONE; } break;
case 7: if (rx) how = v4_wire_next(rx); break;
case 8: if (!wire_in.arrived) return 0; how = V4_WIRE_DONE; break;
case 9:
if (!tx) break;
if (a < 0 || a > (v4_cell)V4_WIRE_CELLS) { how = V4_WIRE_NO_ROOM; break; }
if (v4_wire_room(tx, (unsigned)a) == V4_WIRE_DONE) { how = V4_WIRE_DONE; break; }
if (!wire_in.arrived) return 0;
how = V4_WIRE_NO_ROOM;
break;
case 10: if (tx) how = a < 0 ? V4_WIRE_NOT_A_MESSAGE : a <= (v4_cell)V4_WIRE_CELLS ? v4_wire_room(tx, (unsigned)a) : V4_WIRE_NO_ROOM; break;
default: how = V4_WIRE_NOT_A_MESSAGE; break;
}
v4_node_done(&n, how);
return 1;
}
/* One instruction word, and then what the node asked of its wires; as the
* fabric orders a step (fabric.c). */
static void node_step(void)
{
v4_node_have(&n, wire_in.used > 0 ? 1u << CONSOLE_PORT : 0u);
(void)v4_exec_step_word(&n, &es, &h);
if (n.have_fetched) { wire_in.arrived = 0; n.have_fetched = 0; }
if (v4_node_doing(&n)) (void)wire_do();
}
/* The console puts a line on the node's wire. */
static int console_put(const v4_message *m)
{
return v4_wire_put(&wire_in, m->word, m->word + V4_MSG_HEADER) == V4_WIRE_DONE;
}
/* 1 if the node is asleep with nothing to do: where it waits for a message. */
static int node_idle(void)
{
return n.reading && !n.given && n.read_port == V4_PORT_ANY && n.p > w_idle && n.p <= w_idle_end; /* in (IDLE), where it reads */
return v4_node_doing(&n) && n.do_op == 8 && wire_in.used == 0 && n.mem[AWAIT_FROM] == 0;
}
/* Run until the text ends, or until it has been inside KEY with nothing to
@@ -208,35 +272,27 @@ static int node_idle(void)
* for a character, 0: neither. */
static int run_line(long max)
{
static v4_cell hd[V4_WIRE_HEADER], text[V4_MSG_MAX_CHARS / 4u];
long steps = 0;
unsigned idle = 0;
while (steps < max && idle < 64) {
(void)v4_exec_step_word(&n, &es, &h);
node_step();
steps++;
if (n.asking && n.ask_port == 0) { kernel_serve(); v4_node_port_served(&n); continue; } /* a request */
if (n.asking && n.ask_port == CONSOLE_PORT) { /* a word of a message from the node */
v4_cell word = n.request;
v4_node_port_served(&n);
if (v4_message_word(&from_node, word)) {
unsigned i, chars = v4_message_length(&from_node);
if (v4_message_type(&from_node) == V4_MSG_OUTPUT) {
for (i = 0; i < chars; i++) {
if (shown_len < sizeof shown) shown[shown_len++] = v4_message_char(&from_node, i);
else shown_dropped = 1;
}
} else if (v4_message_type(&from_node) == V4_MSG_DONE) {
text_ended = (int)from_node.word[V4_MSG_HEADER];
from_node.count = 0;
last_steps = steps;
return 1;
if (n.asking) { (void)v4_node_port_gone(&n, 18); continue; } /* a port with no one on it */
v4_wire_first(&wire_out);
while (v4_wire_take(&wire_out, hd, text, V4_MSG_MAX_CHARS / 4u) == V4_WIRE_DONE) { /* what the node has sent */
if (hd[2] == V4_MSG_OUTPUT) {
unsigned i;
for (i = 0; i < (unsigned)hd[6]; i++) {
if (shown_len < sizeof shown) shown[shown_len++] = (char)(((v4_ucell)text[i / 4u] >> (8u * (i % 4u))) & 0xFFu);
else shown_dropped = 1;
}
from_node.count = 0;
} else if (hd[2] == V4_MSG_DONE) {
text_ended = (int)text[0];
last_steps = steps;
return 1;
}
continue;
}
if (n.reading && !n.given && to_sent < to_node.count && (n.read_port == CONSOLE_PORT || n.read_port == V4_PORT_ANY)) {
v4_node_port_give(&n, CONSOLE_PORT, to_node.word[to_sent++]); /* a word of the message to the node */
continue;
}
if (n.input_pos == n.input_len && n.p >= w_key && n.p < w_key_end) idle++; else idle = 0;
}
@@ -279,7 +335,7 @@ static void boot_with(unsigned depth)
for (i = 0; i < depth; i++) v4_dstack_push(&n.ds, (v4_cell)(0x5A000000 + i));
v4_dstack_push(&n.ds, CANARY);
v4_node_port_attach(&n, PORT);
v4_node_port_status(&n, 0, (1u | 1u << CONSOLE_PORT) * (1u + (1u << V4_PORTS))); /* the kernel and the console take what is written when it is written */
v4_wire_reset(&wire_in); v4_wire_reset(&wire_out);
n.mem[WORD_DEFINED] = 0; /* no one is told of entries, until a test says so */
n.mem[WORD_FORGOTTEN] = 0;
known_n = 0;
@@ -287,13 +343,13 @@ static void boot_with(unsigned depth)
n.mem[LINE_STATUS] = 1;
n.mem[ME] = 0; /* it has no number yet: a message to 0 is for it */
HOST_MESSAGES_EMPTY(&n);
n.mem[REPLY] = PORT + CONSOLE_PORT;
n.mem[REPLY] = CONSOLE_PORT;
n.p = w_idle; /* waiting for a message */
typed_len = 0;
line_open = 0;
to_node.count = 0; to_sent = 0; from_node.count = 0;
to_node.count = 0;
shown_len = 0; shown_dropped = 0;
for (i = 0; i < 64 && !n.reading; i++) (void)v4_exec_step_word(&n, &es, &h); /* no message waits: it reads its ports, and is blocked */
for (i = 0; i < 256 && !node_idle(); i++) node_step(); /* no message waits: it sleeps */
}
static void boot(void) { boot_with(0); }
/* The same with nothing at all on the data stack. */
@@ -335,7 +391,7 @@ static const char *say(const char *input)
if (!nl) break;
len = (unsigned)(nl - typed);
if (!v4_message_text(&to_node, 0, 1, V4_MSG_TEXT, typed, len)) return "(line too long)";
to_sent = 0;
if (!console_put(&to_node)) return "(no room on the wire)";
memmove(typed, nl + 1, typed_len - len - 1);
typed_len -= len + 1;
line_open = 1;
@@ -376,8 +432,7 @@ static int post_line(void *self, const char *text, unsigned text_len, char *o, u
(void)self;
*len = 0;
if (post_state_fails && text_len == 25 && memcmp(text, "DECIMAL FORTH DEFINITIONS", 25) == 0) text = "NOSUCHWORD-FOR-STATE ";
if (!v4_message_text(&to_node, 0, 1, V4_MSG_TEXT, text, text_len)) return -1;
to_sent = 0; from_node.count = 0;
if (!v4_message_text(&to_node, 0, 1, V4_MSG_TEXT, text, text_len) || !console_put(&to_node)) return -1;
shown_len = 0; shown_dropped = 0;
ended = run_line(post_step_limit);
if (ended != 1) return -1;
@@ -870,7 +925,6 @@ int main(void)
printf(" capsule: %ld words\n", (long)v4_text_here(&tx) - 16);
if (failures) { printf(" %d checks, %d failures\n", checks, failures); return 1; }
w_idle = v4_text_word(&tx, "(IDLE)");
w_idle_end = v4_text_word(&tx, "(PASS-ON)"); /* the word after (IDLE) in quit.v4 */
w_key = v4_text_word(&tx, "KEY");
w_key_end = v4_text_word(&tx, "CR"); /* the word after KEY in core.v4 */
w_fault = v4_text_word(&tx, "(FAULTS)");
@@ -1153,7 +1207,7 @@ int main(void)
(void)say("WORDS\n");
for (at = 0; at < plain; at++) if (n.mem[OUT_W + OUT_CELLS + at] != 0) { over++; worst = k; break; }
if (n.mem[OUT_PTR] > OUT_W + OUT_CELLS) { over++; worst = k; }
if (n.asking || n.doing) { over++; worst = k; } /* it stored to a port */
if (n.asking) { over++; worst = k; } /* it stored to a port */
CHECK(strcmp(say("1 2 + .\n"), "3 ok\nok> ") == 0, "WORDS with %u values on the stack: the node goes on", k);
}
CHECK(over == 0, "nothing was ever put past the end of the output buffer (it was, with %u values on the stack)", worst);
v4/tests/test_host_unit.c
+104 -74
View File
@@ -63,6 +63,8 @@ static int storage_made(void)
}
static v4_place places[PLACES];
static v4_fabric f;
#define QUEUES 64u /* two for every wire there is at once: five kernels, the console, four to Hera, four round the square */
static v4_wire_queue queues[QUEUES];
static v4_image im; /* only what the dictionary hash needs of it */
/* ---- the capsules ---- */
@@ -196,10 +198,10 @@ static int kernel_take(void *self, v4_cell value) /* a request */
}
static const v4_device kernel = { kernel_take, kernel_give, 0, 0 };
/* ---- the console: a device on Hera's port 1 ---- */
/* ---- the console: a device on Hera's port 1 ----
* It speaks whole messages: it puts them on the wire to Hera and takes them
* off the wire from her, through the fabric (MESH.md 7d.2). */
#define CONSOLE_ID 1
static v4_message going, coming;
static unsigned going_at;
static char printed[8192]; /* what has come back since the console last sent */
static unsigned printed_len;
static v4_cell printed_from;
@@ -207,48 +209,45 @@ static int ended;
static v4_cell ended_from, ended_how;
static unsigned post_passed[32]; /* by node number: POST tallies with no failures seen from it */
static unsigned post_other; /* tallies with failures */
static const v4_device console = { 0, 0, 0, 0 };
static int console_give(void *self, v4_cell *value)
static unsigned console_takes(void)
{
(void)self;
if (going_at >= going.count) return 0;
*value = going.word[going_at++];
return 1;
}
static int console_take(void *self, v4_cell value)
{
(void)self;
if (v4_message_word(&coming, value)) {
if (v4_message_type(&coming) == V4_MSG_OUTPUT) {
unsigned i, chars = v4_message_length(&coming), start = printed_len;
for (i = 0; i < chars && printed_len + 1 < sizeof printed; i++) printed[printed_len++] = v4_message_char(&coming, i);
static v4_cell hd[V4_WIRE_HEADER], text[V4_MSG_MAX_CHARS / 4u];
unsigned took = 0;
while (v4_fabric_device_take(&f, hera_place, 1, hd, text, V4_MSG_MAX_CHARS / 4u) == V4_WIRE_DONE) {
took++;
if (hd[2] == V4_MSG_OUTPUT) {
unsigned i, start = printed_len;
for (i = 0; i < (unsigned)hd[6] && printed_len + 1 < sizeof printed; i++) printed[printed_len++] = (char)(((v4_ucell)text[i / 4u] >> (8u * (i % 4u))) & 0xFFu);
printed[printed_len] = 0;
printed_from = v4_message_from(&coming);
printed_from = hd[1];
if (strstr(printed + start, "PARITY:V4_POST")) {
if (strstr(printed + start, " fail=0\n") && printed_from >= 0 && printed_from < 32) post_passed[printed_from]++;
else post_other++;
}
} else if (v4_message_type(&coming) == V4_MSG_DONE) {
} else if (hd[2] == V4_MSG_DONE) {
ended++;
ended_from = v4_message_from(&coming);
ended_how = coming.word[V4_MSG_HEADER];
ended_from = hd[1];
ended_how = text[0];
}
coming.count = 0;
}
return 1;
return took;
}
static int console_pending(void *self) { (void)self; return going_at < going.count; }
static const v4_device console = { console_take, console_give, 0, console_pending };
/* Is there a node that will execute at the next step? A step in which a
* node only faulted counts nothing done (exec.h), and it goes on from its
* fault handler at the next. */
/* Is there a node, other than those known to be going round for ever, that
* will execute at the next step? A node asleep at a wire will not; a step
* in which a node only faulted counts nothing done (exec.h), and it goes on
* from its fault handler at the next. */
static unsigned spinning; /* bit n: the node numbered n is known to be stuck in a loop, and is not waited for */
static int any_running(void)
{
unsigned k;
for (k = 0; k < PLACES; k++) {
const v4_fabric_node *x = v4_fabric_node_at(&f, k);
if (x && !places[k].asleep && !x->n.stopped && !x->n.asking && !(x->n.reading && !x->n.given)) return 1;
if (!x || places[k].asleep || x->n.stopped || x->n.asking || x->n.doing || (x->n.reading && !x->n.given)) continue;
if (x->n.mem[ME] >= 0 && x->n.mem[ME] < 32 && (spinning & 1u << x->n.mem[ME])) continue;
return 1;
}
return 0;
}
@@ -260,21 +259,31 @@ static void stuck(void)
unsigned k;
for (k = 0; k < PLACES; k++) {
const v4_fabric_node *x = v4_fabric_node_at(&f, k);
if (x) printf(" stuck: node %ld p=%ld asking=%d port=%u reading=%d rport=%u given=%d stopped=%d mq=%ld lost=%ld\n", (long)x->n.mem[ME], (long)x->n.p,
x->n.asking, x->n.ask_port, x->n.reading, x->n.read_port, x->n.given, x->n.stopped, (long)x->n.mem[MQ_COUNT], (long)x->n.mem[LOST]);
if (x) printf(" stuck: node %ld p=%ld asking=%d port=%u reading=%d doing=%d op=%ld wire=%u stopped=%d await=%ld lost=%ld\n", (long)x->n.mem[ME], (long)x->n.p,
x->n.asking, x->n.ask_port, x->n.reading, x->n.doing, (long)x->n.do_op, x->n.wire, x->n.stopped, (long)x->n.mem[AWAIT_FROM], (long)x->n.mem[LOST]);
}
}
/* Send text to a node and let everything that follows from it happen. */
/* Send text to a node and let everything that follows from it happen: until
* nothing can; or, with nodes known to be stuck, until no other node has
* executed and the console has been sent nothing for a while. */
static const char *tell(v4_cell node, const char *text)
{
unsigned long steps = 0;
static v4_message m;
unsigned long steps = 0, quiet = 0;
printed_len = 0; printed[0] = 0; printed_from = -1;
ended = 0; ended_from = -1; ended_how = -1;
if (!v4_message_text(&going, node, CONSOLE_ID, V4_MSG_TEXT, text, (unsigned)strlen(text))) return "(too long)";
going_at = 0;
while (steps < step_limit && (v4_fabric_step(&f) != 0 || any_running())) steps++;
if (steps >= step_limit) { stuck(); return "(still running)"; }
return printed;
if (!v4_message_text(&m, node, CONSOLE_ID, V4_MSG_TEXT, text, (unsigned)strlen(text))) return "(too long)";
if (v4_fabric_device_put(&f, hera_place, 1, m.word, m.word + V4_MSG_HEADER) != V4_WIRE_DONE) return "(not put)";
while (steps < step_limit) {
unsigned did = v4_fabric_step(&f), took = console_takes();
int run = any_running();
steps++;
if (did == 0 && took == 0 && !run) return printed;
quiet = (spinning && !run && took == 0) ? quiet + 1 : 0;
if (quiet >= 400000ul) return printed;
}
stuck();
return "(still running)";
}
static int told(v4_cell node, const char *text) { return tell(node, text)[0] == 0 && ended == 1 && ended_how == V4_TEXT_COMPLETED; }
@@ -314,7 +323,7 @@ static unsigned load(v4_cell node, const char *file)
while ((n = next_line(&r, line)) >= 0) {
line[n] = 0;
(void)tell(node, line);
if (ended != 1 || ended_how != V4_TEXT_COMPLETED) { if (!bad) { const v4_node *q = &pool[0].n; printf(" %s: \"%s\" -> \"%s\" ended=%d how=%ld; stopped=%d asking=%d port=%u reading=%d rport=%u p=%ld fault=%u@%ld\n", file, line, printed, ended, (long)ended_how, q->stopped, q->asking, q->ask_port, q->reading, q->read_port, (long)q->p, q->fault_kind, (long)q->fault_addr); } bad++; }
if (ended != 1 || ended_how != V4_TEXT_COMPLETED) { if (!bad) { const v4_node *q = &pool[0].n; printf(" %s: \"%s\" -> \"%s\" ended=%d how=%ld; stopped=%d asking=%d port=%u doing=%d op=%ld p=%ld fault=%u@%ld\n", file, line, printed, ended, (long)ended_how, q->stopped, q->asking, q->ask_port, q->doing, (long)q->do_op, (long)q->p, q->fault_kind, (long)q->fault_addr); } bad++; }
}
return bad;
}
@@ -331,10 +340,18 @@ static v4_uheat_t clock_of(v4_cell number)
for (k = 0; k < PLACES; k++) if (v4_fabric_node_at(&f, k) && v4_fabric_node_at(&f, k)->n.mem[ME] == number) return v4_fabric_node_at(&f, k)->es.anticlock;
return 0;
}
/* 1 if the node is asleep (operation 8): it executes nothing until a message comes. */
static int waiting(v4_cell number)
{
const v4_node *n = node_numbered(number);
return n && n->reading && !n->given && n->read_port == V4_PORT_ANY;
return n && n->doing && n->do_op == 8;
}
/* how many cells of messages wait on the wire going from a port of the node */
static unsigned going_from(v4_cell number, unsigned port)
{
unsigned k;
for (k = 0; k < PLACES; k++) if (v4_fabric_node_at(&f, k) && v4_fabric_node_at(&f, k)->n.mem[ME] == number && places[k].wire[port].tx) return places[k].wire[port].tx->used;
return 0;
}
int main(void)
@@ -381,18 +398,17 @@ int main(void)
/* ---- Hera is born empty, and takes in the nucleus ---- */
v4_fabric_init(&f, places, PLACES);
v4_fabric_queues(&f, queues, QUEUES);
v4_fabric_gone_error(&f, V4_ERROR_NO_ONE);
v4_fabric_interrupt_error(&f, V4_ERROR_INTERRUPTED);
place = host_born(0);
CHECK(place == 0, "a node is born");
hera_place = (unsigned)place;
for (i = 0; i < 4096 && pool[0].n.mem[i] == 0; i++) { }
CHECK(i == 4096 && pool[0].n.p == PORT + (v4_cell)V4_PORT_ANY, "with nothing in it, listening at its ports");
CHECK(v4_fabric_wire_device(&f, hera_place, 0, &kernel) && v4_fabric_wire_device(&f, hera_place, 1, &console), "the kernel is on its port 0 and the console on its port 1");
going.count = 0; going_at = 0;
for (i = 0; i < 400000 && v4_fabric_step(&f) != 0; i++) { }
CHECK(given_cells == f18_count && pool[0].n.reading && pool[0].n.read_port == V4_PORT_ANY && !pool[0].n.stopped,
"it takes in the nucleus through its port and waits for a message: %u of %u cells", given_cells, f18_count);
CHECK(given_cells == f18_count && pool[0].n.doing && pool[0].n.do_op == 8 && !pool[0].n.stopped,
"it takes in the nucleus through its port, a word at a time, and sleeps until a message comes: %u of %u cells", given_cells, f18_count);
CHECK(told(0, "10 (ME) ! 1 (CONSOLE) ! 1 1 ROUTE") && ended_from == 10, "it is told it is 10, and where the console is");
{
@@ -501,64 +517,78 @@ int main(void)
CHECK(strcmp(tell(10, "(LOST) @ ."), "0 ") == 0 && strcmp(tell(12, "(LOST) @ ."), "0 ") == 0, "and no message was let go");
CHECK(waiting(10) && waiting(11) && waiting(12) && waiting(13) && waiting(14), "all five are waiting at their ports again");
/* ---- Hera kills a node by number, and tells the others it is gone (MESH.md 7b) ---- */
/* a node is killed while its neighbour is writing to it */
step_limit = 3000000ul;
CHECK(strcmp(tell(14, ": SPIN BEGIN 0 UNTIL ; SPIN"), "(still running)") == 0, "node 14 is stuck in a loop that never ends");
CHECK(strcmp(tell(12, ": TO14 S\" 65 EMIT\" 14 SEND ; TO14"), "(still running)") == 0 && node_numbered(12)->asking,
"node 12, beside it, sends it text: 14 never reads, and 12 is blocked writing to it");
/* ---- Hera kills a node by number, and tells the others it is gone (MESH.md 7b, 7d) ----
* A node that is stuck holds up no one: what is sent to it waits on its wire until the wire is full, and
* is refused from then on; Hera can be typed to whatever any other node is doing, and her KILL of one
* stuck node is not held by another (acceptance 3 and 4). */
step_limit = 60000000ul;
spinning = 1u << 13 | 1u << 14;
(void)tell(14, ": SPIN BEGIN 0 UNTIL ; SPIN");
(void)tell(13, ": SPIN BEGIN 0 UNTIL ; SPIN");
CHECK(!waiting(14) && !waiting(13) && ended == 0, "nodes 13 and 14 are each stuck in a loop that never ends");
CHECK(tell(12, ": TO14 S\" 65 EMIT\" 14 SEND ; TO14")[0] == 0 && ended == 1 && ended_how == V4_TEXT_COMPLETED && waiting(12) && going_from(12, 3) == 9,
"node 12, beside 14, sends it text: the text waits on the wire, 14 never taking it, and node 12's line ends: \"%s\", %u cells", printed, going_from(12, 3));
{
v4_cell refused = node_numbered(12)->mem[REFUSED];
CHECK(strstr(tell(12, ": FILL14 200 0 DO S\" 65 EMIT\" 14 SEND LOOP ; FILL14"), "Message refused") != NULL && ended == 1 && ended_how == V4_TEXT_ERROR
&& node_numbered(12)->mem[REFUSED] == refused + 1 && going_from(12, 3) > V4_WIRE_CELLS - 9u,
"it sends more: when the wire is full the next is refused at once, and told: \"%s\", %u cells on the wire", printed, going_from(12, 3));
CHECK(strcmp(tell(12, "12 100 * ."), "1200 ") == 0 && waiting(12) && strcmp(tell(11, "11 100 * ."), "1100 ") == 0, "node 12 is not held, and goes on doing what it is sent; so does node 11");
}
CHECK(strcmp(tell(10, "1 2 + ."), "3 ") == 0, "Hera is typed to, with two nodes stuck");
{
unsigned born = born_count;
const char *r = tell(10, "14 KILL 65 EMIT");
CHECK(strstr(printed, "A") != NULL && node_numbered(14) == NULL && born_count == born, "Hera kills node 14, by its number: \"%s\"", r);
CHECK(strcmp(r, "A") == 0 && ended == 1 && ended_how == V4_TEXT_COMPLETED && node_numbered(14) == NULL && born_count == born,
"Hera kills node 14, by its number, with node 13 still stuck: the KILL ends, and the rest of her line is done: \"%s\"", r);
CHECK(going_from(10, 4) == 8 && node_numbered(13) != NULL && !waiting(13), "her word to node 13 that 14 is gone waits on the wire to it: it is stuck, and she did not wait for it: %u cells", going_from(10, 4));
}
CHECK(!node_numbered(12)->asking && !node_numbered(12)->stopped && waiting(12), "node 12 is no longer blocked: it is waiting at its ports");
CHECK(strstr(printed, "No one on that port") != NULL, "what it was doing ended in an error, which said so: \"%s\"", printed);
step_limit = 30000000ul;
CHECK(strcmp(tell(12, "12 100 * ."), "1200 ") == 0 && strcmp(tell(13, "13 100 * ."), "1300 ") == 0 && strcmp(tell(10, "1 2 + ."), "3 ") == 0, "and everything else keeps running: \"%s\"", printed);
spinning = 1u << 13;
CHECK(waiting(12) && waiting(11) && waiting(10), "every node that is not stuck is asleep again");
CHECK(strcmp(tell(12, "12 100 * ."), "1200 ") == 0 && strcmp(tell(11, "11 100 * ."), "1100 ") == 0 && strcmp(tell(10, "1 2 + ."), "3 ") == 0, "and everything else keeps running: \"%s\"", printed);
CHECK(strstr(tell(12, "5 3 PORT!"), "No one on that port") != NULL && waiting(12), "a write to the port node 14 was on is an error at once, not a wait: \"%s\"", printed);
{
v4_cell refused = node_numbered(12)->mem[REFUSED];
v4_cell refused = node_numbered(12)->mem[REFUSED], r11 = node_numbered(11)->mem[REFUSED];
CHECK(tell(12, ": AGAIN14 S\" 65 EMIT\" 14 SEND ; AGAIN14")[0] == 0 && node_numbered(12)->mem[REFUSED] == refused + 1 && waiting(12),
"every node was told 14 is gone and forgot the way: what node 12 sends it now goes toward Hera, who has no way either, and is refused: \"%s\"", printed);
"node 12 was told 14 is gone and forgot the way: what it sends it now goes toward Hera, who has no way either, and is refused: \"%s\"", printed);
CHECK(tell(11, ": AGAIN14 S\" 65 EMIT\" 14 SEND ; AGAIN14")[0] == 0 && node_numbered(11)->mem[REFUSED] == r11 + 1 && waiting(11), "and so was node 11");
CHECK(strstr(tell(10, ": H14 S\" 1\" 14 SEND ; H14"), "Argument out of range") != NULL, "Hera herself has no way to it");
}
/* a node waits on one that is stuck and is not its neighbour; Hera kills the stuck one */
step_limit = 3000000ul;
CHECK(strcmp(tell(13, ": SPIN BEGIN 0 UNTIL ; SPIN"), "(still running)") == 0, "node 13 is stuck in a loop");
CHECK(strcmp(tell(12, ": W13 13 AWAIT . ; W13"), "(still running)") == 0 && node_numbered(12)->mem[AWAIT_FROM] == 13 && waiting(12),
"node 12, which is not wired to it, waits for its answer");
(void)tell(12, ": W13 13 AWAIT . ; W13");
CHECK(ended == 0 && node_numbered(12)->mem[AWAIT_FROM] == 13 && waiting(12), "node 12, which is not wired to node 13, waits for its answer, asleep");
(void)tell(10, "13 KILL");
CHECK(node_numbered(13) == NULL && strstr(printed, "Node gone") != NULL && node_numbered(12)->mem[AWAIT_FROM] == 0 && waiting(12),
"Hera kills node 13: node 12's wait ends, with an error that says the node is gone: \"%s\"", printed);
step_limit = 30000000ul;
spinning = 0;
CHECK(strcmp(tell(12, "12 100 * ."), "1200 ") == 0 && strcmp(tell(11, "11 100 * ."), "1100 ") == 0, "and the others go on");
/* Hera's own wait, on a node that is stuck: a line from the console ends it */
step_limit = 3000000ul;
CHECK(strcmp(tell(12, ": SPIN BEGIN 0 UNTIL ; SPIN"), "(still running)") == 0, "node 12 is stuck in a loop");
CHECK(strcmp(tell(10, "12 AWAIT ."), "(still running)") == 0 && node_numbered(10)->mem[AWAIT_FROM] == 12 && waiting(10), "Hera waits for its answer, which will not come");
spinning = 1u << 12;
(void)tell(12, ": SPIN BEGIN 0 UNTIL ; SPIN");
(void)tell(10, "12 AWAIT .");
CHECK(ended == 0 && !waiting(12) && node_numbered(10)->mem[AWAIT_FROM] == 12 && waiting(10), "node 12 is stuck in a loop; Hera waits for its answer, which will not come");
{
const char *r = tell(10, "12 KILL 66 EMIT");
CHECK(strstr(r, "Interrupted\n") != NULL && strstr(r, "B") != NULL && strstr(r, "Interrupted\n") < strstr(r, "B") && ended == 2,
"a line typed at the console ends her wait, with an error that says so, and is then done: \"%s\"", r);
CHECK(node_numbered(12) == NULL && node_numbered(10)->mem[AWAIT_FROM] == 0, "the line killed the stuck node");
}
step_limit = 30000000ul;
spinning = 0;
/* Hera blocked writing to a node that is stuck: a line from the console lets her go (MESH.md 7b.7) */
step_limit = 3000000ul;
CHECK(strcmp(tell(11, ": SPIN BEGIN 0 UNTIL ; SPIN"), "(still running)") == 0, "node 11 is stuck in a loop");
CHECK(strcmp(tell(10, ": T11 S\" 1 DROP\" 11 SEND 67 EMIT ; T11"), "(still running)") == 0 && node_numbered(10)->asking,
"Hera sends it text: its number is the higher, so she writes without looking, and is blocked");
/* Hera sends to a node that is stuck: her line ends, and when the wire is full she is refused; she is never held */
spinning = 1u << 11;
(void)tell(11, ": SPIN BEGIN 0 UNTIL ; SPIN");
CHECK(strcmp(tell(10, ": T11 S\" 1 DROP\" 11 SEND 67 EMIT ; T11"), "C") == 0 && ended == 1 && !waiting(11) && waiting(10),
"node 11 is stuck in a loop; Hera sends it text, which waits on the wire, and the rest of her line is done: \"%s\"", printed);
CHECK(strstr(tell(10, ": F11 200 0 DO S\" 1 DROP\" 11 SEND LOOP 67 EMIT ; F11"), "Message refused") != NULL && strstr(printed, "C") == NULL && ended_how == V4_TEXT_ERROR && waiting(10),
"she sends more than the wire holds: the one there is no room for is refused at once, and her line ends there: \"%s\"", printed);
{
const char *r = tell(10, "11 KILL 68 EMIT");
CHECK(strstr(r, "Interrupted\n") != NULL && strstr(r, "D") != NULL && strstr(r, "C") == NULL && strstr(r, "Interrupted\n") < strstr(r, "D"),
"a line typed at the console ends the line that was blocked, with an error that says so, and is then done: \"%s\"", r);
CHECK(node_numbered(11) == NULL && !node_numbered(10)->asking && waiting(10), "the line killed the stuck node, and Hera is back at her ports");
CHECK(strcmp(r, "D") == 0 && node_numbered(11) == NULL && waiting(10), "she is typed to, and kills the stuck node: \"%s\"", r);
}
spinning = 0;
CHECK(strcmp(tell(10, "1 2 + ."), "3 ") == 0, "and she goes on");
step_limit = 30000000ul;
v4/tools/depthsweep.py
+4
View File
@@ -65,6 +65,8 @@ for k in [0, 1, shallow] + list(range(ddepth - 10, ddepth + 3)):
check('SEND with no way', k, [': SD S" 1 DROP" 5 SEND ;'] + v + ['SD', '77 .'], 'Argument out of range' if sh else None)
check('a write to an empty port', k, v + ['5 7 PORT!', '77 .'], 'No one on that port' if sh else None)
check('an unknown word', k, v + ['NOSUCHWORD', '77 .'], 'UNKNOWN WORD' if sh else None)
check('a loop that prints 400 numbers', k, [': PR 400 0 DO I . LOOP ;'] + v + ['PR', '77 .'], ' 398 399 ok' if sh else None)
check('SEND by a way with no one on the port', k, ['5 7 ROUTE', ': SP S" 1 DROP" 5 SEND ;'] + v + ['SP', '77 .'], 'No one on that port' if sh else None)
def nest(n, inner):
return [': N1 %s ;' % inner] + [': N%d N%d ;' % (i, i - 1) for i in range(2, n + 1)] + ['N%d' % n]
@@ -76,6 +78,8 @@ for n in [1, rshallow] + list(range(rdepth - 12, rdepth + 3)):
check('WORDS, calls deep', n, nest(n, 'WORDS') + ['77 .'], '77 ok')
check('a line typed during AWAIT, calls deep', n, nest(n, '5 AWAIT') + ['77 .', '88 .'], '77 ok')
check('SEND with no way, calls deep', n, nest(n, 'S" 1 DROP" 5 SEND') + ['77 .'], '77 ok')
check('a loop that prints 400 numbers, calls deep', n, nest(n, '400 0 DO I . LOOP') + ['77 .'], '77 ok')
check('SEND by a way with no one on the port, calls deep', n, ['5 7 ROUTE'] + nest(n, 'S" 1 DROP" 5 SEND') + ['77 .'], '77 ok')
with ThreadPoolExecutor(max_workers=8) as pool:
found = [f for f in pool.map(judge, cases) if f]