rajamesandClaude Opus 5.5
66b26f823c
The final review of step 6e, by a fresh reviewer told to break it, and what was ruled: fix them all, test first. Each has a test that failed before the mend. - Two texts from one node could be begun in the wrong order when room for their answers came between the node's look at the first and at the second. Texts whose answers go by the same port are begun in the order they came: (D-MASK), quit.v4. 102 of 700 timings were wrong before. - A word written with PORT! to a node that speaks whole messages, or to a console's port, blocked its writer for ever and cut off every node beyond it. It is error 18 now, whether that node is asleep, running or stuck: fabric.c, node.c. - A node asleep for room on one wire is woken when another of its wires is cut. - A line there was no room for on the lone node's wire was reported as a fault and ended the hosted program. It is Message refused, and the prompt comes back: V4_BOOT_LINE_REFUSED. hosted-check has the case; no bare-metal boot has typed it. - Ruled: text behind held output for the same port is refused though it would fit. MESH.md 7d.4 said otherwise and is corrected. - The removal test also cuts and re-makes a wire, and has an exchange in which output is held at a full wire: 26,814 disturbances in all. - MESH.md and v4/README.md no longer say that a stuck node holds up no other node, that only printing waits, or that no node is left waiting on one that is gone; 7d.6 lists the limits and what the products do that they did not before. make -C v4 test and sanitize at both widths, hosted-check, lint. Three bare-metal boots: logs/20261013-194827 (amd64), -195131 (aarch64), -195518 (riscv64). POST 538 of 538, word_count=317, dict_hash=0xe5a57f3eb72ff94a on all six; the three sessions are the same character for character. The boots were built with the working tree's uncommitted change to kernel/Makefile that adds the ISA to the kernel's version line. Co-Authored-By: Claude Opus 5.5 <noreply@anthropic.com>
586 lines
30 KiB
Plaintext
586 lines
30 KiB
Plaintext
\ quit.v4 -- a line of text, interpreted; how it ends; and the words that
|
|
\ print text written in the source.
|
|
\
|
|
\ DECOMPOSITION.md 5.15 and 5.10: QUIT ABORT ABORT" (ABORT") ." (."). Part of
|
|
\ 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 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
|
|
\ What a console then shows is v3's:
|
|
\ ok> 65 EMIT the console's prompt, and the line
|
|
\ A ok what the line printed, then " ok"
|
|
\ ok> NOSUCH
|
|
\ UNKNOWN WORD: 'NOSUCH'
|
|
\ ERROR
|
|
\ ok> -1 @
|
|
\ Address out of range an address fault (D-14), from any depth
|
|
\ ERROR
|
|
\ KEY, EXPECT and QUERY are FORTH-79 words that read characters, as before;
|
|
\ they are not how text reaches the node. They still read the console's
|
|
\ registers, CONSOLE-RX and CONSOLE-STATUS, and not a message.
|
|
\
|
|
\ THE STACKS are guarded (D-16): each counts what it holds, and a push onto
|
|
\ a full one or a pop from an empty one is a fault. So QUIT and ABORT, which
|
|
\ never return to whatever ran them, must empty the return stack, and ABORT
|
|
\ the data stack too. A store to RSTACK-DEPTH or DSTACK-DEPTH does that.
|
|
\
|
|
\ 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
|
|
\ (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
|
|
|
|
\ ( -- ) empty the return stack. `a` is only something to store: any
|
|
\ store to the register empties the stack, and `a` needs nothing to be on
|
|
\ the data stack. One cell of the data stack is used for a moment.
|
|
macro R-CLEAR RSTACK-DEPTH b! a !b endmacro
|
|
|
|
\ ( -- ) stop compiling; forget the word being built and any open control
|
|
\ structures. A definition that was under way stays hidden.
|
|
: (RESET) 0 STATE a! ! (CG-RESET) CFBASE (CFP) a! ! ;
|
|
|
|
\ ( s -- ) the text is done with. What it printed is sent, then a message
|
|
\ saying how it ended -- 0 QUIT, 1 completed, 2 an error -- and the node waits
|
|
\ for the next. (DONE) is entered with the same number and, for an error,
|
|
\ stops compiling first; it is always jumped to, never called, by
|
|
\ something that has emptied the return stack (or by a fault, which empties
|
|
\ it). (LINE-STATUS) keeps how the last text ended, 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 nothing is this text's doing
|
|
(LINE-STATUS) b! !b
|
|
0 0 0 0 drop drop drop drop
|
|
(FLUSH-OUT)
|
|
-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
|
|
drop (RESET) 2 jump (FINISH)
|
|
OK: drop 1 jump (FINISH)
|
|
GO: drop 0 jump (FINISH)
|
|
|
|
\ ( -- flag ) A GONE has been taken: its seven words are in (IN), the
|
|
\ node it is about in (ONE), and (S-WIRE) is the wire it came by. It is
|
|
\ believed only if it came by the port that leads to this node's centre
|
|
\ and says it is from the centre (MESH.md 7b.4): the way to the node is
|
|
\ then forgotten, and the flag is -1. Otherwise nothing is done, and 0.
|
|
\ (As first built only what it said it was from was looked at, and one
|
|
\ that came by another port was believed.)
|
|
: (GONE?)
|
|
(CENTRE) if NOT (IN)+1 a! @ xor if FROM drop 0 ;
|
|
NOT: ;
|
|
FROM: drop (ROUTE-DEFAULT) a! @ (PORT) - (S-WIRE) a! @ xor if YES drop 0 ;
|
|
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; with none known, or no one on
|
|
\ that port, 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: there may be several such, on wires
|
|
\ whose answers go different ways, and each is begun when
|
|
\ its own has the room. That room is kept from then until
|
|
\ the answer has gone.
|
|
\ TEXTS WHOSE ANSWERS GO THE SAME WAY ARE BEGUN IN THE ORDER
|
|
\ THEY CAME. Once one has been left for want of room, every
|
|
\ text behind it on this pass whose answer goes by that port
|
|
\ is left too, though the room has come since: (D-MASK) has
|
|
\ a bit for each such port. (As first built only the room
|
|
\ was asked, each time; room that came between the look at
|
|
\ one text and at the next began the second first. Found
|
|
\ by the final review of step 6e.)
|
|
\ a NACK is taken and counted in (REFUSED)
|
|
\ a GONE is taken, and believed if this node's centre sent it
|
|
\ an answer no one is waiting for is dropped: a SEND that is not waited
|
|
\ on is ordinary use, and its answer is not a loss.
|
|
\ any other is dropped, and counted in (LOST): what a node printed
|
|
\ that came here, a type there is none of, or a NACK or GONE
|
|
\ that is not as long as one is. (LOST) counts what should
|
|
\ have been delivered or acted on and was not.
|
|
\ A TAKE THAT DOES NOT TAKE -- the wire was cut after the message was
|
|
\ looked at -- leaves nothing to act on: no text is done and nothing is
|
|
\ believed for it, (UNTAKEN). The same for a drop that does not drop.
|
|
\ With nothing to begin it sleeps, executing nothing, until a message
|
|
\ comes; or, if text is waiting for room for its answer, or (SERVE) left a
|
|
\ message for want of room, until there is room on any wire that leads
|
|
\ from it 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)
|
|
-1 (KEEP) a! ! 0 (AWAIT-FROM) a! ! -1 (DEFER) a! ! 0 (D-MASK) a! !
|
|
(SERVE) (MINE0)
|
|
M: (MINE) if REST
|
|
drop (IN)+2 a! @ -1 + if TEXT -3 + if NACK -1 + if GONE
|
|
OTHER: drop 4 (DO) if LETGO drop (SKIP) jump M \ it was not there to drop: nothing is counted
|
|
LETGO: drop (IN)+2 a! @ -3 + if ANSWER \ let go. An answer no one waits for is ordinary:
|
|
drop (LOST) a! @ 1 + ! jump M \ anything else should not have come here, and is counted
|
|
ANSWER: drop jump M
|
|
NACK: drop (IN)+6 a! @ -4 + if N1 jump OTHER
|
|
N1: drop (TAKE1) if N2 drop (UNTAKEN) jump M \ not taken: nothing is done for it
|
|
N2: drop (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) if G2 drop (UNTAKEN) jump M
|
|
G2: drop (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! !
|
|
(DONE-PORT) a! @ (WBIT) (D-MASK) a! @ and if FREE1 jump FULL \ text ahead of it waits for room on that wire
|
|
FREE1: drop
|
|
8 (DONE-PORT) a! @ (ROOM?) if START -1 + if FULL
|
|
drop (S-WIRE) a! @ (DONE-PORT) a! ! \ no one is on that port: back by the wire it came on,
|
|
(S-WIRE) a! @ (WBIT) (D-MASK) a! @ and if FREE2 jump FULL
|
|
FREE2: drop
|
|
8 (S-WIRE) a! @ (ROOM?) -1 + if FULL jump START \ if that has the room -- or has no one on it either
|
|
FULL: drop (DONE-PORT) a! @ (WBIT) dup inv (D-MASK) a! @ and + !
|
|
(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 (SLEEP) jump L
|
|
ROOM: (WIRE!) 8 (WIRE-A) b! !b 9 (DO) drop jump L
|
|
START: drop
|
|
(S-WIRE) a! @ dup (REPLY) a! ! (WIRE!)
|
|
(MSG) (WIRE-A) b! !b TIB 2/ 2/ (WIRE-B) b! !b 2 (DO) \ its seven words, and its text
|
|
if TAKEN drop (UNTAKEN) jump M \ not taken: the wire was cut since it was looked at
|
|
TAKEN: drop
|
|
0 (MSG)+6 a! @ TIB + C! \ a zero after the text
|
|
(MSG)+6 a! @ SPAN 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;
|
|
P1: dup (PRINT-TO) a! !
|
|
(WAY) -if Q1 drop (REPLY) a! @ \ by the way there, or the wire the text came on
|
|
Q1: (PRINT-PORT) a! !
|
|
jump (LINE)
|
|
|
|
\ ( -- ) 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
|
|
\ data stack stays there.
|
|
: (LINE)
|
|
0 (QUIET) a! ! \ an error from here on is this text's
|
|
0 BLK a! ! \ the terminal, whatever was being loaded
|
|
TIB (SRC) a! ! 0 >IN a! !
|
|
0 NODE-ERROR b! !b
|
|
INTERPRET
|
|
NODE-ERROR b! @b if GOOD
|
|
drop 2 jump (DONE)
|
|
GOOD: drop 1 jump (DONE)
|
|
|
|
\ ---- the node among others (MESH.md sections 6 and 7) ---------------------------
|
|
\ Not FORTH-79 and not in v3: v3's VMs are sent to through the kernel.
|
|
|
|
\ ( node port -- ) the port, by its number, leads toward that node
|
|
header ROUTE
|
|
: ROUTE
|
|
(ROUTE#) a! @ -16 + if FULL drop
|
|
(PORT) + (ROUTE#) a! @ 2* (ROUTES) + a!
|
|
push !+ pop !+
|
|
(ROUTE#) a! @ 1 + ! ;
|
|
FULL: drop drop drop NODE-ERROR b! 12 !b ;
|
|
|
|
\ ( node port -- ) the node on the other end of the port, by its number;
|
|
\ 0: none, or a device. Whoever wires the node tells it, and tells it again
|
|
\ when the wiring changes. It is how a node knows who its centre is, the
|
|
\ one node whose GONE it believes: (CENTRE).
|
|
header NEIGHBOUR
|
|
: NEIGHBOUR
|
|
dup -if POS jump BAD
|
|
POS: -PORTS + -if BAD drop (NEAR) + a! ! ;
|
|
BAD: drop drop drop NODE-ERROR b! 12 !b ;
|
|
|
|
\ ( port -- ) the port, by its number, leads toward every node not told of
|
|
header DEFAULT-ROUTE
|
|
: DEFAULT-ROUTE (PORT) + (ROUTE-DEFAULT) a! ! ;
|
|
|
|
\ ( node -- ) forget the way to that node, if one is known: what is for it
|
|
\ then goes by the way for every node not told of, if there is one. The
|
|
\ last way in the table takes its place.
|
|
header NO-ROUTE
|
|
: NO-ROUTE
|
|
(ROUTE#) a! @ if NONE -1 + (ROUTES) a!
|
|
FOR dup @+ xor if HIT drop @+ drop NEXT
|
|
drop ;
|
|
NONE: drop drop ;
|
|
HIT: drop drop pop drop
|
|
a -1 + push \ where its entry is
|
|
(ROUTE#) a! @ -1 + dup ! \ one way fewer
|
|
2* (ROUTES) + a! @+ @ \ the last entry: node port
|
|
pop a! SWAP !+ ! ;
|
|
|
|
\ ( about node type -- ) send the node a message of one word, `about`:
|
|
\ 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 (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
|
|
\ for n's answer the wait ends.
|
|
header GONE
|
|
: GONE 5 jump (SEND1)
|
|
|
|
\ ( -- ) forget every way: for when the wiring has changed
|
|
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 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. What lies after the text in
|
|
\ this node's memory does not go with it: the last word is made zero past
|
|
\ the last character.
|
|
: (SEND-ON)
|
|
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* +
|
|
(SEND^) b! @b a! !+ a !b 4 + NEXT
|
|
drop
|
|
(OUT-HDR)+6 a! @ 3 and if PUT \ the last word: nothing in it past the last character
|
|
(SEND^) b! @b -1 + a!
|
|
-1 + if M1 -1 + if M2
|
|
drop @ 16777215 and ! jump PUT0
|
|
M2: drop @ 65535 and ! jump PUT0
|
|
M1: drop @ 255 and ! jump PUT0
|
|
NONE: drop
|
|
PUT: drop
|
|
PUT0: (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 (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
|
|
\ its own yet, to which text is sent as to node 0.
|
|
header SEND-ON
|
|
: SEND-ON
|
|
dup -if POS jump BAD
|
|
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
|
|
\ leads to everything it has no other way to. 0: it has none, or has not
|
|
\ been told who is there (NEIGHBOUR).
|
|
: (CENTRE)
|
|
(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! @ ;
|
|
|
|
\ ( 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 (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. (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
|
|
(ONE) a! ! (ROOM) \ if this faults, no one is waited for:
|
|
(ONE) a! @ (AWAIT-FROM) a! ! 0 (A-SELF) a! ! \ (AWAIT-FROM) is set only when the stack has been tried
|
|
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) if A3 drop (UNTAKEN) jump M \ not taken: nothing is done for it
|
|
A3: drop 1 jump (A-END)
|
|
NACK: drop (IN)+6 a! @ -4 + if N1 jump KEEP
|
|
N1: drop (TAKE1) if N0 drop (UNTAKEN) jump M
|
|
N0: drop (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) if G0 drop (UNTAKEN) jump M
|
|
G0: drop (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 (SLEEP) 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
|
|
\ code (docs/v4.0.0/MESH.md section 5): the cells go as they are, not as a
|
|
\ message, to a node that is executing from its ports.
|
|
header PORT!
|
|
: PORT!
|
|
dup -if POS jump BAD
|
|
POS: -PORTS + -if BAD drop (PORT) + b! !b ;
|
|
BAD: drop drop drop NODE-ERROR b! 12 !b ;
|
|
|
|
\ ( -- ) WHAT IS IN THE DICTIONARY NOW IS THE SYSTEM: COLD comes back to
|
|
\ it and FORGET will not go below it. Whoever has loaded a node's capsules
|
|
\ has it do this (system.v4, (BOOT) and FENCE).
|
|
header (SEAL)
|
|
: (SEAL)
|
|
DP a! @ (BOOT) a! !
|
|
(LATEST) a! @ (BOOT)+1 a! !
|
|
DP a! @ 3 + 2/ 2/ FENCE a! ! ;
|
|
|
|
\ FORTH-79: clear the return stack, set execution mode, return control to
|
|
\ the terminal; no message is given. The data stack is left as it is.
|
|
\ NODE-ERROR, by name: how a definition written in FORTH raises an error.
|
|
\ A store of a code that is not zero is the trap of D-18 -- the word goes no
|
|
\ further, the message for the code is printed (-1: the word has printed
|
|
\ its own) and the line ends with ERROR. The codes are listed in core.v4.
|
|
header NODE-ERROR inline : NODE-ERROR' NODE-ERROR ;
|
|
header (ME) inline : (ME)' (ME) ;
|
|
header (CONSOLE) inline : (CONSOLE)' (CONSOLE) ;
|
|
header (LOST) inline : (LOST)' (LOST) ;
|
|
header (REFUSED) inline : (REFUSED)' (REFUSED) ;
|
|
header (WORD-DEFINED) inline : (WORD-DEFINED)' (WORD-DEFINED) ;
|
|
header (WORD-FORGOTTEN) inline : (WORD-FORGOTTEN)' (WORD-FORGOTTEN) ;
|
|
|
|
header QUIT
|
|
: QUIT R-CLEAR (RESET) CR 0 jump (DONE)
|
|
|
|
\ FORTH-79: clear the data and return stacks, set execution mode, return
|
|
\ control to the terminal. As v3, the line it stops ends with " ok".
|
|
\ Both are emptied before anything is called: ABORT may be run with the
|
|
\ return stack full.
|
|
header ABORT
|
|
: ABORT R-CLEAR DSTACK-DEPTH b! a !b (RESET) 1 jump (DONE)
|
|
|
|
\ ---- faults (D-14, D-16) -------------------------------------------------------
|
|
\ Where the node goes when a programme uses an address outside its memory,
|
|
\ pushes onto a full stack or pops an empty one. The opcode that faulted did
|
|
\ nothing, and both stacks have been emptied. Each handler says what happened;
|
|
\ whatever was running is abandoned, as by ABORT, and the line ends with
|
|
\ ERROR.
|
|
: (FAULT) \ "Address out of range"
|
|
$72646441 (EMIT4) $20737365 (EMIT4) $2074756F (EMIT4) $7220666F (EMIT4) $65676E61 (EMIT4) CR
|
|
2 jump (DONE)
|
|
: (D-OVER) \ "Stack overflow"
|
|
$63617453 (EMIT4) $766F206B (EMIT4) $6C667265 (EMIT4) $776F (EMIT4) CR
|
|
2 jump (DONE)
|
|
: (D-UNDER) \ "Stack underflow"
|
|
$63617453 (EMIT4) $6E75206B (EMIT4) $66726564 (EMIT4) $776F6C (EMIT4) CR
|
|
2 jump (DONE)
|
|
: (R-OVER) \ "Return stack overflow"
|
|
$75746552 (EMIT4) $73206E72 (EMIT4) $6B636174 (EMIT4) $65766F20 (EMIT4) $6F6C6672 (EMIT4) $77 (EMIT4) CR
|
|
2 jump (DONE)
|
|
: (R-UNDER) \ "Return stack underflow"
|
|
$75746552 (EMIT4) $73206E72 (EMIT4) $6B636174 (EMIT4) $646E7520 (EMIT4) $6C667265 (EMIT4) $776F (EMIT4) CR
|
|
2 jump (DONE)
|
|
|
|
\ A word has stored an error code in NODE-ERROR (D-18; the codes are listed
|
|
\ in core.v4). Print its message -- a negative code means the word printed
|
|
\ 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:
|
|
\ 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)
|
|
SPEAK: drop
|
|
NODE-ERROR b! @b
|
|
-if POS drop 2 jump (DONE)
|
|
POS: -1 + if M1 -1 + if M2 -1 + if M3 -1 + if M4
|
|
-1 + if M5 -1 + if M6 -1 + if M7 -1 + if M8 -1 + if M9
|
|
-1 + if M10 -1 + if M11 -1 + if M12 -1 + if M13 -1 + if M14
|
|
-1 + if M15 -1 + if M16 -1 + if M17 -1 + if M18
|
|
-1 + if M19 -1 + if M20 -1 + if M21
|
|
drop 2 jump (DONE)
|
|
M1: drop $6167654E (EMIT4) $65766974 (EMIT4) $756F6320 (EMIT4) $746E (EMIT4) CR 2 jump (DONE)
|
|
M2: drop $20746F4E (EMIT4) $756E2061 (EMIT4) $7265626D (EMIT4) CR 2 jump (DONE)
|
|
M3: drop $626D754E (EMIT4) $74207265 (EMIT4) $6C206F6F (EMIT4) $676E6F (EMIT4) CR 2 jump (DONE)
|
|
M4: drop $20746F4E (EMIT4) $68632061 (EMIT4) $63617261 (EMIT4) $726574 (EMIT4) CR 2 jump (DONE)
|
|
M5: drop $74636944 (EMIT4) $616E6F69 (EMIT4) $66207972 (EMIT4) $6C6C75 (EMIT4) CR 2 jump (DONE)
|
|
M6: drop $656D614E (EMIT4) $73696D20 (EMIT4) $676E6973 (EMIT4) CR 2 jump (DONE)
|
|
M7: drop $746E6F43 (EMIT4) $206C6F72 (EMIT4) $75727473 (EMIT4) $72757463 (EMIT4) $696D2065 (EMIT4) $74616D73 (EMIT4) $6863 (EMIT4) CR 2 jump (DONE)
|
|
M8: drop $746E6F43 (EMIT4) $206C6F72 (EMIT4) $75727473 (EMIT4) $72757463 (EMIT4) $74207365 (EMIT4) $64206F6F (EMIT4) $706565 (EMIT4) CR 2 jump (DONE)
|
|
M9: drop $66696853 (EMIT4) $6F632074 (EMIT4) $20746E75 (EMIT4) $2074756F (EMIT4) $7220666F (EMIT4) $65676E61 (EMIT4) CR 2 jump (DONE)
|
|
M10: drop $746F7250 (EMIT4) $65746365 (EMIT4) $6F772064 (EMIT4) $6472 (EMIT4) CR 2 jump (DONE)
|
|
M11: drop $69766944 (EMIT4) $6E6F6973 (EMIT4) $20796220 (EMIT4) $6F72657A (EMIT4) CR 2 jump (DONE)
|
|
M12: drop $75677241 (EMIT4) $746E656D (EMIT4) $74756F20 (EMIT4) $20666F20 (EMIT4) $676E6172 (EMIT4) $65 (EMIT4) CR 2 jump (DONE)
|
|
M13: drop $636F6C42 (EMIT4) $756F206B (EMIT4) $666F2074 (EMIT4) $6E617220 (EMIT4) $6567 (EMIT4) CR 2 jump (DONE)
|
|
M14: drop $62206F4E (EMIT4) $6B636F6C (EMIT4) $20736920 (EMIT4) $6E696562 (EMIT4) $6F6C2067 (EMIT4) $64656461 (EMIT4) CR 2 jump (DONE)
|
|
M15: drop $65666544 (EMIT4) $64657272 (EMIT4) $726F7720 (EMIT4) $6F6E2064 (EMIT4) $65732074 (EMIT4) $74 (EMIT4) CR 2 jump (DONE)
|
|
M16: drop $20746F4E (EMIT4) $6F772061 (EMIT4) $6472 (EMIT4) CR 2 jump (DONE)
|
|
M17: drop $726F7453 (EMIT4) $20656761 (EMIT4) $75666572 (EMIT4) $646573 (EMIT4) CR 2 jump (DONE)
|
|
M18: drop (OUT) (OUT^) a! ! \ what was printed and not sent cannot be sent: it is let go
|
|
$6F206F4E (EMIT4) $6F20656E (EMIT4) $6874206E (EMIT4) $70207461 (EMIT4) $74726F (EMIT4) CR 2 jump (DONE)
|
|
M19: drop $7373654D (EMIT4) $20656761 (EMIT4) $75666572 (EMIT4) $646573 (EMIT4) CR 2 jump (DONE)
|
|
M20: drop $65646F4E (EMIT4) $6E6F6720 (EMIT4) $65 (EMIT4) CR 2 jump (DONE)
|
|
M21: drop $65746E49 (EMIT4) $70757272 (EMIT4) $646574 (EMIT4) CR 2 jump (DONE)
|
|
|
|
\ The table the loader gives the node: six words, one for each kind of
|
|
\ fault in the node's order, each a jump. A jump fills its word, so they
|
|
\ are one after another.
|
|
: (FAULTS)
|
|
jump (FAULT) jump (D-OVER) jump (D-UNDER) jump (R-OVER) jump (R-UNDER) jump (RAISED)
|
|
|
|
\ ---- text in the source ---------------------------------------------------------
|
|
\ The three run-time words have names, as v3's have, so that SEE can tell a
|
|
\ string in a definition from code; they cannot be used from the prompt.
|
|
\ ." and ABORT" take the text up to the next " , which may be none at all
|
|
\ (input.v4's (PARSE)); with no closing " it is the rest of the line. Inside a definition they lay
|
|
\ down a call to their run-time word and, after it, the text as a counted
|
|
\ string: the count byte and the characters, four to a cell, the last cell
|
|
\ filled with zeros. The run-time word finds the string by the return
|
|
\ address the call left, and returns to the cell after the string.
|
|
|
|
\ ( -- ) lay the counted string in WBUF into the dictionary, as above.
|
|
\ (Q)+0 how many bytes are still to go, (Q)+1 which is next.
|
|
: (STRING,)
|
|
(FLUSH)
|
|
WBUF C@ 1 + (Q) a! ! 0 (Q)+1 a! !
|
|
L: (Q) a! @ if DONE -1 + !
|
|
(Q)+1 a! @ dup 1 + ! WBUF + C@ C,
|
|
jump L
|
|
DONE: drop
|
|
P: DP b! @b 3 and if ALIGNED drop 0 C, jump P
|
|
ALIGNED: drop ;
|
|
|
|
\ The run time of ." : print the string after the call, go on after it.
|
|
\ It takes the return address off before it calls anything and keeps the
|
|
\ count there instead, so a word that prints text goes no deeper than one
|
|
\ that calls any other word.
|
|
header (.") compile-only
|
|
: (.")
|
|
pop 4* dup C@ \ baddr n
|
|
L: if DONE
|
|
push 1 + dup C@ EMIT pop -1 + jump L
|
|
DONE: drop 4/ 1 + push ; \ the cell after the last character
|
|
|
|
\ FORTH-79: ." text" prints the text -- now, if interpreting; when the word
|
|
\ it is compiled into runs, if compiling.
|
|
header ." immediate
|
|
: DOT-QUOTE
|
|
34 (PARSE) drop
|
|
STATE a! @ if NOW
|
|
drop &(.") (CALL,) jump (STRING,)
|
|
NOW: drop WBUF COUNT jump TYPE
|
|
|
|
\ ( flag -- ) the run time of ABORT" : if the flag is not zero print the
|
|
\ string after the call, start a new line and ABORT; otherwise go on after
|
|
\ the string.
|
|
header (ABORT") compile-only
|
|
: (ABORT")
|
|
if NO
|
|
drop pop 4* R-CLEAR COUNT TYPE CR jump ABORT
|
|
NO: drop pop 4* dup C@ + 4/ 1 + push ;
|
|
|
|
\ ( flag -- ) ABORT" text" as v3 (it is FORTH-83's, not FORTH-79's): if
|
|
\ the flag is not zero, print the text and ABORT.
|
|
header ABORT" immediate
|
|
: ABORT-QUOTE
|
|
34 (PARSE) drop
|
|
STATE a! @ if NOW
|
|
drop &(ABORT") (CALL,) jump (STRING,)
|
|
NOW: drop if NO
|
|
drop WBUF COUNT TYPE CR jump ABORT
|
|
NO: drop ;
|
|
|
|
\ The run time of S" : leave the address and length of the string after the
|
|
\ call, and go on after it.
|
|
header (S") compile-only
|
|
: (S")
|
|
pop 4* dup C@ \ baddr n
|
|
over over + 4/ 1 + push \ the cell after the last character
|
|
push 1 + pop ; \ baddr+1 n
|
|
|
|
\ ( -- baddr u ) S" text" as v3. In a definition the text is compiled
|
|
\ into it. At the prompt it is copied to PAD, where it stays until PAD is
|
|
\ used again: WORD's buffer is overwritten by the very next word of the line.
|
|
header S" immediate
|
|
: S-QUOTE
|
|
34 (PARSE) drop
|
|
STATE a! @ if NOW
|
|
drop &(S") (CALL,) jump (STRING,)
|
|
NOW: drop WBUF+1 PAD WBUF C@ CMOVE PAD WBUF jump C@
|