rajamesandClaude Opus 5.5
c88af25e1e
What a birthing node needs is centre.4th; KILL, PAUSE, RESUME, UNIT-KILL and CENTRE are Hera's. An outer node births, as a v3 VM may, and may not kill. A capsule is read by the node that opened it. test_host_unit: 93 checks. Co-Authored-By: Claude Opus 5.5 <noreply@anthropic.com>
118 lines
4.8 KiB
Forth
118 lines
4.8 KiB
Forth
Block 8100
|
|
( centre.4th -- what a node that births others needs. )
|
|
( docs/v4.0.0/MESH.md 9a. Births follow v3: any node may )
|
|
( birth on its own ports, and is its children's parent. )
|
|
( The kernel's requests, by their numbers in manage.h: )
|
|
-6 KERNEL-WORD NODE-ME -7 KERNEL-WORD NODE-BORN
|
|
-8 KERNEL-WORD NODE-WIRE -9 KERNEL-WORD NODE-UNWIRE
|
|
-13 KERNEL-WORD NODE-PARITY -14 KERNEL-WORD CAPSULE-OPEN
|
|
-15 KERNEL-WORD CAPSULE-CELL -16 KERNEL-WORD CAPSULE-LINE
|
|
-17 KERNEL-WORD NODE-CHILD -18 KERNEL-WORD NODE-PLACE
|
|
( Text for another node is built in PAD. )
|
|
VARIABLE (T#)
|
|
: (T0) ( -- ) 0 (T#) ! ;
|
|
: (TC) ( c -- ) PAD (T#) @ + C! 1 (T#) +! ;
|
|
: (TS) ( baddr u -- )
|
|
DUP IF 0 DO DUP I + C@ (TC) LOOP DROP ELSE DROP DROP THEN ;
|
|
Block 8101
|
|
: (TN) ( n -- ) 0 <# #S #> (TS) 32 (TC) ;
|
|
: (T) ( -- baddr u ) PAD (T#) @ ;
|
|
( The node being born: its number, its place, the port of )
|
|
( this node that leads to it, its own port that leads here, )
|
|
( and its personality: a capsule's name, or none. )
|
|
VARIABLE (KID) VARIABLE (KID#) VARIABLE (KIDP)
|
|
VARIABLE (KIDC) VARIABLE (PERS) VARIABLE (PERS#)
|
|
: (FAIL) ( -- )
|
|
." BIRTH: node " (KID#) @ . ." did not do as it was told" CR
|
|
-1 NODE-ERROR ! ;
|
|
: (TOLD) ( how -- ) 1 - IF (FAIL) THEN ;
|
|
: (TELL) ( baddr u -- ) (KID#) @ SEND (KID#) @ AWAIT (TOLD) ;
|
|
Block 8102
|
|
( the system, a capsule of F18 code, cell by cell to its port )
|
|
: (NUCLEUS) ( -- )
|
|
S" v4:nucleus-64.f18" CAPSULE-OPEN 0= IF (FAIL) THEN
|
|
BEGIN CAPSULE-CELL WHILE (KIDP) @ PORT! REPEAT DROP ;
|
|
( a capsule of FORTH blocks, a line at a time )
|
|
: (LINES) ( baddr u -- ) CAPSULE-OPEN 0= IF (FAIL) THEN
|
|
BEGIN PAD CAPSULE-LINE DUP 0< 0= WHILE PAD SWAP (TELL) REPEAT
|
|
DROP ;
|
|
Block 8103
|
|
( The nodes this one has had born: for each its number and )
|
|
( the port of this node it is on. Sixteen at most. )
|
|
CREATE (KIDS) 32 ALLOT VARIABLE (KIDS#) 0 (KIDS#) !
|
|
: (KID@) ( i -- addr ) 2 * (KIDS) + ;
|
|
: (NOTE) ( number port -- )
|
|
(KIDS#) @ 16 < IF
|
|
(KIDS#) @ (KID@) SWAP OVER 1+ ! ! 1 (KIDS#) +!
|
|
ELSE DROP DROP THEN ;
|
|
: (WHICH) ( number -- i | -1 )
|
|
-1 SWAP (KIDS#) @ DUP IF 0 DO
|
|
DUP I (KID@) @ = IF SWAP DROP I SWAP THEN
|
|
LOOP ELSE DROP THEN DROP ;
|
|
: (UNLIST) ( i -- )
|
|
(KIDS#) @ 1- DUP (KIDS#) ! (KID@) DUP @ SWAP 1+ @
|
|
ROT (KID@) SWAP OVER 1+ ! ! ;
|
|
Block 8104
|
|
( Who it is, where its printing goes, which of its ports )
|
|
( leads to everything it is not told of, and who is there. )
|
|
: (WHO) ( -- )
|
|
(T0) (KID#) @ (TN) S" (ME) ! " (TS)
|
|
(CONSOLE) @ (TN) S" (CONSOLE) ! " (TS)
|
|
(KIDC) @ (TN) S" DEFAULT-ROUTE " (TS)
|
|
(ME) @ (TN) (KIDC) @ (TN) S" NEIGHBOUR" (TS)
|
|
(T) 0 (KIDP) @ SEND-ON (KID#) @ AWAIT (TOLD) ;
|
|
Block 8105
|
|
( number port childport baddr u -- place A NODE IS BORN, )
|
|
( its port childport joined to this one's port: empty, then )
|
|
( the system, FORTH-79, and its personality if u is not 0. )
|
|
: BIRTH-AS
|
|
(PERS#) ! (PERS) ! (KIDC) ! (KIDP) ! (KID#) !
|
|
(KID#) @ NODE-BORN DUP 0< IF (FAIL) THEN (KID) !
|
|
NODE-ME (KIDP) @ (KID) @ (KIDC) @ NODE-WIRE 0= IF (FAIL) THEN
|
|
(NUCLEUS)
|
|
(KID#) @ (KIDP) @ ROUTE (KID#) @ (KIDP) @ NEIGHBOUR (WHO)
|
|
S" v4:forth79.4th" (LINES)
|
|
(PERS#) @ IF (PERS) @ (PERS#) @ (LINES) THEN
|
|
S" (SEAL)" (TELL)
|
|
(KID) @ (KID#) @ NODE-PARITY
|
|
(KID#) @ (KIDP) @ (NOTE)
|
|
(KID) @ ;
|
|
Block 8106
|
|
( number port childport -- place a node with no capsule )
|
|
: BIRTH 0 0 BIRTH-AS ;
|
|
( Two outer nodes are joined: port 3 of X to port 4 of Y, )
|
|
( and each is told the other is there. )
|
|
VARIABLE (XP) VARIABLE (XN) VARIABLE (YP) VARIABLE (YN)
|
|
: (X) ( place number -- ) (XN) ! (XP) ! ;
|
|
: (Y) ( place number -- ) (YN) ! (YP) ! ;
|
|
: (SAY) ( them port me -- ) (KID#) !
|
|
(T0) OVER (TN) DUP (TN) S" ROUTE " (TS)
|
|
SWAP (TN) (TN) S" NEIGHBOUR" (TS) (T) (TELL) ;
|
|
: (JOIN) ( -- )
|
|
(XP) @ 3 (YP) @ 4 NODE-WIRE 0= IF (FAIL) THEN
|
|
(YN) @ 3 (XN) @ (SAY) (XN) @ 4 (YN) @ (SAY) ;
|
|
Block 8107
|
|
( n -- A UNIT: four outer nodes, n+1 to n+4, on ports 2 )
|
|
( to 5 of this one, each by its own port 2, and joined in a )
|
|
( square: 1-2, 2-4, 4-3, 3-1. )
|
|
VARIABLE (U)
|
|
VARIABLE (P1) VARIABLE (P2) VARIABLE (P3) VARIABLE (P4)
|
|
: (N) ( k -- number ) (U) @ + ;
|
|
: UNIT ( n -- ) (U) !
|
|
1 (N) 2 2 BIRTH (P1) ! 2 (N) 3 2 BIRTH (P2) !
|
|
3 (N) 4 2 BIRTH (P3) ! 4 (N) 5 2 BIRTH (P4) !
|
|
(P1) @ 1 (N) (X) (P2) @ 2 (N) (Y) (JOIN)
|
|
(P2) @ 2 (N) (X) (P4) @ 4 (N) (Y) (JOIN)
|
|
(P4) @ 4 (N) (X) (P3) @ 3 (N) (Y) (JOIN)
|
|
(P3) @ 3 (N) (X) (P1) @ 1 (N) (Y) (JOIN) ;
|
|
Block 8108
|
|
( n -- NODE n IS GONE: every node this one birthed is told, )
|
|
( as from this one, and n leaves the list if it was there. )
|
|
( The system calls this when it believes a GONE, through )
|
|
( GONE-HOOK in quit.f18; Hera calls it from KILL. )
|
|
: GONE-DOWN ( n -- )
|
|
DUP (WHICH) DUP 0< IF DROP ELSE (UNLIST) THEN
|
|
(KIDS#) @ DUP IF 0 DO DUP I (KID@) @ GONE LOOP
|
|
ELSE DROP THEN DROP ;
|
|
' GONE-DOWN (GONE-HOOK) !
|