rajamesandClaude Opus 5.5
f1419e739c
- Engine: a wire keeps whether the message at its mark is the one last looked at; a node's take, move and drop of any other answer 3 and write nothing (MESH.md 7d.3). A wire cut and made again between a look and a take no longer has a NACK done as text, or 256 cells written where one was looked for. - Engine: v4_fabric_wire_kernel wires a kernel to a port with no queues; a message for it is refused at once, error 18, on a mesh as on the products. - The result of a drop is looked at; a take that does not take has the message dropped, or gone past: nothing goes round. - An answer nobody waits for is let go uncounted; (LOST) counts what should have been delivered or acted on and was not. The flood's account is exact. - Error 18 from under a word that was printing empties the data stack, as a fault does: that word's own values are not left there. - Tests: the take and drop windows cut at every step, with and without another message put; a refusal owed to a stuck node whose wire is full. Co-Authored-By: Claude Opus 5.5 <noreply@anthropic.com>
573 lines
29 KiB
Plaintext
573 lines
29 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.
|
|
\ 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! !
|
|
(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! !
|
|
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,
|
|
8 (S-WIRE) a! @ (ROOM?) -1 + if FULL jump START \ if that has the room -- or has no one on it either
|
|
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 (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@
|