admin/LithosAnanake
1
1
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

feat(v4.0.0): a node looks before it writes; two neighbours no longer stop each other

Browse Source 
MESH.md step 4, the fault found there, as ruled (section 7a): a node
writes only to a neighbour that is reading, keeps what it takes in
meanwhile, and loses and counts what it has no room for.

Engine: two more addresses after a node's ports -- which ports have a
neighbour waiting to write to it, which to read from it. Nucleus: (GATE)
before every message; the messages waiting, a ring of 400 cells, dealt
with when the node is idle. Of two neighbours the lower number may wait
to write (ruled after it was built); NEIGHBOUR tells a node who is on
each port.

test_host_mesh.c, 44 checks: the case that stopped the nodes passes; six
messages from each node to each at once all arrive; 800 at once, the
nodes come to rest and every message arrived or was counted (287 arrived,
714 of all kinds let go). test_fabric.c: the two looks. Both widths,
ASan+UBSan.

POST: twelve cases handed HERE, a cell address on v4, to words that take
a byte address, and so wrote into or read from the nucleus's code at cell
HERE/4. Ruled: left out, marked OPEN, until HERE and the byte words are
made to agree as its own step. POST is 538 cases.

hosted-check on three ISAs, 538/538. Bare metal: logs/20261006-134817
(amd64), -135044 (aarch64), -135440 (riscv64).

Co-Authored-By: Claude Opus 5.5 <noreply@anthropic.com>
This commit is contained in:
rajames
2026-10-06 13:56:57 -04:00
co-authored by Claude Opus 5.5
parent 630d03fa4e
commit f9c034cadd
21 changed files with 1015 additions and 308 deletions
Download Patch File Download Diff File Expand all files Collapse all files
v4/README.md
+9 -7
View File
@@ -61,7 +61,7 @@ load `v4:forth79.4th`, pass POST and reach `ok>`, with the same lines:
```
PARITY:V4_NUCLEUS name=v4:nucleus-64.f18 capsule_id=... capsule_hash=0x97a655081b2af559 words=298
PARITY:V4_CAPSULE name=v4:forth79.4th capsule_id=... dict_hash=...
PARITY:V4_POST tests=550 pass=550 fail=0
PARITY:V4_POST tests=538 pass=538 fail=0
PARITY:V4_CAPSULE name=v4:post79.4th capsule_id=... dict_hash=...
PARITY:OK
POST: PASSED
@@ -115,11 +115,13 @@ steps 8 and 9.
**Finding the way** (`MESH.md` step 4) is built: a node has a table of
which port leads toward which node (`ROUTE`, `DEFAULT-ROUTE`, `NO-ROUTES`),
passes on a message that is not for it, and `SEND`s text to another node;
`v4/tests/test_host_mesh.c` runs three StarForth nodes in a row. **It has
a fault that stands:** two neighbours that write to each other at the same
moment wait for ever, because a write blocks until the neighbour reads and
a node that is writing is not reading. The test shows it, named KNOWN
FAULT. The ways out are in `MESH.md` section 7a and none is chosen yet.
`v4/tests/test_host_mesh.c` runs three StarForth nodes in a row. A node
looks before it begins a message (`MESH.md` section 7a): it takes in what
its neighbours are waiting to write to it, keeps those messages until it
has nothing else to do, and writes only to a neighbour that is waiting to
read -- or, of two neighbours, the one with the lower number may wait.
`NEIGHBOUR ( node port -- )` tells a node who is on each port. A node with
no room for one more message lets it go and counts it in `(LOST)`.
**This is still the lone node.** On bare metal `kernel_main.c` starts it
before the fleet tables, beside the kernel's own system and not in the VM's
@@ -133,7 +135,7 @@ a time with POST after each, is the next step (`NUCLEUS.md` section 8).
## POST
`capsules/v4/post79.4th`: 550 cases in blocks 7000 up, covering 126 of the
`capsules/v4/post79.4th`: 538 cases in blocks 7000 up, covering 126 of the
130 words of the FORTH-79 Required Word Set. 443 are v3's cases with what
the hosted v3 binary did as the expected result. The other 107, and the 27
v3 cases left out, are listed with reasons in `docs/v4.0.0/POST79.md`.
v4/capsule/core.v4
+93 -1
View File
@@ -128,6 +128,98 @@ header CMOVE
NONE: drop drop (ROUTE-DEFAULT) a! @ ;
HIT: drop drop @+ pop drop ;
\ LOOKING BEFORE WRITING (MESH.md section 7a). A write waits until the
\ neighbour reads, and a node that is waiting to write reads nothing: two
\ neighbours that each began to write to the other would wait for ever. So
\ a node does not begin a message until it has looked, (GATE):
\ - while any neighbour is waiting to write to it, it takes that message
\ in and keeps it with the messages waiting, to deal with when it has
\ nothing else to do;
\ - then, if the neighbour it means to write to is waiting to read, it
\ writes;
\ - and if that neighbour is not, it writes all the same when the
\ neighbour's number is the higher of the two, and otherwise looks
\ again. Of two neighbours one only may wait to write to the other, and
\ it is the lower: so those that wait are waiting on ever higher
\ numbers, and the highest of them is not waiting to write; it is
\ looking, and takes in what is being written to it.
\ (WRITERS) and (READERS) are the node's two looks at its neighbours, a bit
\ for each port. (NEAR) is the number of the node on each port, told by
\ whoever wires it (NEIGHBOUR, quit.v4); a port not told of -- a device's
\ -- is written to only when what is there is waiting to read.
\
\ THE MESSAGES WAITING are kept in (MQ) .. (MQ-END), one after another,
\ going round: for each its seven words, the port it came on, and its text.
\ (MQ-HEAD) is where the oldest begins, (MQ-TAIL) where the next will go,
\ (MQ#) how many cells are taken. One that there is no room for is read to
\ its end and let go, and (LOST) counts it.
\ ( mask index -- bit )
: (BIT)
if Z -1 + FOR 2/ NEXT 1 and ;
Z: drop 1 and ;
\ ( mask -- index ) the lowest port in it; the mask is not zero
: (LOW)
0 push
L: dup 1 and if UP drop drop pop ;
UP: drop 2/ pop 1 + push jump L
\ ( w -- ) one more cell of the messages waiting. B is kept.
: (MQ!)
(MQ-TAIL) a! @ a! !+
a (MQ-END) xor if WRAP drop a jump SET
WRAP: drop (MQ)
SET: (MQ-TAIL) a! !
(MQ#) a! @ 1 + ! ;
\ ( -- w ) the oldest cell of the messages waiting, which goes
: (MQ@)
(MQ-HEAD) a! @ a! @+
a (MQ-END) xor if WRAP drop a jump SET
WRAP: drop (MQ)
SET: (MQ-HEAD) a! !
(MQ#) a! @ -1 + ! ;
\ ( port to -- ) take in a message. B is at the port, by its address,
\ and `to` is the message's first word, already read from it. A length
\ below zero, or above what a message carries, is kept as -1 with no text:
\ a longer one is read to its end first, so that what follows it is not
\ taken for a message.
: (TAKE)
(MQ-HDR) a! !+ 5 FOR @b !+ UNEXT ! \ its seven words, and the port
(MQ-HDR)+6 a! @ -if SIZED
drop -1 (MQ-HDR)+6 a! ! 0 jump COUNTED
SIZED: dup -1025 + -if LONG drop 3 + 2/ 2/ jump COUNTED
LONG: drop 3 + 2/ 2/ -1 + FOR @b drop UNEXT -1 (MQ-HDR)+6 a! ! 0
COUNTED: \ ( n ) how many words of text follow
dup (MQ#) a! @ + -MQ-ROOM + -if FULL
drop push
(MQ-HDR) a! @ (MQ!) (MQ-HDR)+1 a! @ (MQ!) (MQ-HDR)+2 a! @ (MQ!) (MQ-HDR)+3 a! @ (MQ!)
(MQ-HDR)+4 a! @ (MQ!) (MQ-HDR)+5 a! @ (MQ!) (MQ-HDR)+6 a! @ (MQ!) (MQ-HDR)+7 a! @ (MQ!)
pop if NOTEXT -1 + FOR @b (MQ!) NEXT ;
NOTEXT: drop ;
FULL: drop if GONE -1 + FOR @b drop UNEXT jump LOSE
GONE: drop
LOSE: (LOST) a! @ 1 + ! ;
\ ( port -- ) wait until a message may be begun on the port, by its
\ address, taking in whatever is being written to this node meanwhile; and
\ leave B at the port. The port is kept in (GATE-PORT), not on the stack:
\ this is run with the stack as full as EMIT may be.
: (GATE)
(GATE-PORT) a! !
L: (WRITERS) b! @b if QUIET
(LOW) (PORT) + dup b! @b (TAKE) jump L
QUIET: drop
(GATE-PORT) a! @ (PORT) - (NEAR) + a! @ if ASK
(ME) a! @ - -if GO jump ASK \ its number less this node's
GO: drop (GATE-PORT) a! @ b! ; \ the neighbour's is the higher
ASK: drop
(READERS) b! @b (GATE-PORT) a! @ (PORT) - (BIT) if NOTYET
drop (GATE-PORT) a! @ b! ; \ it is waiting to read
NOTYET: drop jump L
\ ( type -- ) words 1 to 5 of a message this node sends: from, type, and
\ the three that are carried and not used yet. Its caller has put B at the
\ port and sent word 0, whom it is to, and sends the length and the text.
@@ -142,7 +234,7 @@ header CMOVE
\ lowest. quit.v4 sets those two when text for this node arrives.
: (FLUSH-OUT)
(OUT^) a! @ (OUT) xor if NONE drop
(PRINT-PORT) a! @ b! (PRINT-TO) a! @ !b
(PRINT-PORT) a! @ (GATE) (PRINT-TO) a! @ !b
2 (HDR)
(OUT^) a! @ (OUT) - dup !b
3 + 2/ 2/ -1 + (OUT) a!
v4/capsule/quit.v4
+37 -27
View File
@@ -65,7 +65,7 @@ macro R-CLEAR RSTACK-DEPTH b! a !b endmacro
: (FINISH) ( s -- )
(LINE-STATUS) b! dup !b
(FLUSH-OUT)
(DONE-PORT) a! @ b! (MSG)+1 a! @ !b \ to whoever sent the text
(DONE-PORT) a! @ (GATE) (MSG)+1 a! @ !b \ to whoever sent the text
3 (HDR) 4 !b !b \ a message of type 3, four characters long: how it ended
jump (IDLE)
@@ -78,29 +78,30 @@ macro R-CLEAR RSTACK-DEPTH b! a !b endmacro
OK: drop 1 jump (FINISH)
GO: drop 0 jump (FINISH)
\ ( -- ) WAITING. A node with nothing to do is blocked reading its ports
\ (docs/v4.0.0/MESH.md 4.1): it executes nothing until a neighbour writes.
\ What arrives is a message (core.v4). Its first word is taken from any
\ port and the rest from the port that came on. Its text goes into TIB,
\ which holds 1024 characters, the most a message carries; a longer one is
\ read to its end, so that what follows it is not taken for a message, and
\ is error 12. A message of type 1 for this node is text to interpret: it
\ is done as a line was, and (FINISH) reports how it ended. A message for
\ another node is passed on, (PASS-ON).
\ ( -- ) WAITING. A node with nothing to do deals with the oldest of the
\ messages waiting (core.v4). With none waiting it is blocked reading its
\ ports (docs/v4.0.0/MESH.md 4.1): it executes nothing until a neighbour
\ writes, and what arrives is taken in as any message is, its first word
\ from any port and the rest from the port that came on. The message's
\ text goes into TIB, which holds 1024 characters, the most a message
\ carries; one that came with a length no message has is error 12. A
\ message of type 1 for this node is text to interpret: it is done as a
\ line was, and (FINISH) reports how it ended. A message for another node
\ is passed on, (PASS-ON).
: (IDLE)
(PORT)+8 b! @b (MSG) a! !+ \ to, from any port
(PORT)+9 b! @b (PORT) + dup b! \ B: the port it came on
5 FOR @b !+ UNEXT \ from, type, heat and TTL, ACL tag, sequence, length
(REPLY) a! !
(MSG)+6 a! @ -if SIZED jump BAD \ a length below zero: no telling what follows
SIZED: dup -1025 + -if LONG drop jump FITS
LONG: drop 3 + 2/ 2/ -1 + FOR @b drop UNEXT 0 \ too long: read it and let it go
BAD: drop 0 (MSG)+6 a! ! 0 SPAN a! ! NODE-ERROR b! 12 !b
FITS:
3 + 2/ 2/ if EMPTY
-1 + TIB 2/ 2/ a! FOR @b !+ UNEXT
jump READ
EMPTY: drop
L: (MQ#) a! @ if WAIT drop jump HAVE
WAIT: drop (PORT)+8 b! @b (PORT)+9 b! @b (PORT) + dup b! \ ( to port ) B: the port it came on
SWAP (TAKE) jump L
HAVE:
(MQ@) (MSG) a! ! (MQ@) (MSG)+1 a! ! (MQ@) (MSG)+2 a! ! (MQ@) (MSG)+3 a! !
(MQ@) (MSG)+4 a! ! (MQ@) (MSG)+5 a! ! (MQ@) (MSG)+6 a! ! (MQ@) (REPLY) a! !
(MSG)+6 a! @ -if SIZED
drop 0 (MSG)+6 a! ! 0 SPAN a! ! NODE-ERROR b! 12 !b \ no telling what it was
SIZED: drop
TIB 2/ 2/ (MSG)+6 a! @ 3 + 2/ 2/ if EMPTY
-1 + FOR (MQ@) over a! ! 1 + NEXT
drop jump READ
EMPTY: drop drop
READ:
0 (MSG)+6 a! @ TIB + C! \ a zero after the text
(MSG)+6 a! @ SPAN a! !
@@ -124,7 +125,7 @@ macro R-CLEAR RSTACK-DEPTH b! a !b endmacro
\ known it is let go, and (LOST) counts it.
: (PASS-ON)
(MSG) a! @ (PORT-FOR) if NOWAY
b! (MSG) a! 6 FOR @+ !b UNEXT \ its seven words
(GATE) (MSG) a! 6 FOR @+ !b UNEXT \ its seven words
(MSG)+6 a! @ 3 + 2/ 2/ if SENT
-1 + TIB 2/ 2/ a! FOR @+ !b UNEXT \ and its text
jump (IDLE)
@@ -156,6 +157,16 @@ header ROUTE
(ROUTE#) a! @ 1 + ! ;
FULL: drop drop drop NODE-ERROR b! 12 !b ;
\ ( node port -- ) the node on the other end of the port, by its number;
\ 0: none, or a device. Whoever wires the node tells it, and tells it again
\ when the wiring changes. It is what lets one of two neighbours, and one
\ only, wait to write to the other (core.v4, (GATE)).
header NEIGHBOUR
: NEIGHBOUR
dup -if POS jump BAD
POS: -PORTS + -if BAD drop (NEAR) + a! ! ;
BAD: drop drop drop NODE-ERROR b! 12 !b ;
\ ( port -- ) the port, by its number, leads toward every node not told of
header DEFAULT-ROUTE
: DEFAULT-ROUTE (PORT) + (ROUTE-DEFAULT) a! ! ;
@@ -167,12 +178,11 @@ header NO-ROUTES
\ ( baddr u node -- ) send the node u characters of text to interpret. It
\ is on its way when SEND returns; what it prints there goes to that node's
\ console. With no way to the node it is error 12. The write waits for the
\ neighbour to read: a neighbour that is itself waiting to write to this
\ node will wait for ever, and so will this one.
\ neighbour to read, and is not begun until it may be (core.v4, (GATE)).
header SEND
: SEND
dup (PORT-FOR) if NOWAY
b! !b \ to
(GATE) !b \ to
1 (HDR)
dup !b \ length
3 + 2/ 2/ if NONE -1 +
v4/include/v4/node.h
+14
View File
@@ -109,6 +109,8 @@ typedef struct {
v4_cell given_value;
unsigned given_port;
unsigned last_from; /* the port the last read from "any" took its word from */
unsigned writers; /* bit k: the neighbour on port k is blocked writing to this node */
unsigned readers; /* bit k: the neighbour on port k is blocked reading from this node */
/* DSTACK-DEPTH and RSTACK-DEPTH (D-16). See v4_node_stack_regs_attach. */
v4_cell dstack_reg; /* its word address, or -1 */
@@ -181,6 +183,13 @@ void v4_node_console_attach(v4_node *n, v4_cell addr);
* base + V4_PORTS "any port": a read here takes from whichever port
* has a neighbour writing
* base + V4_PORTS + 1 which port the last read from "any" came from
* base + V4_PORTS + 2 which ports have a neighbour waiting to write to this
* node: bit k for port k
* base + V4_PORTS + 3 which ports have a neighbour waiting to read from it
* The last two are how a node looks before it writes (MESH.md 7a), as the
* F18's io register lets it. They are what whoever connects the ports last
* said, v4_node_port_status; fetching them waits for nothing and changes
* nothing.
* (read only)
* None of them is memory while the ports are attached.
*
@@ -213,6 +222,11 @@ void v4_node_port_served(v4_node *n);
* port or "any", is unblocked and will fetch it. */
void v4_node_port_give(v4_node *n, unsigned port, v4_cell value);
/* What is on the other end of the node's ports now: bit k of `writers` if
* the neighbour on port k is blocked writing to this node, bit k of
* `readers` if it is blocked reading from it and would take a word. */
void v4_node_port_status(v4_node *n, unsigned writers, unsigned readers);
/* Which port `addr` is: 0 .. V4_PORTS - 1, V4_PORT_ANY, V4_PORTS + 1 for the
* "which port" address, or -1 if it is none of them. */
int v4_node_port_index(const v4_node *n, v4_cell addr);
v4/src/fabric.c
+24
View File
@@ -155,10 +155,34 @@ static unsigned hand_over_read(v4_fabric *f, unsigned a)
return 0;
}
/* What node `a` can see of its neighbours before it executes: who is
* blocked writing to it, and who would take a word from it. A device is
* always ready to be written to; what it has to give, the node finds when
* it reads. */
static void look_about(v4_fabric *f, unsigned a)
{
unsigned k, writers = 0, readers = 0;
for (k = 0; k < V4_PORTS; k++) {
const v4_wire *w = &f->place[a].wire[k];
if (w->kind == V4_WIRE_DEVICE) {
if (w->device->take) readers |= 1u << k;
} else if (w->kind == V4_WIRE_NODE && awake(f, w->node)) {
const v4_node *o = &f->place[w->node].node->n;
if (o->asking && o->ask_port == w->port) writers |= 1u << k;
if (o->reading && !o->given && (o->read_port == w->port || o->read_port == V4_PORT_ANY)) readers |= 1u << k;
}
}
v4_node_port_status(&f->place[a].node->n, writers, readers);
}
unsigned v4_fabric_step(v4_fabric *f)
{
unsigned i, done = 0;
for (i = 0; i < f->capacity; i++)
if (awake(f, i)) look_about(f, i);
for (i = 0; i < f->capacity; i++)
if (awake(f, i)) done += v4_exec_step_word(&f->place[i].node->n, &f->place[i].node->es, &f->place[i].node->h);
v4/src/node.c
+12 -2
View File
@@ -159,6 +159,8 @@ v4_cell v4_node_fetch(v4_node *n, v4_cell addr)
{
int port = v4_node_port_index(n, addr);
if (port == (int)V4_PORTS + 1) return (v4_cell)n->last_from;
if (port == (int)V4_PORTS + 2) return (v4_cell)n->writers;
if (port == (int)V4_PORTS + 3) return (v4_cell)n->readers;
if (port >= 0) {
/* the word its neighbour wrote; v4_node_read_ready has said it is there */
if (!n->given) return 0;
@@ -214,18 +216,26 @@ void v4_node_port_attach(v4_node *n, v4_cell base)
n->given_value = 0;
n->given_port = 0;
n->last_from = 0;
n->writers = 0;
n->readers = 0;
}
void v4_node_port_status(v4_node *n, unsigned writers, unsigned readers)
{
n->writers = writers;
n->readers = readers;
}
int v4_node_port_index(const v4_node *n, v4_cell addr)
{
if (n->port < 0 || addr < n->port || addr > n->port + (v4_cell)V4_PORTS + 1) return -1;
if (n->port < 0 || addr < n->port || addr > n->port + (v4_cell)V4_PORTS + 3) return -1;
return (int)(addr - n->port);
}
int v4_node_read_ready(v4_node *n, v4_cell addr)
{
int port = v4_node_port_index(n, addr);
if (port < 0 || port == (int)V4_PORTS + 1) return 1;
if (port < 0 || port > (int)V4_PORT_ANY) return 1;
if (n->given && (port == (int)V4_PORT_ANY || (unsigned)port == n->given_port)) return 1;
n->reading = 1;
n->read_port = (unsigned)port;
v4/system/boot.c
+4
View File
@@ -365,6 +365,10 @@ int v4_boot_run(const v4_boot *b, unsigned char *disk, unsigned blocks)
say(b, "V4: the nucleus is not for this build of the engine\nPARITY:FAIL\nPOST: FAILED\n");
return 0;
}
/* what is on its two ports, the kernel and the console, takes a word
* when it is written: the node need never wait before writing to them
* (node.h, v4_node_port_status) */
v4_node_port_status(b->n, 0, 1u << KERNEL_PORT | 1u << CONSOLE_PORT);
if (!load_nucleus(b)) { say(b, "PARITY:FAIL\nPOST: FAILED\n"); return 0; }
/* the kernel's words, before any capsule that might use one */
v4/tests/host_map.h
+31 -3
View File
@@ -74,8 +74,18 @@
#define ROUTE_DEFAULT (BUF0_W - 18) /* the port address for a node not in the table, or 0: there is none */
#define LOST (BUF0_W - 19) /* how many messages have been let go for want of a way */
#define PRINT_TO (BUF0_W - 20) /* where what the text being served prints is to go: the node, */
#define PRINT_PORT (BUF0_W - 21) /* and the port address that leads there */
#define DONE_PORT (BUF0_W - 22) /* the port address that leads back to whoever sent the text being served */
#define WRITERS (PORT + (v4_cell)V4_PORTS + 2) /* which ports have a neighbour waiting to write to this node (node.h) */
#define READERS (PORT + (v4_cell)V4_PORTS + 3) /* and which have one waiting to read from it */
#define PRINT_PORT (BUF0_W - 33) /* and the port address that leads there */
#define DONE_PORT (BUF0_W - 34) /* the port address that leads back to whoever sent the text being served */
#define MQ_HEAD (BUF0_W - 35) /* the messages waiting to be dealt with: where the oldest begins, */
#define MQ_TAIL (BUF0_W - 36) /* where the next will go, */
#define MQ_COUNT (BUF0_W - 37) /* and how many cells they take */
#define GATE_PORT (BUF0_W - 38) /* the port address a message is about to be begun on */
#define NEAR (BUF0_W - 64) /* for each port, the number of the node on the other end; 0: not told */
#define MQ_HDR (BUF0_W - 56) /* a message being taken in: its seven words and the port it came on */
#define MQ_W (OUT_W - 400) /* the messages waiting: each is its seven words, the port it came on, its text */
#define MQ_CELLS 400
#define ROUTES (BUF0_W - 96) /* the table of ways: 16 entries of a node and the port address that leads to it */
#define ROUTE_MAX 16
#define ME (BUF0_W - 13) /* this node's number: a message is for it when its first word is this */
@@ -90,6 +100,10 @@
#define BOOT_CELLS (BVARS + 14) /* (BOOT): DP and LATEST as the loader left them, 2 cells */
#define BUF0_W (BVARS - 2 * 256) /* the two block buffers, 256 cells each */
#define BUF1_W (BUF0_W + 256)
/* the ports' ten addresses and the two that follow them end below BUF0_W - 20 */
typedef char host_map_ports_fit[(V4_PORTS <= 8u) ? 1 : -1];
/* Nothing printed and no message waiting: a node's variables for them, as at switch-on. */
#define HOST_MESSAGES_EMPTY(n) do { (n)->mem[OUT_PTR] = OUT_W; (n)->mem[MQ_HEAD] = MQ_W; (n)->mem[MQ_TAIL] = MQ_W; (n)->mem[MQ_COUNT] = 0; } while (0)
#define QVARS (BUF0_W - 4) /* (Q): quit.v4, system.v4 and blocks.v4, 4 cells */
#define WBUF (WBUF_W * 4)
#define TIB (TIB_W * 4)
@@ -103,6 +117,8 @@
#ifndef DICT_END_W
#define DICT_END_W ((v4_cell)14336)
#endif
/* the messages waiting are above the dictionary */
typedef char host_map_queue_fits[(MQ_W >= DICT_END_W) ? 1 : -1];
/* How many slots, from slot 0, a branch may sit in on a node this size: those
* whose address field reaches every word of it. */
@@ -123,7 +139,7 @@ static int host_load(v4_text *tx, v4_node *n, const char *const *files, unsigned
unsigned i;
v4_node_reset(n);
n->mem[OUT_PTR] = OUT_W; /* nothing has been printed: what is, is kept from here (core.v4) */
HOST_MESSAGES_EMPTY(n); /* nothing has been printed and no message waits (core.v4) */
v4_text_begin(tx, n, 16);
v4_text_constant(tx, "N-1", V4_CELL_BITS - 1);
v4_text_constant(tx, "NODE-ERROR", NODE_ERROR);
@@ -173,6 +189,18 @@ static int host_load(v4_text *tx, v4_node *n, const char *const *files, unsigned
v4_text_constant(tx, "(PRINT-PORT)", PRINT_PORT);
v4_text_constant(tx, "(DONE-PORT)", DONE_PORT);
v4_text_constant(tx, "(ROUTES)", ROUTES);
v4_text_constant(tx, "(WRITERS)", WRITERS);
v4_text_constant(tx, "(READERS)", READERS);
v4_text_constant(tx, "-PORTS", -(v4_cell)V4_PORTS);
v4_text_constant(tx, "(NEAR)", NEAR);
v4_text_constant(tx, "(GATE-PORT)", GATE_PORT);
v4_text_constant(tx, "(MQ)", MQ_W);
v4_text_constant(tx, "(MQ-END)", MQ_W + MQ_CELLS);
v4_text_constant(tx, "-MQ-ROOM", -(v4_cell)(MQ_CELLS - 7)); /* cells taken + a text's words + this is below zero while the message fits */
v4_text_constant(tx, "(MQ-HEAD)", MQ_HEAD);
v4_text_constant(tx, "(MQ-TAIL)", MQ_TAIL);
v4_text_constant(tx, "(MQ#)", MQ_COUNT);
v4_text_constant(tx, "(MQ-HDR)", MQ_HDR);
v4_text_constant(tx, "(OUT^)", OUT_PTR);
v4_text_constant(tx, "(REPLY)", REPLY);
v4_text_constant(tx, "(MSG)", MSG);
v4/tests/test_fabric.c
+23
View File
@@ -331,6 +331,29 @@ int main(void)
"a port that is not there, a node that is not there, a port to itself: refused");
CHECK(v4_fabric_wire(&f, a, 1, a, 2), "but one port of a node may be wired to another of the same node");
/* ---- a node looks at its neighbours before it writes (MESH.md 7a) ---- */
v4_fabric_init(&f, places, 4);
a = loaded(0); LIT(PB + 0); O(BANG_B); LIT(5); O(STORE_B); wait_for_ever(); /* writes to its port 0 */
c = loaded(1); LIT(PB + 1); O(BANG_B); O(FETCH_B); LIT(OUT); O(BANG_A); O(STORE_A); wait_for_ever(); /* reads its port 1 */
for (i = 0; i < 10; i++) (void)v4_fabric_step(&f);
CHECK(ND(a)->n.asking && ND(c)->n.reading, "one node is waiting to write and another to read");
b = loaded(2);
LIT(PB + (v4_cell)V4_PORTS + 2); O(BANG_B); O(FETCH_B); LIT(OUT); O(BANG_A); O(STORE_A);
LIT(PB + (v4_cell)V4_PORTS + 3); O(BANG_B); O(FETCH_B); LIT(OUT + 1); O(BANG_A); O(STORE_A);
wait_for_ever();
CHECK(v4_fabric_wire(&f, b, 2, a, 0) && v4_fabric_wire(&f, b, 4, c, 1), "a third is wired to both");
{
static stream none;
static v4_device sink;
sink.take = stream_take; sink.give = 0; sink.self = &none;
CHECK(v4_fabric_wire_device(&f, b, 6, &sink), "and to a device that takes what is written to it");
}
for (i = 0; i < 20; i++) (void)v4_fabric_step(&f);
CHECK(ND(b)->n.mem[OUT] == (1 << 2), "it sees which of its ports has a neighbour waiting to write to it: %ld", (long)ND(b)->n.mem[OUT]);
CHECK(ND(b)->n.mem[OUT + 1] == ((1 << 4) | (1 << 6)), "and which have one waiting to read from it, or a device: %ld", (long)ND(b)->n.mem[OUT + 1]);
CHECK(ND(a)->n.asking && ND(a)->n.request == 5 && ND(c)->n.reading && ND(c)->n.mem[OUT] == 0, "looking takes nothing and gives nothing: both wait as they did");
CHECK(!ND(b)->n.stopped && ND(b)->n.reading, "and the one that looked did not wait to look");
printf(" %d checks, %d failures\n", checks, failures);
return failures != 0;
}
v4/tests/test_host_mesh.c
+62 -15
View File
@@ -14,6 +14,7 @@
#include "v4/message.h"
#include "v4/text.h"
#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#include "host_map.h"
@@ -126,7 +127,7 @@ int main(void)
nucleus.mem[CURRENT] = LATEST;
nucleus.mem[SRC] = TIB;
nucleus.mem[LINE_STATUS] = 1;
nucleus.mem[OUT_PTR] = OUT_W;
HOST_MESSAGES_EMPTY(&nucleus);
v4_fabric_init(&f, places, 3);
hera = starforth_node(0);
@@ -196,22 +197,68 @@ int main(void)
CHECK(strcmp(tell(12, "5 5 + ."), "10 ") == 0 && pool[1].es.anticlock == before, "text for it no longer passes through the middle node, which executes nothing");
}
/* ---- WHAT DOES NOT WORK: two neighbours that write to each other at once ----
/* ---- two neighbours with something for each other at the same moment ----
* A write blocks until the neighbour reads, and a node that is writing
* is not reading. Here the far node sends text to the middle one and
* then goes to send word of how its own text ended, which goes by the
* middle one; the middle one does the text and goes to answer the far
* one. Each waits for the other to read, for ever. It is the same
* whenever messages go both ways on a wire at once, and it is because
* passing a message on is done here by the node's own programme
* (v4/capsule/quit.v4, (PASS-ON)), which cannot pass anything on while
* it waits to write. docs/v4.0.0/MESH.md, step 4. This check is here
* so that the fault is on record and is seen to go when it is put
* right. */
* is not reading: so a node looks before it begins a message, and of
* two neighbours only the one with the lower number may wait to write
* to the other (v4/capsule/core.v4, (GATE); docs/v4.0.0/MESH.md 7a).
* Each node is told who is on each of its ports. */
CHECK(is_empty(tell(10, "NO-ROUTES 1 1 ROUTE 11 2 ROUTE 12 2 ROUTE")) && is_empty(tell(12, "NO-ROUTES 2 DEFAULT-ROUTE")), "the row of three again");
(void)tell(12, ": HI S\" 72 EMIT\" 11 SEND ; HI");
CHECK(pool[1].n.asking && pool[1].n.ask_port == 3 && pool[2].n.asking && pool[2].n.ask_port == 2,
"KNOWN FAULT: two neighbours each writing to the other wait for ever");
CHECK(is_empty(tell(10, "11 2 NEIGHBOUR 0 3 NEIGHBOUR")) && is_empty(tell(11, "10 2 NEIGHBOUR 12 3 NEIGHBOUR")) && is_empty(tell(12, "11 2 NEIGHBOUR 0 3 NEIGHBOUR")),
"each is told who is on the other end of its ports");
CHECK(strstr(tell(10, "11 8 NEIGHBOUR"), "Argument out of range") != NULL && strstr(tell(10, "11 -1 NEIGHBOUR"), "Argument out of range") != NULL,
"a port a node has not got is an error");
/* the far node sends the middle one text, and then word of how its own
* text ended, which goes by the middle one; the middle one does the
* text and answers the far one: the two messages meet on one wire */
CHECK(strcmp(tell(12, ": HI S\" 72 EMIT\" 11 SEND ; HI"), "H") == 0 && printed_from == 11 && ended == 1 && ended_from == 12,
"from the far end to the middle, with the answers crossing: \"%s\" from %ld", printed, (long)printed_from);
CHECK(waiting(hera) && waiting(mid) && waiting(far), "and all three are waiting again");
/* every node sends every other a number of messages, all at once: each
* counts what it is sent */
CHECK(is_empty(tell(10, "VARIABLE GOT : HIT 1 GOT +! ; VARIABLE WHO VARIABLE SENT : BURST WHO ! 0 DO S\" HIT\" WHO @ SEND 1 SENT +! LOOP ;")) &&
is_empty(tell(11, "VARIABLE GOT : HIT 1 GOT +! ; VARIABLE WHO VARIABLE SENT : BURST WHO ! 0 DO S\" HIT\" WHO @ SEND 1 SENT +! LOOP ;")) &&
is_empty(tell(12, "VARIABLE GOT : HIT 1 GOT +! ; VARIABLE WHO VARIABLE SENT : BURST WHO ! 0 DO S\" HIT\" WHO @ SEND 1 SENT +! LOOP ;")), "each node is given a word to count with and one to send with");
{
const char *r = tell(10, ": GO S\" 6 10 BURST 6 12 BURST\" 11 SEND S\" 6 11 BURST 6 10 BURST\" 12 SEND 6 11 BURST 6 12 BURST ; GO");
CHECK(is_empty(r), "six messages from each node to each other, all at once: \"%s\"", r);
CHECK(waiting(hera) && waiting(mid) && waiting(far), "all three come to rest");
CHECK(strcmp(tell(10, "GOT @ . (LOST) @ ."), "12 1 ") == 0 && strcmp(tell(11, "GOT @ . (LOST) @ ."), "12 0 ") == 0 && strcmp(tell(12, "GOT @ . (LOST) @ ."), "12 0 ") == 0,
"every one of them arrived, and none was let go: \"%s\"", printed);
}
/* ---- more than a node has room to keep ----
* A node that takes messages in while it waits to write keeps them, and
* when it has no room for one more it lets that one go and counts it.
* Far more are sent here than the nodes can keep. */
{
long got = 0, lost = 0, sent = 0, v;
unsigned k;
static const v4_cell who[3] = { 10, 11, 12 };
const char *r;
CHECK(is_empty(tell(10, "0 GOT ! 0 SENT !")) && is_empty(tell(11, "0 GOT ! 0 SENT !")) && is_empty(tell(12, "0 GOT ! 0 SENT !")), "the counts begin again");
r = tell(10, ": GO2 S\" 200 10 BURST 200 12 BURST\" 11 SEND S\" 200 11 BURST 200 10 BURST\" 12 SEND 200 11 BURST 200 12 BURST ; GO2");
CHECK(strcmp(r, "(still running)") != 0, "two hundred from each to each: it ends");
CHECK(waiting(hera) && waiting(mid) && waiting(far), "and all three come to rest, none waiting to write");
for (k = 0; k < 3; k++) {
r = tell(who[k], "GOT @ .");
v = strtol(r, NULL, 10); got += v;
CHECK(v > 0 && v <= 400, "node %ld took %ld of the 400 for it", (long)who[k], v);
r = tell(who[k], "(LOST) @ .");
lost += strtol(r, NULL, 10);
r = tell(who[k], "SENT @ .");
sent += strtol(r, NULL, 10);
CHECK(pool[k].n.mem[MQ_COUNT] == 0, "node %ld has none left waiting", (long)who[k]);
}
lost -= 1; /* the one for node 99, earlier */
/* what is let go is of every kind: the text that would have set a
* node sending, the answers to text, as well as what was sent */
printf(" of %ld messages the nodes sent each other at once %ld arrived; %ld messages of all kinds were let go for want of room\n", sent, got, lost);
CHECK(lost > 0, "there was not room for all of them");
CHECK(got <= sent && got + lost >= sent, "every message sent either arrived or was counted: %ld sent, %ld arrived, %ld let go", sent, got, lost);
CHECK(strcmp(tell(12, "7 8 * ."), "56 ") == 0 && printed_from == 12, "and the nodes go on as before");
}
printf(" %d checks, %d failures\n", checks, failures);
return failures != 0;
v4/tests/test_host_quit.c
+4 -3
View File
@@ -160,7 +160,7 @@ static int text_ended; /* how the text ended, when it has */
/* 1 if the node is where it waits for a message, with nothing given it. */
static int node_idle(void)
{
return n.reading && !n.given && n.read_port == V4_PORT_ANY && n.p > w_idle && n.p <= w_idle + 3;
return n.reading && !n.given && n.read_port == V4_PORT_ANY && n.p > w_idle && n.p <= w_idle + 8; /* in the first words of (IDLE), where it reads */
}
/* Run until the text ends, or until it has been inside KEY with nothing to
@@ -239,20 +239,21 @@ static void boot_with(unsigned depth)
for (i = 0; i < depth; i++) v4_dstack_push(&n.ds, (v4_cell)(0x5A000000 + i));
v4_dstack_push(&n.ds, CANARY);
v4_node_port_attach(&n, PORT);
v4_node_port_status(&n, 0, 1u | 1u << CONSOLE_PORT); /* the kernel and the console take what is written when it is written */
n.mem[WORD_DEFINED] = 0; /* no one is told of entries, until a test says so */
n.mem[WORD_FORGOTTEN] = 0;
known_n = 0;
last_request = 0;
n.mem[LINE_STATUS] = 1;
n.mem[ME] = 0; /* it has no number yet: a message to 0 is for it */
n.mem[OUT_PTR] = OUT_W;
HOST_MESSAGES_EMPTY(&n);
n.mem[REPLY] = PORT + CONSOLE_PORT;
n.p = w_idle; /* waiting for a message */
typed_len = 0;
line_open = 0;
to_node.count = 0; to_sent = 0; from_node.count = 0;
shown_len = 0; shown_dropped = 0;
(void)v4_exec_step_word(&n, &es, &h); /* it reads its ports, and is blocked */
for (i = 0; i < 8 && !n.reading; i++) (void)v4_exec_step_word(&n, &es, &h); /* no message waits: it reads its ports, and is blocked */
}
static void boot(void) { boot_with(0); }
/* The same with nothing at all on the data stack. */
v4/tools/mkimage.c
+1 -1
View File
@@ -99,7 +99,7 @@ int main(int argc, char **argv)
if (!v4_node_guards_intact(&n)) die("the node's guards are damaged", NULL);
n.mem[LINE_STATUS] = 1; /* nothing has ended badly */
n.mem[OUT_PTR] = OUT_W; /* nothing has been printed */
HOST_MESSAGES_EMPTY(&n); /* nothing has been printed, no message waits */
/* the nucleus as a capsule of F18 code: the words a neighbour writes to
* an empty node's port, each in V4_CELL_BITS / 8 bytes, low byte first */
v4/tools/post79_rules.py
+33
View File
@@ -67,6 +67,19 @@ STANDARD = {
"MOVE.basic": dict(text="65 HERE ! 66 HERE 1+ ! HERE HERE 16 + 2 MOVE HERE 16 + @ . HERE 17 + @ . CR",
out="65 66 \n", why="FORTH-79: MOVE moves cells; and " + D1),
"PAD.usable": None, # see OPEN below
# see OPEN below: HERE handed to a word that takes a byte address
"C!.basic": None,
"C!.zero": None,
"C!.high_byte": None,
"C!.truncation": None,
"C@.after_cstore": None,
"C@.zero_byte": None,
"FILL.basic": None,
"FILL.zero_byte": None,
"CMOVE.overlap": None,
"TYPE.single_char": None,
"COUNT.string_bounds": None,
"COUNT.zero_addr_plus_one": None,
"BASE.base_store": dict(out="255 \n", why="255 read in base 16 and printed in base 16 is 255; v3 printed 467"),
@@ -123,9 +136,29 @@ STANDARD = {
"LEAVE.qdloop": dict(out="3 \n", why=LEAVE),
}
# Found 2026-10-06 (docs/v4.0.0/MESH.md section 10, step 4): on v4 HERE is a
# cell address and C! C@ FILL CMOVE COUNT TYPE take byte addresses, so these
# cases wrote into, or read from, the nucleus's own code at cell HERE/4 --
# and passed, reading back what they had written there. Ruled: left out
# until how HERE and the byte words agree is settled, as its own step.
HERE_BYTE = ("OPEN: HERE is a cell address on v4 and this word takes a byte address (D-1): "
"the case wrote to or read from the nucleus's code at cell HERE/4")
# Dropped, and why. mkpost.py prints these with the cases it leaves out.
DROPPED = {
"PAD.usable": "OPEN: PAD 42 OVER ! faults on v4 -- PAD is a byte address and ! takes a cell address (D-1)",
"C!.basic": HERE_BYTE,
"C!.zero": HERE_BYTE,
"C!.high_byte": HERE_BYTE,
"C!.truncation": HERE_BYTE,
"C@.after_cstore": HERE_BYTE,
"C@.zero_byte": HERE_BYTE,
"FILL.basic": HERE_BYTE,
"FILL.zero_byte": HERE_BYTE,
"CMOVE.overlap": HERE_BYTE,
"TYPE.single_char": HERE_BYTE,
"COUNT.string_bounds": HERE_BYTE,
"COUNT.zero_addr_plus_one": HERE_BYTE,
"CMOVE.bounds": "moves 1000 bytes over the system; v3 refuses by a bounds rule FORTH-79 has not got",
}
for _name in [k for k, v in STANDARD.items() if v is None and k.startswith("WORD.")]: