rajamesandClaude Opus 5.5
630d03fa4e
MESH.md step 4. Each node has a table of destinations and the port toward each, and a port for everything else (ROUTE, DEFAULT-ROUTE, NO-ROUTES). A message not for this node is passed on whole; one with nowhere to go is dropped and counted. What text prints and how it ended go back to the node it came from by the same table. SEND sends text to another node. test_host_mesh.c: three StarForth nodes in a row behind a console, 28 checks at both widths and under ASan+UBSan. hosted-check on three ISAs. Bare metal: logs/20261006-115225 (amd64), -115501 (aarch64), -115849 (riscv64). NOT DONE. Two neighbours that write to each other at once wait for ever: a write blocks until the neighbour reads, and a node that is writing is not reading. The last check in test_host_mesh.c shows it (KNOWN FAULT). MESH.md section 7a sets out the ways out; none is chosen. Co-Authored-By: Claude Opus 5.5 <noreply@anthropic.com>
197 lines
8.3 KiB
Plaintext
197 lines
8.3 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, (EMIT-HOOK), (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
|
|
\ -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 ;
|
|
|
|
\ ( 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
|
|
0 !b 0 !b 0 !b ; \ heat and TTL, ACL tag, sequence
|
|
|
|
\ ( -- ) 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! @ b! (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, unless (EMIT-HOOK)
|
|
\ holds the xt of a word: then that word is given it instead ( c -- ), and
|
|
\ returns to EMIT's caller. Everything the node prints goes through EMIT,
|
|
\ so a hook sees all of it. The hook is taken off when the text being
|
|
\ interpreted ends (quit.v4), so that nothing can leave a node silent.
|
|
\ POST uses it to compare what a case prints (docs/v4.0.0/NUCLEUS.md 6.3).
|
|
\ 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 -- )
|
|
(EMIT-HOOK) b! @b if NONE push ;
|
|
NONE: drop
|
|
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 ;
|