rajamesandClaude Opus 5.5
a041b401ea
MESH.md step 3. The ports are the transport; the message is what is transported: to, from, type, heat and TTL, ACL tag, sequence, length, then text four characters to a word. - quit.v4: a node with nothing to do is blocked reading "any port"; text for it is interpreted; (FINISH) sends what it printed and then how the text ended, and it waits again - core.v4: EMIT keeps what is printed, (FLUSH-OUT) and (HDR) send it to the sender on the port the message came on. EMIT still needs one free data cell and no more; it works on the return stack and in A and B - message.h/.c: the same format for whatever is on a port and is not a node - boot.c: the boot is the node's console on port 1 and its kernel on port 0 - the prompt tests are a console that speaks messages - gone: v4_line_begin, v4_line_done, v4_line_status; writing a node's input buffer and setting its P from outside; any use of CONSOLE-TX Verified: make -C v4 test (test_host_quit.c 1283 checks, the full-stack figures unchanged) and make -C v4 sanitize pass; hosted-check passes on three ISAs with POST 550 of 550; clean qemu with STARFORTH_V4=1 passes POST and answers lines typed at each prompt on amd64, aarch64 and riscv64 (logs/20261006-110551, -111621, -111341). -110837 is an aarch64 run ended by the test wrapper's limit while still in UEFI firmware; it shows nothing about v4. Not done: KEY, EXPECT and QUERY still read the console's input registers; a message not for this node is let go (step 4). Co-Authored-By: Claude Opus 5.5 <noreply@anthropic.com>
180 lines
7.4 KiB
Plaintext
180 lines
7.4 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^).
|
|
\
|
|
\ 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 goes back, as a message, to whoever sent that one,
|
|
\ on the port it 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.
|
|
|
|
\ ( type -- ) the first six words of a message to the sender of the one
|
|
\ being served; its length, and its text, are the caller's to send. Each
|
|
\ write waits for the neighbour to take it. B is left at the port.
|
|
: (HDR)
|
|
(REPLY) a! @ b!
|
|
(MSG)+1 a! @ !b \ to
|
|
(ME) a! @ !b \ from
|
|
!b \ type
|
|
0 !b 0 !b 0 !b ; \ heat and TTL, ACL tag, sequence: carried, not used yet
|
|
|
|
\ ( -- ) send what has been printed: its length, then its characters, four
|
|
\ to a word, the first lowest
|
|
: (FLUSH-OUT)
|
|
(OUT^) a! @ (OUT) xor if NONE drop
|
|
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 ;
|