rajamesandClaude Opus 5.5
59727f762a
The review of step 6c found it did not keep its rule. Ruled: fix them all; 16 hops. - Paying a NACK no longer waits on a lower-numbered neighbour; a node that owes one does not sleep, and goes on taking in what it is sent. - AWAIT looks first through the messages already waiting. - A node waiting to write to a removed neighbour gets error 18: the word that says who is reading also says which ports have anything on them. - A console line lets Hera go when she is blocked on the first word of a message (v4_fabric_interrupt_error, a device's `pending`). - A refused answer is told to the node that waits, not the one that answered; one owed to the node itself goes to its own queue. - A message is passed on by at most 16 nodes, then refused. - A GONE is believed only when it says it is from the node's centre. - Tests: the check that tested nothing is replaced; no room for a waiting sender; the limit that remains is tested as a limit. - MESH.md 7b's rule reworded to what holds, 7b.7 says where it falls short; README likewise. make -C v4 test, sanitize, hosted-check; three bare-metal boots. POST 538 of 538, word_count=317, dict_hash=0xc0769523a47b7dc3 on all six. Co-Authored-By: Claude Opus 5.5 <noreply@anthropic.com>
382 lines
17 KiB
Plaintext
382 lines
17 KiB
Plaintext
\ core.v4 -- the core words the host-node capsules rest on.
|
|
\
|
|
\ Each is the definition DECOMPOSITION.md gives and the golden-model tests
|
|
\ execute (test_foundation.c, test_strings.c, test_terminal.c, test_pictured.c),
|
|
\ written here as text for the text assembler (v4/include/v4/text.h).
|
|
\
|
|
\ Constants the loader supplies: N-1 (cell bits - 1), NODE-ERROR, CONSOLE-TX,
|
|
\ CONSOLE-RX, CONSOLE-STATUS, BASE, (MSG), (REPLY), (ME), (OUT),
|
|
\ (OUT^), (CONSOLE), (ROUTES), (ROUTE#), (ROUTE-DEFAULT), (PRINT-TO),
|
|
\ (PRINT-PORT).
|
|
\
|
|
\ ERRORS (D-18). A word that finds an error takes its arguments off the stack
|
|
\ and stores a code in NODE-ERROR. On a node with a prompt that store is a
|
|
\ trap: the word goes no further, and the prompt prints the message for the
|
|
\ code and ERROR (quit.v4, (RAISED)). The codes:
|
|
\ 1 Negative count 2 Not a number 3 Number too long
|
|
\ 4 Not a character 5 Dictionary full 6 Name missing
|
|
\ 7 Control structure mismatch 8 Control structures too deep
|
|
\ 9 Shift count out of range 10 Protected word
|
|
\ 11 Division by zero (Q./) 12 Argument out of range
|
|
\ 13 Block out of range 14 No block is being loaded
|
|
\ 15 Deferred word not set 16 Not a word
|
|
\ 17 Storage refused 18 No one on that port
|
|
\ 19 Message refused 20 Node gone
|
|
\ 21 Interrupted
|
|
\ -1 the word has printed its own message
|
|
|
|
macro SWAP over push push drop pop pop endmacro
|
|
macro - push inv pop + inv endmacro \ x y -- x-y
|
|
macro NEGATE inv 1 + endmacro
|
|
macro NIP push drop pop endmacro
|
|
|
|
\ ---- section 4: multiply ------------------------------------------------
|
|
header UM*
|
|
: UM* ( u1 u2 -- ulo uhi )
|
|
over 1 and inv 1 + over 2/ and \ u1 u2 t0 t0 = u2 2/ if u1 odd
|
|
over a! N-1 push \ A: u2 R: loop count
|
|
push over 2/ pop \ u1 u2 s t0 s = u1 2/
|
|
L: +* unext \ u1 u2 s hi A: lo
|
|
push drop pop \ u1 u2 hi
|
|
2* a -if L0 drop 1 + jump L1 L0: drop L1: push
|
|
over -if L2 drop dup jump L3 L2: drop 0 L3: push
|
|
dup -if L4 drop over 1 and jump L5 L4: drop 0 L5:
|
|
pop + pop + push
|
|
and 1 and a 2* + pop ;
|
|
|
|
\ ---- section 5.7: doubles ------------------------------------------------
|
|
header D+
|
|
: D+ ( d1 d2 -- d3 )
|
|
push over push push drop pop \ al bl R: bh ah
|
|
over over xor -if L1
|
|
drop + -if C1 jump C0
|
|
L1: drop over -if L2
|
|
drop + jump C1
|
|
L2: drop +
|
|
C0: pop pop + ;
|
|
C1: pop pop + 1 + ;
|
|
|
|
header DNEGATE
|
|
: DNEGATE ( d -- -d )
|
|
inv over if L1 drop push inv 1 + pop ;
|
|
L1: drop 1 + ;
|
|
|
|
\ ---- section 5.3: bytes --------------------------------------------------
|
|
\ The shifts are written out, eight to a line, where DECOMPOSITION.md 5.3 has
|
|
\ a FOR ... UNEXT loop: a loop keeps its count on the return stack, and C@ and
|
|
\ C! are at the bottom of every chain of calls in the compiler capsule, where
|
|
\ there is not an entry to spare (D-2). The result is the same.
|
|
macro 8/ 2/ 2/ 2/ 2/ 2/ 2/ 2/ 2/ endmacro
|
|
macro 8* 2* 2* 2* 2* 2* 2* 2* 2* endmacro
|
|
|
|
header C@
|
|
: C@ ( baddr -- c )
|
|
dup 2/ 2/ a! 3 and
|
|
if K0 -1 + if K1 -1 + if K2
|
|
drop @ 8/ 8/ 8/ 255 and ;
|
|
K2: drop @ 8/ 8/ 255 and ;
|
|
K1: drop @ 8/ 255 and ;
|
|
K0: drop @ 255 and ;
|
|
|
|
header C!
|
|
: C! ( c baddr -- )
|
|
dup 2/ 2/ a! 3 and
|
|
if K0 -1 + if K1 -1 + if K2
|
|
drop 8* 8* 8* 4278190080 and @ 4278190080 inv and + ! ;
|
|
K2: drop 8* 8* 16711680 and @ -16711681 and + ! ;
|
|
K1: drop 8* 65280 and @ -65281 and + ! ;
|
|
K0: drop 255 and @ -256 and + ! ;
|
|
|
|
\ ---- section 5.9: strings ------------------------------------------------
|
|
header CMOVE
|
|
: CMOVE ( src dst u -- )
|
|
-if OK drop drop drop NODE-ERROR b! 1 !b ;
|
|
OK: if DONE push
|
|
over C@ over C! 1 + push 1 + pop pop -1 + jump OK
|
|
DONE: drop drop drop ;
|
|
|
|
\ ---- section 5.10: the console -------------------------------------------
|
|
\ ---- what a node prints (docs/v4.0.0/MESH.md section 6) ------------------------
|
|
\ A node has no console of its own. It does what a message asks, and what
|
|
\ it prints while doing it is sent as a message: to the node in (CONSOLE), or
|
|
\ if that is 0 to whoever sent the text; by the port that leads there, or if
|
|
\ this node knows of none, by the port the text came on. A message is seven words and then its text, four
|
|
\ characters to a word:
|
|
\ 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.
|
|
\
|
|
\ 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^)
|
|
\ is where the next goes.
|
|
\
|
|
\ 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.
|
|
|
|
\ 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
|
|
\ port leads toward that node: the table (ROUTES), (ROUTE#) entries of a
|
|
\ 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)
|
|
(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 ;
|
|
|
|
\ 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.
|
|
\
|
|
\ 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.
|
|
|
|
\ ( mask index -- bit )
|
|
: (BIT)
|
|
if Z -1 + FOR 2/ NEXT 1 and ;
|
|
Z: drop 1 and ;
|
|
|
|
\ ( 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
|
|
|
|
\ ( 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 + ! ;
|
|
|
|
\ ( -- 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)
|
|
|
|
\ ( 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! !
|
|
L: (WRITERS) b! @b if QUIET
|
|
(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.
|
|
: (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
|
|
|
|
\ 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.
|
|
|
|
\ ( 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 ! ;
|
|
|
|
\ ( 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)
|
|
|
|
\ ( -- ) send every refusal this node owes that can go now
|
|
: (PAY)
|
|
(OWED#) a! @ if NONE -1 +
|
|
FOR pop dup push (PAY1) NEXT ;
|
|
NONE: drop ;
|
|
|
|
\ ( -- ) 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.
|
|
: (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! ! ;
|
|
NONE: drop ;
|
|
|
|
\ EMIT puts the character with what has been printed. Everything the node
|
|
\ prints goes through EMIT. A is kept: the words that print have always
|
|
\ been free to use it across an EMIT. As v3, only the low 8 bits of the
|
|
\ character are printed.
|
|
header EMIT
|
|
: EMIT ( c -- )
|
|
255 and a push push \ A, and then the character, to the return stack
|
|
(OUT^) b! @b a! pop !+ a !b \ the character goes where (OUT^) points, which moves on
|
|
a (OUT)+256 xor if FULL drop pop a! ;
|
|
FULL: drop (FLUSH-OUT) pop a! ;
|
|
header KEY
|
|
: KEY ( -- c )
|
|
L: CONSOLE-STATUS b! @b if WAIT drop CONSOLE-RX b! @b ;
|
|
WAIT: drop jump L
|
|
|
|
header CR
|
|
: CR ( -- ) 10 jump EMIT
|
|
header SPACE
|
|
: SPACE ( -- ) 32 jump EMIT
|
|
header COUNT
|
|
: COUNT ( baddr -- baddr+1 c ) dup C@ push 1 + pop ;
|
|
header TYPE
|
|
: TYPE ( baddr u -- )
|
|
-if OK drop drop NODE-ERROR b! 1 !b ;
|
|
OK: if DONE over C@ EMIT push 1 + pop -1 + jump OK
|
|
DONE: drop drop ;
|
|
|
|
\ ( x -- ) up to four characters packed in one cell, the first in the low
|
|
\ byte: how the capsule prints its own short messages, a literal at a time.
|
|
: (EMIT4)
|
|
L: if DONE dup EMIT 8/ jump L
|
|
DONE: drop ;
|
|
|
|
\ ---- section 5.8: the number base ----------------------------------------
|
|
: (BASE) ( -- b ) \ BASE, or 10 when it is outside 2 .. 36
|
|
BASE b! @b dup -2 + -if L1 drop drop 10 ;
|
|
L1: drop dup -37 + -if L2 drop ;
|
|
L2: drop drop 10 ;
|