\ 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 ;