feat(v4): centre.4th and hera.4th; every node's kernel serves it (MESH.md 9a.3)
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>
This commit is contained in:
rajames
co-authored by
Claude Opus 5.5
Claude Opus 5.5
parent
450dea9c24
commit
c88af25e1e
@@ -0,0 +1,117 @@
|
||||
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) !
|
||||
+28
-109
@@ -1,111 +1,30 @@
|
||||
Block 8000
|
||||
( hera.4th -- Hera: the node that has the others born and )
|
||||
( manages them. docs/v4.0.0/MESH.md sections 9 and 10. )
|
||||
( She asks whoever holds the fabric for a node, wires it, )
|
||||
( and sends it its capsules through the port that joins )
|
||||
( them. The unit rule is here and nowhere else: four outer )
|
||||
( nodes round a centre, an outer node wired only inside its )
|
||||
( unit. )
|
||||
( 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 ;
|
||||
: (TN) ( n -- ) 0 <# #S #> (TS) 32 (TC) ;
|
||||
: (T) ( -- baddr u ) PAD (T#) @ ;
|
||||
Block 8001
|
||||
( The node being born: its place in the fabric, the number )
|
||||
( it is to have, and the port of this node that leads to it. )
|
||||
VARIABLE (KID) VARIABLE (KID#) VARIABLE (KIDP)
|
||||
: (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) ;
|
||||
( the nucleus, 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 8002
|
||||
( The nodes this one has had born: for each its number and )
|
||||
( its place in the fabric. Sixteen at most. )
|
||||
CREATE (KIDS) 32 ALLOT VARIABLE (KIDS#) 0 (KIDS#) !
|
||||
: (KID@) ( i -- addr ) 2 * (KIDS) + ;
|
||||
: (NOTE) ( number place -- )
|
||||
(KIDS#) @ 16 < IF
|
||||
(KIDS#) @ (KID@) SWAP OVER 1+ ! ! 1 (KIDS#) +!
|
||||
ELSE DROP DROP THEN ;
|
||||
( which of them has that number: its place in the list, or -1 )
|
||||
: (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 ;
|
||||
Block 8003
|
||||
( who it is, where its printing goes, and that everything )
|
||||
( not told of goes by its port 2, where this node is )
|
||||
: (WHO) ( -- )
|
||||
(T0) (KID#) @ (TN) S" (ME) ! " (TS)
|
||||
(CONSOLE) @ (TN) S" (CONSOLE) ! 2 DEFAULT-ROUTE " (TS)
|
||||
(ME) @ (TN) S" 2 NEIGHBOUR" (TS)
|
||||
(T) 0 (KIDP) @ SEND-ON (KID#) @ AWAIT (TOLD) ;
|
||||
( number port -- place A NODE IS BORN on that port of )
|
||||
( this one: empty, then the nucleus, then FORTH-79. )
|
||||
: BIRTH ( number port -- place )
|
||||
(KIDP) ! (KID#) !
|
||||
(KID#) @ NODE-BORN DUP 0< IF (FAIL) THEN (KID) !
|
||||
NODE-ME (KIDP) @ (KID) @ 2 NODE-WIRE 0= IF (FAIL) THEN
|
||||
(NUCLEUS)
|
||||
(KID#) @ (KIDP) @ ROUTE (KID#) @ (KIDP) @ NEIGHBOUR (WHO)
|
||||
S" v4:forth79.4th" (LINES)
|
||||
Block 8004
|
||||
S" (SEAL)" (TELL)
|
||||
(KID) @ (KID#) @ NODE-PARITY
|
||||
(KID#) @ (KID) @ (NOTE)
|
||||
(KID) @ ;
|
||||
( 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 8005
|
||||
( n -- A UNIT: four outer nodes, n+1 to n+4, on ports 2 )
|
||||
( to 5 of this one, and joined in a square: 1-2, 2-4, 4-3, )
|
||||
( 3-1. The corners across from each other are not wired: )
|
||||
( what one sends the other goes by this node. )
|
||||
VARIABLE (U)
|
||||
VARIABLE (P1) VARIABLE (P2) VARIABLE (P3) VARIABLE (P4)
|
||||
: (N) ( k -- number ) (U) @ + ;
|
||||
: UNIT ( n -- ) (U) !
|
||||
1 (N) 2 BIRTH (P1) ! 2 (N) 3 BIRTH (P2) !
|
||||
3 (N) 4 BIRTH (P3) ! 4 (N) 5 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 8006
|
||||
( n -- KILL: node n is removed, whatever it was doing. )
|
||||
( This node forgets the way to it, and every other node it )
|
||||
( has had born is told that n is gone: each forgets its way )
|
||||
( to n, and one that is waiting for n's answer stops. )
|
||||
( docs/v4.0.0/MESH.md 7b.5. As v3's KILL, by number. )
|
||||
: (UNLIST) ( i -- )
|
||||
(KIDS#) @ 1- DUP (KIDS#) ! (KID@) DUP @ SWAP 1+ @
|
||||
ROT (KID@) SWAP OVER 1+ ! ! ;
|
||||
( hera.4th -- what is Hera's alone, beside centre.4th, which )
|
||||
( she loads first. docs/v4.0.0/MESH.md 9a. She decides )
|
||||
( which nodes there are and which are awake: KILL, PAUSE and )
|
||||
( RESUME, by number, through the kernel's registry, are hers )
|
||||
( and no other node's, as v3's KILL is Hera's alone. )
|
||||
-10 KERNEL-WORD NODE-SLEEP -11 KERNEL-WORD NODE-WAKE
|
||||
-12 KERNEL-WORD NODE-KILL
|
||||
( n -- n flag a node there is, and not Hera herself )
|
||||
: (THERE?) DUP (ME) @ = 0= OVER NODE-PLACE 0< 0= AND ;
|
||||
: (NO-NODE) ( n -- ) DROP ." no such node" CR -1 NODE-ERROR ! ;
|
||||
( n -- KILL: node n is removed, whatever it was doing; this )
|
||||
( node forgets the way to it, and GONE goes down the graph. )
|
||||
: KILL ( n -- )
|
||||
DUP (WHICH) DUP 0< IF
|
||||
DROP DROP ." KILL: no such node" CR -1 NODE-ERROR ! THEN
|
||||
OVER NODE-KILL (UNLIST)
|
||||
DUP NO-ROUTE
|
||||
(KIDS#) @ DUP IF 0 DO DUP I (KID@) @ GONE LOOP ELSE DROP THEN
|
||||
DROP ;
|
||||
(THERE?) 0= IF ." KILL: " (NO-NODE) THEN
|
||||
DUP NODE-KILL DUP NO-ROUTE GONE-DOWN ;
|
||||
Block 8001
|
||||
: PAUSE ( n -- )
|
||||
(THERE?) 0= IF ." PAUSE: " (NO-NODE) THEN NODE-SLEEP ;
|
||||
: RESUME ( n -- )
|
||||
(THERE?) 0= IF ." RESUME: " (NO-NODE) THEN NODE-WAKE ;
|
||||
( n -- a unit is removed: each of n's children, then n )
|
||||
: UNIT-KILL ( n -- )
|
||||
BEGIN DUP 0 NODE-CHILD ?DUP WHILE KILL REPEAT KILL ;
|
||||
( n -- A SECOND CENTRE, node n, from its port 6 to Hera's )
|
||||
( port 6, given centre.4th; it births its unit, n+1 to n+4. )
|
||||
: CENTRE ( n -- )
|
||||
DUP 6 6 S" v4:centre.4th" BIRTH-AS DROP
|
||||
5 1 DO DUP I + 6 ROUTE LOOP DROP
|
||||
(T0) (KID#) @ (TN) S" UNIT" (TS) (T) (TELL) ;
|
||||
|
||||
+39
-31
@@ -49,7 +49,7 @@
|
||||
static int failures = 0, checks = 0;
|
||||
#define CHECK(c,...) do{checks++; if(!(c)){failures++; printf("FAIL %s:%d: ",__FILE__,__LINE__); printf(__VA_ARGS__); printf("\n");}}while(0)
|
||||
|
||||
#define PLACES 10u
|
||||
#define PLACES 12u
|
||||
static v4_node nucleus; /* the system, as the ROM assembled it: what the capsule of F18 code is written from */
|
||||
static v4_cell w_idle, w_fault;
|
||||
static v4_fabric_node pool[PLACES];
|
||||
@@ -68,6 +68,9 @@ static int storage_made(void)
|
||||
}
|
||||
static v4_place places[PLACES];
|
||||
static v4_fabric f;
|
||||
static v4_manage manage;
|
||||
static v4_manage_entry registry[PLACES]; /* the kernel's registry of live nodes (MESH.md 9a.4) */
|
||||
static unsigned pool_place[PLACES]; /* where each node of the pool is in the fabric */
|
||||
#define QUEUES 64u /* two for every wire there is at once: five kernels, the console, four to Hera, four round the square */
|
||||
static v4_wire_queue queues[QUEUES];
|
||||
static v4_image im; /* only what the dictionary hash needs of it */
|
||||
@@ -91,7 +94,7 @@ static int read_file(reader *r, const char *name)
|
||||
r->text = (char *)malloc((size_t)r->len + 1);
|
||||
if (!r->text || fread(r->text, 1, (size_t)r->len, in) != (size_t)r->len) { fclose(in); return 0; }
|
||||
fclose(in);
|
||||
r->at = 0; r->in_block = 0; r->is_f18 = 0;
|
||||
r->at = 0; r->in_block = 0; r->is_f18 = 0; r->cells_at = 0;
|
||||
return 1;
|
||||
}
|
||||
/* the next line of a block that has anything on it: its length, or -1 */
|
||||
@@ -113,10 +116,10 @@ static int next_line(reader *r, char *text)
|
||||
}
|
||||
|
||||
/* ---- what Hera's requests are answered with ---- */
|
||||
static reader hera_reads; /* the capsule Hera has open */
|
||||
static reader reads[PLACES]; /* the capsule each node has open, by its place: a reader is the asker's (MESH.md 9a.4) */
|
||||
static unsigned born_count, parity_count;
|
||||
static v4_cell parity_number[8];
|
||||
static uint64_t parity_hash[8];
|
||||
static v4_cell parity_number[16];
|
||||
static uint64_t parity_hash[16];
|
||||
|
||||
/* THE KERNEL, for a node that is not Hera: on its port 0 it serves the
|
||||
* node's blocks, and no other request (MESH.md 8.3). */
|
||||
@@ -125,7 +128,8 @@ static v4_blocks node_blocks[PLACES]; /* what the kernel keeps of each node's
|
||||
static int node_kernel_take(void *self, v4_cell value)
|
||||
{
|
||||
v4_fabric_node *x = (v4_fabric_node *)self;
|
||||
if (!v4_blocks_serve(&node_blocks[x - pool], &x->n, value)) refused++;
|
||||
if (v4_blocks_serve(&node_blocks[x - pool], &x->n, value)) return 1;
|
||||
if (!v4_manage_serve(&manage, pool_place[x - pool], value)) refused++; /* any node may ask, and the kernel checks who (MESH.md 9a.4) */
|
||||
return 1;
|
||||
}
|
||||
static v4_device node_kernel[PLACES];
|
||||
@@ -140,6 +144,7 @@ static int host_born(void *self)
|
||||
place = v4_fabric_add(&f, &pool[k], PORT);
|
||||
if (place < 0) return -1;
|
||||
pool_used[k] = 1;
|
||||
pool_place[k] = (unsigned)place;
|
||||
born_count++;
|
||||
/* what a node's hardware gives it; there is nothing in its memory */
|
||||
v4_node_stack_regs_attach(&pool[k].n, DSTACK_REG, RSTACK_REG);
|
||||
@@ -164,34 +169,35 @@ static void host_gone(void *self, unsigned place, v4_fabric_node *was)
|
||||
}
|
||||
static int host_open(void *self, unsigned asker, const char *name, unsigned len)
|
||||
{
|
||||
(void)self; (void)asker;
|
||||
if (len == 17 && memcmp(name, "v4:nucleus-64.f18", 17) == 0) { hera_reads.is_f18 = 1; hera_reads.cells_at = 0; return 1; }
|
||||
if (len == 14 && memcmp(name, "v4:forth79.4th", 14) == 0) return read_file(&hera_reads, "forth79.4th");
|
||||
reader *r = &reads[asker];
|
||||
(void)self;
|
||||
if (len == 17 && memcmp(name, "v4:nucleus-64.f18", 17) == 0) { r->is_f18 = 1; r->cells_at = 0; return 1; }
|
||||
if (len == 14 && memcmp(name, "v4:forth79.4th", 14) == 0) return read_file(r, "forth79.4th");
|
||||
if (len == 13 && memcmp(name, "v4:centre.4th", 13) == 0) return read_file(r, "centre.4th");
|
||||
return 0;
|
||||
}
|
||||
static int host_cell(void *self, unsigned asker, v4_cell *w)
|
||||
{
|
||||
(void)self; (void)asker;
|
||||
if (!hera_reads.is_f18 || hera_reads.cells_at >= f18_count) return 0;
|
||||
*w = f18[hera_reads.cells_at++];
|
||||
reader *r = &reads[asker];
|
||||
(void)self;
|
||||
if (!r->is_f18 || r->cells_at >= f18_count) return 0;
|
||||
*w = f18[r->cells_at++];
|
||||
return 1;
|
||||
}
|
||||
static int host_line(void *self, unsigned asker, char *text)
|
||||
{
|
||||
(void)self; (void)asker;
|
||||
return hera_reads.is_f18 ? -1 : next_line(&hera_reads, text);
|
||||
reader *r = &reads[asker];
|
||||
(void)self;
|
||||
return r->is_f18 ? -1 : next_line(r, text);
|
||||
}
|
||||
static void host_parity(void *self, unsigned place, v4_cell number, const v4_node *n)
|
||||
{
|
||||
(void)self; (void)place;
|
||||
if (parity_count < 8) { parity_number[parity_count] = number; parity_hash[parity_count] = v4_image_dict_hash(n, &im); }
|
||||
if (parity_count < 16) { parity_number[parity_count] = number; parity_hash[parity_count] = v4_image_dict_hash(n, &im); }
|
||||
parity_count++;
|
||||
}
|
||||
static v4_manage manage;
|
||||
static v4_manage_entry registry[PLACES]; /* the kernel's registry of live nodes (MESH.md 9a.4) */
|
||||
|
||||
/* ---- the kernel: a device on Hera's port 0 ---- */
|
||||
#define FIRST_REQUEST 1 /* the number of NODE-ME on her */
|
||||
static unsigned hera_place, given_cells;
|
||||
static int kernel_give(void *self, v4_cell *value) /* the nucleus, to a node that has nothing in it */
|
||||
{
|
||||
@@ -410,13 +416,6 @@ int main(void)
|
||||
|
||||
CHECK(told(0, "10 (ME) ! 1 (CONSOLE) ! 1 1 ROUTE") && ended_from == 10, "it is told it is 10, and where the console is");
|
||||
CHECK(v4_manage_enter(&manage, 10, hera_place, 0), "the kernel enters her in its registry, as v3's enters Hera");
|
||||
{
|
||||
char text[600];
|
||||
size_t at = 0;
|
||||
for (i = 0; i < V4_MANAGE_WORDS; i++) at += (size_t)snprintf(text + at, sizeof text - at, "%d KERNEL-WORD %s ", (int)(V4_REQ_NODE_ME - (v4_cell)i), v4_manage_words[i]);
|
||||
CHECK(told(10, text), "and given the words that ask for nodes and capsules: \"%s\"", printed);
|
||||
}
|
||||
CHECK(strcmp(tell(10, "NODE-ME ."), "0 ") == 0 && refused == 0, "it asks where it is, and is answered");
|
||||
CHECK(load(10, "forth79.4th") == 0, "it takes in FORTH-79");
|
||||
CHECK(told(10, "(SEAL)"), "the nucleus and FORTH-79 are the system POST is run on");
|
||||
{
|
||||
@@ -442,7 +441,10 @@ int main(void)
|
||||
}
|
||||
CHECK(strstr(tell(10, "T{"), "UNKNOWN WORD") != NULL, "nothing of POST's harness is on her: \"%s\"", printed);
|
||||
CHECK(strstr(tell(10, "RS1"), "UNKNOWN WORD") != NULL && strstr(tell(10, "ZERO"), "UNKNOWN WORD") != NULL, "nor anything POST's cases defined: POST leaves nothing, as in v3: \"%s\"", printed);
|
||||
CHECK(load(10, "hera.4th") == 0, "and its own capsule, which makes it Hera");
|
||||
CHECK(load(10, "centre.4th") == 0, "she takes in what a node that births needs");
|
||||
CHECK(load(10, "hera.4th") == 0, "and her own capsule, which makes it Hera");
|
||||
CHECK(strcmp(tell(10, "(GONE-HOOK) @ 0= ."), "0 ") == 0, "centre.4th has put GONE-DOWN in her (GONE-HOOK)");
|
||||
CHECK(strcmp(tell(10, "NODE-ME ."), "0 ") == 0 && refused == 0, "she asks where she is, by the word centre.4th made, and is answered");
|
||||
CHECK(told(10, "(SEAL)"), "that is the system it comes back to");
|
||||
|
||||
/* ---- she births the unit ---- */
|
||||
@@ -509,11 +511,17 @@ int main(void)
|
||||
}
|
||||
CHECK(strstr(tell(14, "9000 BLOCK"), "Block out of range") != NULL && strcmp(tell(14, "14 100 * ."), "1400 ") == 0, "a block there is not says so, and the node goes on: \"%s\"", printed);
|
||||
{
|
||||
char text[64];
|
||||
unsigned before = refused, born = born_count;
|
||||
snprintf(text, sizeof text, "%u KERNEL-WORD ASK-BORN ASK-BORN", FIRST_REQUEST + 1);
|
||||
(void)tell(12, text);
|
||||
CHECK(refused == before + 1 && born_count == born, "an outer node's request for a node is not honoured: only its blocks are");
|
||||
/* Births follow v3 (MESH.md 9): an outer node births, and is its child's parent; it may not kill,
|
||||
* put to sleep or wire what it did not birth. Hera kills the node it birthed, by number. */
|
||||
unsigned born = born_count;
|
||||
CHECK(told(12, "-7 KERNEL-WORD ASK-BORN -12 KERNEL-WORD ASK-KILL -10 KERNEL-WORD ASK-SLEEP")
|
||||
&& told(12, "-8 KERNEL-WORD ASK-WIRE -18 KERNEL-WORD ASK-PLACE"), "node 12 is given words that ask the kernel");
|
||||
CHECK(strstr(tell(12, "30 ASK-BORN ."), "-1") == NULL && born_count == born + 1 && ended_how == V4_TEXT_COMPLETED, "node 12 births node 30, as any v3 VM may: \"%s\"", printed);
|
||||
CHECK(strstr(tell(12, "11 ASK-KILL"), "Argument out of range") != NULL && node_numbered(11) != NULL, "it may not kill node 11: KILL is Hera's: \"%s\"", printed);
|
||||
CHECK(strstr(tell(12, "11 ASK-SLEEP"), "Argument out of range") != NULL && waiting(11), "nor put it to sleep");
|
||||
CHECK(strstr(tell(12, "11 ASK-PLACE 5 10 ASK-PLACE 6 ASK-WIRE"), "Argument out of range") != NULL, "nor wire Hera and node 11, neither of which it birthed");
|
||||
CHECK(told(10, "30 KILL") && born_count == born + 1, "Hera kills node 30, which she did not birth, by its number");
|
||||
CHECK(strcmp(tell(12, "30 ASK-PLACE ."), "-1 ") == 0, "and the kernel no longer has it: \"%s\"", printed);
|
||||
}
|
||||
|
||||
/* two nodes use the store at once */
|
||||
|
||||
Reference in New Issue
Block a user