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) !