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

Star forth v4.0.0 #3

Closed
admin wants to merge 136 commits from StarForth-v4.0.0 into master
pull from: StarForth-v4.0.0
merge into: :master
Conversation 0 Commits 136 Files Changed 806
+820 -17
11 changed files with 820 additions and 17 deletions
Download Patch File Download Diff File Expand all files Collapse all files
Showing only changes of commit 630d03fa4e - Show all commits
capsules/BLOCK_MAP.md
+1 -1
View File
@@ -1,5 +1,5 @@
# Capsule Block Manifest — Auto-generated
<!-- Generated by mkcapsule --manifest 2026-10-06T15:15:54Z -->
<!-- Generated by mkcapsule --manifest 2026-10-06T15:58:11Z -->
<!-- DO NOT EDIT — re-run mkcapsule --manifest to refresh. -->
<!-- Hand-written justifications and immutability notes live -->
<!-- in MANIFEST.md alongside this auto-generated index. -->
capsules/v4/nucleus-64.f18
BIN
View File
Binary file not shown.
docs/v4.0.0/MESH.md
+71
View File
@@ -213,6 +213,39 @@ outer nodes, and for each other unit the port toward that unit's centre.
A different geometry is a different way of filling in the wiring table
and these tables. Nothing else changes.
## 7a. Two neighbours writing to each other (open; awaits a ruling)
The fault is in section 10, step 4. Three ways out, none built:
**A. A node writes only to a neighbour that is already reading.** The
engine gives a node two more things to fetch, as the F18's `io` register
does: which ports have a neighbour writing, and which have a neighbour
reading. A node with a message to send looks first. If the neighbour is
reading, it writes, and the write does not wait. If the neighbour is
writing to it instead, it takes that message in first, and deals with it,
and looks again. A node therefore holds messages waiting to go, in its own
memory, and what it does when that room is full has to be decided (the
message is lost and counted, as one with nowhere to go is now). Writes
still block, as ruled; a node simply does not start one it cannot finish.
This is how it is done on the chip. It is all in the nucleus but for the
two fetches.
**B. Passing on is not the node's programme's work.** `DECOMPOSITION.md`
6.1 says "the router in each node forwards packets". Read as a thing apart
from the programme -- logic beside the F18 on the FPGA, a part of the
fabric in the model -- it takes in and sends on whatever the programme is
doing, and holds what is for the programme until it reads. The programme's
own writes then never wait on a neighbour's programme. This is more
hardware per node and takes passing-on out of F18 code, and out of what a
capsule can change.
**C. No answer to a `SEND`.** It removes the case found and leaves the
fault: any two messages crossing still stop both nodes. Not offered as a
way out; listed so that it is seen to have been weighed.
Recommended: A. It keeps every ruling as it stands, keeps a node an F18
and nothing more, and what it adds to the engine the chip already has.
## 8. Storage
**Proposal.** A disk is a device on a port. Asking for a block is a
@@ -311,6 +344,44 @@ Each is tested, committed and pushed before the next.
input registers, not a message. A message not for this node, or not
text, is let go: passing it on is step 4.
4. **Finding the way (section 7).**
**Built 2026-10-06; NOT done: one fault stands, below, and it needs a
ruling.** Each node has a table of up to 16 destinations and the port
toward each, and one port for everything else (`ROUTE ( node port -- )`,
`DEFAULT-ROUTE ( port -- )`, `NO-ROUTES`; `(PORT-FOR)` in
`v4/capsule/core.v4`). A message not for this node is written, whole,
to the port its destination's entry names (`(PASS-ON)`,
`v4/capsule/quit.v4`); with no entry and no port for everything else it
is dropped and counted (`(LOST)`). What text prints, and how it ended,
go back to the node the text came from by the same table, so an answer
crosses as many nodes as the text did. `SEND ( baddr u node -- )` sends
text to another node; `(ME)` is a node's own number; `(CONSOLE)`, when
set, is where a node's printing goes instead of to the sender.
`v4/tests/test_host_mesh.c`, 28 checks at both widths and under ASan
and UBSan: three StarForth nodes in a row behind a console; text for
the far one passes through the other two and its answer comes back;
each node keeps its own dictionary; output longer than one message; a
1024-character message passed on whole; a message with nowhere to go
counted; a table changed while running. The single-node products are
unchanged: `hosted-check` on three ISAs; bare metal
`logs/20261006-115225` (amd64), `-115501` (aarch64), `-115849`
(riscv64).
**THE FAULT: two neighbours that write to each other at once wait for
ever.** A write blocks until the neighbour reads (ruling, section 4.1),
and a node that is blocked writing is not reading. Passing a message on
is done here by the node's own programme, so a node cannot pass
anything on, or take anything in, while it waits to write. Found so: the
far node `SEND`s 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 has
done the text and goes to answer the far one. Each is writing the first
word of a message to the other. It is not peculiar to `SEND`: any two
messages going opposite ways on one wire at the same moment do it, and
so would a ring of nodes each writing to the next. The last check in
`test_host_mesh.c` shows it and is named KNOWN FAULT; it is there so the
fault is on record and is seen to go.
It is not a slip in the code. It is what blocking writes and a
programme that does one thing at a time give. Section 7 said nothing
about it and should have. What is to be done about it is not decided:
the choices are in section 7a.
5. **Birth and Hera's requests (section 9); the unit of five.**
6. **Storage (section 8).**
7. **A second unit; scaling while running; sleep, wake and kill by
logs/20261006-115225/amd64/qemu-amd64-20261006-115225.log
+130
View File
@@ -0,0 +1,130 @@
[=3hBdsDxe: loading Boot0002 "UEFI QEMU DVD-ROM QM00005 " from PciRoot(0x0)/Pci(0x1F,0x2)/Sata(0x2,0xFFFF,0x0)
BdsDxe: starting Boot0002 "UEFI QEMU DVD-ROM QM00005 " from PciRoot(0x0)/Pci(0x1F,0x2)/Sata(0x2,0xFFFF,0x0)
[=3hStarKernel UEFI Loader
Loading kernel from ESP...
[CKPT 001] Entered efi_main - ConOut live
RAW SERIAL UP
[CKPT 002] Serial (COM1) initialized
Monolithic build - kernel linked directly
Collecting boot information...
CmdLine: parsed OK
[CKPT 004] Command line parsed
[CKPT 005] Kernel stack allocation decided
[CKPT 006] Boot info collected (ACPI table located)
GOP: linear framebuffer found
[CKPT 007] GOP: linear framebuffer found
[CKPT 008] About to enter ExitBootServices retry loop
EBS...
EBS OK
Calling kernel_main (monolithic)...
_____ _ _ __ _
/ ____| | | |/ / | |
| (___ | |_ __ _ _ __| ' / ___ _ __ _ __ ___| |
\___ \| __/ _` | '__| < / _ \ '__| '_ \ / _ \ |
____) | || (_| | | | . \ __/ | | | | | __/ |
|_____/ \__\__,_|_| |_|\_\___|_| |_| |_|\___|_|
LithosAnanke v2.1.0
Architecture: amd64
Build: Oct 6 2026 11:51:59
UEFI BootServices: EXITED
=== StarKernel Boot Information ===
Memory map entries: 131
Total memory: 1023 MB
Usable memory: 968 MB
===================================
PMM initialized.
PMM statistics:
Total pages: 249253
Free pages : 247730
Used pages : 1523
Total MB : 973
Free MB : 967
Used MB : 5
VMM initialized (mapped RAM, CR3 switched)
VMM initialized (mapped RAM, CR3 switched)
VMM self-test: mapped OK at 0xffff800000000000
VMM self-test complete.
IDT installed.
APIC: init...
APIC: IA32_APIC_BASE MSR=0x00000000fee00900
APIC: stale-ISR drain: 0 EOI(s) issued
APIC: initialized (xAPIC MMIO, TPR=0, SIVR=0x1FF, EOI-clear)
APIC: init done
I/O APIC: init...
I/O APIC: base=0xfec00000, gsi_base=0, overrides=5
override: source=00 gsi=2 flags=0x0000
override: source=05 gsi=5 flags=0x000d
override: source=09 gsi=9 flags=0x000d
override: source=0a gsi=10 flags=0x000d
override: source=0b gsi=11 flags=0x000d
i8042: keyboard ACKed enable-scanning
i8042: IRQ1 enabled in controller config byte
I/O APIC: keyboard IRQ1 routed (masked)
Timer: init...
Timer: init start
Timer: PM_TMR_BLK discovered from FADT at port 1544
Timer: VM mode detected (hypervisor present).
Timer: HPET calibration disabled (VM-exit MMIO would poison timing).
Timer: WARNING: invariant TSC not present under hypervisor.
Timer: continuing in RELATIVE mode (no determinism guarantees).
Timer: RDTSCP not present; using RDTSC (less serialized).
Timer: CPUID frequency unavailable; trying PM Timer...
Timer: trust=1 (0=NONE,1=REL,2=ABS), TSC=2118830204 Hz
Timer: init done
Kernel heap initialized.
Heap statistics:
Total bytes: 536870872
Free bytes: 536870872
Used bytes: 0
Peak bytes: 0
Heap base addr: 24641536
Heap end addr: 561512448
Heartbeat: init...
APIC Timer: calibrating...
APIC Timer: apic_hz=1019349401, tick_hz=100, initial_count=10193494
APIC Timer: configured (masked, ready to start)
Heartbeat: init done
Kernel initialization complete.
Boot successful!
StarForth v4: one host node, the F18-derived engine
V4: capsule v4:nucleus-64.f18 signature: missing (unsigned)
PARITY:V4_NUCLEUS name=v4:nucleus-64.f18 capsule_id=0x9653e727bf5cf8bd capsule_hash=0x9653e727bf5cf8bd words=305
V4: capsule v4:forth79.4th signature: missing (unsigned)
PARITY:V4_CAPSULE name=v4:forth79.4th capsule_id=0x4055641ee17d176b capsule_hash=0x4055641ee17d176b dict_hash=0x14a9ea7be071593b
V4: capsule v4:post79.4th signature: missing (unsigned)
PARITY:V4_POST tests=550 pass=550 fail=0
PARITY:V4_CAPSULE name=v4:post79.4th capsule_id=0xb987dbb4388990bd capsule_hash=0xb987dbb4388990bd dict_hash=0x721a93a6abb945f9
PARITY:OK
POST: PASSED
ok> : SQ DUP * ;
ok
ok> 7 SQ . 3 4 U* . .
49 0 12 ok
ok> COLD
FORTH-79 Cold Start
System initialized.
ok
ok> 3 4 U* . .
0 12 ok
ok> FORGET U*
Protected word
ERROR
ok> 9 KERNEL-WORD ASK9 ASK9
Argument out of range
ERROR
ok> BYE
BYE: cold restart
logs/20261006-115501/aarch64/qemu-aarch64-20261006-115501.log
+104
View File
@@ -0,0 +1,104 @@
UEFI firmware (version 2025.11-3ubuntu7.3 built at 15:40:26 on Sep 23 2026)
[=3hBdsDxe: failed to load Boot0002 "UEFI Misc Device" from PciRoot(0x0)/Pci(0x2,0x0): Not Found
BdsDxe: failed to load Boot0003 "UEFI QEMU QEMU USB HARDDRIVE 1-0000:00:04.0-1" from PciRoot(0x0)/Pci(0x4,0x0)/USB(0x0,0x0): Not Found
BdsDxe: loading Boot0004 "UEFI Misc Device 2" from PciRoot(0x0)/Pci(0x6,0x0)
BdsDxe: starting Boot0004 "UEFI Misc Device 2" from PciRoot(0x0)/Pci(0x6,0x0)
[=3hStarKernel UEFI Loader
Loading kernel from ESP...
[CKPT 001] Entered efi_main - ConOut live
Collecting boot information...
[CKPT 004] Command line parsed
[CKPT 005] Kernel stack allocation decided
[CKPT 006] Boot info collected (ACPI table located)
[CKPT 007] GOP: linear framebuffer found
[CKPT 008] About to enter ExitBootServices retry loop
_____ _ _ __ _
/ ____| | | |/ / | |
| (___ | |_ __ _ _ __| ' / ___ _ __ _ __ ___| |
\___ \| __/ _` | '__| < / _ \ '__| '_ \ / _ \ |
____) | || (_| | | | . \ __/ | | | | | __/ |
|_____/ \__\__,_|_| |_|\_\___|_| |_| |_|\___|_|
LithosAnanke v2.1.0
Architecture: aarch64
Build: Oct 6 2026 11:54:35
UEFI BootServices: EXITED
=== StarKernel Boot Information ===
Memory map entries: 108
Total memory: 4093 MB
Usable memory: 4056 MB
===================================
PMM initialized.
PMM statistics:
Total pages: 1039866
Free pages : 1038455
Used pages : 1411
Total MB : 4061
Free MB : 4056
Used MB : 5
VMM initialized (mapped RAM, CR3 switched)
VMM initialized (mapped RAM, CR3 switched)
VMM self-test: mapped OK at 0xffff800000000000
VMM self-test complete.
AArch64: running at EL1
IDT installed.
APIC: init...
PSCI: no DTB -- using HVC (QEMU virt-machine default)
GICv2: no DTB GIC node -- using QEMU virt-machine defaults
GICv2: distributor+CPU interface enabled, PPI 30
APIC: init done
Timer: init...
Timer: AArch64 generic timer initialised.
Timer: init done
Kernel heap initialized.
Heap statistics:
Total bytes: 2147483608
Free bytes: 2147483608
Used bytes: 0
Peak bytes: 0
Heap base addr: 1207959552
Heap end addr: 3355443200
Heartbeat: init...
Heartbeat: init done
Kernel initialization complete.
Boot successful!
StarForth v4: one host node, the F18-derived engine
V4: capsule v4:nucleus-64.f18 signature: missing (unsigned)
PARITY:V4_NUCLEUS name=v4:nucleus-64.f18 capsule_id=0x9653e727bf5cf8bd capsule_hash=0x9653e727bf5cf8bd words=305
V4: capsule v4:forth79.4th signature: missing (unsigned)
PARITY:V4_CAPSULE name=v4:forth79.4th capsule_id=0x4055641ee17d176b capsule_hash=0x4055641ee17d176b dict_hash=0x14a9ea7be071593b
V4: capsule v4:post79.4th signature: missing (unsigned)
PARITY:V4_POST tests=550 pass=550 fail=0
PARITY:V4_CAPSULE name=v4:post79.4th capsule_id=0xb987dbb4388990bd capsule_hash=0xb987dbb4388990bd dict_hash=0x721a93a6abb945f9
PARITY:OK
POST: PASSED
ok> : SQ DUP * ;
ok
ok> 7 SQ . 3 4 U* . .
49 0 12 ok
ok> COLD
FORTH-79 Cold Start
System initialized.
ok
ok> 3 4 U* . .
0 12 ok
ok> FORGET U*
Protected word
ERROR
ok> 9 KERNEL-WORD ASK9 ASK9
Argument out of range
ERROR
ok> BYE
BYE: cold restart
logs/20261006-115849/riscv64/qemu-riscv64-20261006-115849.log
+174
View File
@@ -0,0 +1,174 @@
OpenSBI v1.8
____ _____ ____ _____
/ __ \ / ____| _ \_ _|
| | | |_ __ ___ _ __ | (___ | |_) || |
| | | | '_ \ / _ \ '_ \ \___ \| _ < | |
| |__| | |_) | __/ | | |____) | |_) || |_
\____/| .__/ \___|_| |_|_____/|____/_____|
| |
|_|
Platform Name : riscv-virtio,qemu
Platform Features : medeleg
Platform HART Count : 1
Platform HART Protection : pmp
Platform IPI Device : aclint-mswi
Platform Timer Device : aclint-mtimer @ 10000000Hz
Platform Console Device : uart8250
Platform HSM Device : ---
Platform PMU Device : ---
Platform Reboot Device : syscon-reboot
Platform Shutdown Device : syscon-poweroff
Platform Suspend Device : ---
Platform CPPC Device : ---
Firmware Base : 0x80000000
Firmware Size : 321 KB
Firmware RW Offset : 0x40000
Firmware RW Size : 65 KB
Firmware Heap Offset : 0x47000
Firmware Heap Size : 37 KB (total), 0 KB (reserved), 12 KB (used), 23 KB (free)
Firmware Scratch Size : 4096 B (total), 1464 B (used), 2632 B (free)
Runtime SBI Version : 3.0
Standard SBI Extensions : ipi,pmu,srst,sse,hsm,rfnc,fwft,time,base,legacy,dbcn,dbtr
Experimental SBI Extensions : none
Domain0 Name : root
Domain0 Boot HART : 0
Domain0 HARTs : 0*
Domain0 Region00 : 0x0000000080040000-0x000000008005ffff M: (F,R,W) S/U: ()
Domain0 Region01 : 0x0000000080000000-0x000000008003ffff M: (F,R,X) S/U: ()
Domain0 Region02 : 0x0000000000100000-0x0000000000100fff M: (I,R,W) S/U: (R,W)
Domain0 Region03 : 0x0000000010000000-0x0000000010000fff M: (I,R,W) S/U: (R,W)
Domain0 Region04 : 0x0000000002000000-0x000000000200ffff M: (I,R,W) S/U: ()
Domain0 Region05 : 0x000000000c400000-0x000000000c5fffff M: (I,R,W) S/U: (R,W)
Domain0 Region06 : 0x000000000c000000-0x000000000c3fffff M: (I,R,W) S/U: (R,W)
Domain0 Region07 : 0x0000000000000000-0xffffffffffffffff M: () S/U: (R,W,X)
Domain0 Next Address : 0x0000000020000000
Domain0 Next Arg1 : 0x00000000bfe00000
Domain0 Next Mode : S-mode
Domain0 SysReset : yes
Domain0 SysSuspend : yes
Boot HART ID : 0
Boot HART Domain : root
Boot HART Priv Version : v1.12
Boot HART Base ISA : rv64imafdch
Boot HART ISA Extensions : sstc,zicntr,zihpm,zicboz,zicbom,sdtrig,svadu
Boot HART PMP Count : 16
Boot HART PMP Granularity : 2 bits
Boot HART PMP Address Bits : 54
Boot HART MHPM Info : 16 (0x0007fff8)
Boot HART Debug Triggers : 2 triggers
Boot HART MIDELEG : 0x0000000000001666
Boot HART MEDELEG : 0x0000000000f4b509
[=3hRISC-V EDK2 firmware version 2025.11-3ubuntu7.3
Press ESCAPE within 5 seconds for boot options ERROR: C40000002:V03051002 I0 6D33944A-EC75-4855-A54D-809C75241F6C 83FFF850
BdsDxe: failed to load Boot0001 "UEFI Misc Device" fr
om PciRoot(0x0)/Pci(0x1,0x0): Not Found
[=3hStarKernel UEFI Loader
Loading kernel from ESP...
[CKPT 001] Entered efi_main - ConOut live
Monolithic build - kernel linked directly
Collecting boot information...
CmdLine: parsed OK
[CKPT 004] Command line parsed
[CKPT 005] Kernel stack allocation decided
[CKPT 006] Boot info collected (ACPI table located)
GOP: linear framebuffer found
[CKPT 007] GOP: linear framebuffer found
[CKPT 008] About to enter ExitBootServices retry loop
Calling kernel_main (monolithic)...
riscv64 item 4.3.5a: satp state at kernel entry (before switch)
satp.MODE = 0x000000000000000a
satp.PPN = 0x00000000000bf868
__kernel_start = 0x00000000bdea78f8
riscv64: satp cleared -- Bare mode, explicit (item 4.3.5a)
_____ _ _ __ _
/ ____| | | |/ / | |
| (___ | |_ __ _ _ __| ' / ___ _ __ _ __ ___| |
\___ \| __/ _` | '__| < / _ \ '__| '_ \ / _ \ |
____) | || (_| | | | . \ __/ | | | | | __/ |
|_____/ \__\__,_|_| |_|\_\___|_| |_| |_|\___|_|
LithosAnanke v2.1.0
Architecture: riscv64
Build: Oct 6 2026 11:58:12
UEFI BootServices: EXITED
=== StarKernel Boot Information ===
Memory map entries: 100
Total memory: 1020 MB
Usable memory: 977 MB
===================================
PMM initialized.
PMM statistics:
Total pages: 250782
Free pages : 250130
Used pages : 652
Total MB : 979
Free MB : 977
Used MB : 2
VMM initialized (mapped RAM, CR3 switched)
VMM initialized (mapped RAM, CR3 switched)
VMM self-test: mapped OK at 0xffff800000000000
VMM self-test complete.
IDT installed.
APIC: init...
PLIC: no DTB PLIC node -- using QEMU virt-machine default (base=0x0c000000)
PLIC: init (S-mode context 1, threshold=0)
APIC: init done
Timer: init...
Timer: RISC-V time CSR @ 10000000 Hz (FALLBACK, no devicetree)
Timer: init done
Kernel heap initialized.
Heap statistics:
Total bytes: 536870872
Free bytes: 536870872
Used bytes: 0
Peak bytes: 0
Heap base addr: 2214588416
Heap end addr: 2751459328
Heartbeat: init...
Heartbeat: init done
Kernel initialization complete.
Boot successful!
StarForth v4: one host node, the F18-derived engine
V4: capsule v4:nucleus-64.f18 signature: missing (unsigned)
PARITY:V4_NUCLEUS name=v4:nucleus-64.f18 capsule_id=0x9653e727bf5cf8bd capsule_hash=0x9653e727bf5cf8bd words=305
V4: capsule v4:forth79.4th signature: missing (unsigned)
PARITY:V4_CAPSULE name=v4:forth79.4th capsule_id=0x4055641ee17d176b capsule_hash=0x4055641ee17d176b dict_hash=0x14a9ea7be071593b
V4: capsule v4:post79.4th signature: missing (unsigned)
PARITY:V4_POST tests=550 pass=550 fail=0
PARITY:V4_CAPSULE name=v4:post79.4th capsule_id=0xb987dbb4388990bd capsule_hash=0xb987dbb4388990bd dict_hash=0x721a93a6abb945f9
PARITY:OK
POST: PASSED
ok> : SQ DUP * ;
ok
ok> 7 SQ . 3 4 U* . .
49 0 12 ok
ok> COLD
FORTH-79 Cold Start
System initialized.
ok
ok> 3 4 U* . .
0 12 ok
ok> FORGET U*
Protected word
ERROR
ok> 9 KERNEL-WORD ASK9 ASK9
Argument out of range
ERROR
ok> BYE
BYE: cold restart
v4/README.md
+9
View File
@@ -112,6 +112,15 @@ their ports are wired, both of which change while they run. The products
below are still one node each; they become the five nodes at `MESH.md`
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.
**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
place. `ENGINE.md` sets out the steps from here; step 1 is done and step 2 is
v4/capsule/core.v4
+28 -11
View File
@@ -6,7 +6,8 @@
\
\ 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^).
\ (OUT^), (CONSOLE), (ROUTES), (ROUTE#), (ROUTE-DEFAULT), (PRINT-TO),
\ (PRINT-PORT).
\
\ 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
@@ -94,8 +95,9 @@ header CMOVE
\ ---- 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
\ it prints while doing it is sent as a message: to the node in (CONSOLE), or
\ if that is 0 to whoever sent the text; by the port that leads there, or if
\ this node knows of none, by the port the text 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
@@ -112,20 +114,35 @@ header CMOVE
\ 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.
\ FINDING THE WAY (MESH.md section 7). A node knows its ports and nothing of
\ the shape they are wired in. Whoever wires it tells it, for a node, which
\ port leads toward that node: the table (ROUTES), (ROUTE#) entries of a
\ node's number and a port's address; and (ROUTE-DEFAULT), the port for any
\ node that is not in the table, or 0.
\ ( node -- port | 0 ) the address of the port that leads toward the node
: (PORT-FOR)
(ROUTE#) a! @ if NONE -1 + (ROUTES) a!
FOR dup @+ xor if HIT drop @+ drop NEXT
0
NONE: drop drop (ROUTE-DEFAULT) a! @ ;
HIT: drop drop @+ pop drop ;
\ ( 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.
\ Each write waits for the neighbour to take it.
: (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
0 !b 0 !b 0 !b ; \ heat and TTL, ACL tag, sequence
\ ( -- ) send what has been printed: its length, then its characters, four
\ to a word, the first lowest
\ ( -- ) send what has been printed, to where (PRINT-TO) says, by the port
\ (PRINT-PORT): its length, then its characters, four to a word, the first
\ 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
2 (HDR)
(OUT^) a! @ (OUT) - dup !b
3 + 2/ 2/ -1 + (OUT) a!
v4/capsule/quit.v4
+68 -5
View File
@@ -65,6 +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
3 (HDR) 4 !b !b \ a message of type 3, four characters long: how it ended
jump (IDLE)
@@ -84,8 +85,8 @@ macro R-CLEAR RSTACK-DEPTH b! a !b endmacro
\ 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. Any other is
\ let go: passing a message on is MESH.md step 4.
\ 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
@@ -103,10 +104,32 @@ macro R-CLEAR RSTACK-DEPTH b! a !b endmacro
READ:
0 (MSG)+6 a! @ TIB + C! \ a zero after the text
(MSG)+6 a! @ SPAN a! !
(MSG) a! @ (ME) a! @ xor if MINE drop jump (IDLE)
(MSG) a! @ (ME) a! @ xor if MINE drop jump (PASS-ON)
MINE: drop
(MSG)+2 a! @ -1 + if TEXT drop jump (IDLE)
TEXT: drop jump (LINE)
(MSG)+2 a! @ -1 + if TEXT drop jump (IDLE) \ for this node and not text: let go
TEXT: drop
(MSG)+1 a! @ (PORT-FOR) if D0 jump D1 \ the way back to whoever sent it:
D0: drop (REPLY) a! @ \ the port it came on, if no other is known
D1: (DONE-PORT) a! !
(CONSOLE) a! @ if P0 jump P1 \ where what it prints goes: the console,
P0: drop (MSG)+1 a! @ \ or whoever sent it
P1: dup (PRINT-TO) a! !
(PORT-FOR) if Q0 jump Q1
Q0: drop (REPLY) a! @
Q1: (PRINT-PORT) a! !
jump (LINE)
\ ( -- ) A MESSAGE FOR ANOTHER NODE is passed on (MESH.md section 7): all
\ of it, as it came, to the port that leads toward that node. With no way
\ 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
(MSG)+6 a! @ 3 + 2/ 2/ if SENT
-1 + TIB 2/ 2/ a! FOR @+ !b UNEXT \ and its text
jump (IDLE)
SENT: drop jump (IDLE)
NOWAY: drop (LOST) a! @ 1 + ! jump (IDLE)
\ ( -- ) THE TEXT, INTERPRETED. It is in TIB with a zero after it and its
\ length in SPAN, and the return stack is empty. It is interpreted with one
@@ -121,6 +144,43 @@ macro R-CLEAR RSTACK-DEPTH b! a !b endmacro
drop 2 jump (DONE)
GOOD: drop 1 jump (DONE)
\ ---- the node among others (MESH.md sections 6 and 7) ---------------------------
\ Not FORTH-79 and not in v3: v3's VMs are sent to through the kernel.
\ ( node port -- ) the port, by its number, leads toward that node
header ROUTE
: ROUTE
(ROUTE#) a! @ -16 + if FULL drop
(PORT) + (ROUTE#) a! @ 2* (ROUTES) + a!
push !+ pop !+
(ROUTE#) a! @ 1 + ! ;
FULL: 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! ! ;
\ ( -- ) forget every way: for when the wiring has changed
header NO-ROUTES
: NO-ROUTES 0 (ROUTE#) a! ! 0 (ROUTE-DEFAULT) a! ! ;
\ ( 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.
header SEND
: SEND
dup (PORT-FOR) if NOWAY
b! !b \ to
1 (HDR)
dup !b \ length
3 + 2/ 2/ if NONE -1 +
FOR dup C@ over 1 + C@ 8* + over 2 + C@ 8* 8* + over 3 + C@ 8* 8* 8* + !b 4 + NEXT
drop ;
NONE: drop drop ;
NOWAY: drop drop drop drop NODE-ERROR b! 12 !b ;
\ FORTH-79: clear the return stack, set execution mode, return control to
\ the terminal; no message is given. The data stack is left as it is.
\ NODE-ERROR, by name: how a definition written in FORTH raises an error.
@@ -129,6 +189,9 @@ macro R-CLEAR RSTACK-DEPTH b! a !b endmacro
\ its own) and the line ends with ERROR. The codes are listed in core.v4.
header NODE-ERROR inline : NODE-ERROR' NODE-ERROR ;
header (CATCH) inline : (CATCH)' (CATCH) ;
header (ME) inline : (ME)' (ME) ;
header (CONSOLE) inline : (CONSOLE)' (CONSOLE) ;
header (LOST) inline : (LOST)' (LOST) ;
header (WORD-DEFINED) inline : (WORD-DEFINED)' (WORD-DEFINED) ;
header (WORD-FORGOTTEN) inline : (WORD-FORGOTTEN)' (WORD-FORGOTTEN) ;
header (EMIT-HOOK) inline : (EMIT-HOOK)' (EMIT-HOOK) ;
v4/tests/host_map.h
+17
View File
@@ -69,6 +69,15 @@
#define CATCH (BUF0_W - 8) /* non-zero: a line's error is recorded here, -1, and the line ends " ok" */
#define LINE_STATUS (BUF0_W - 9) /* how the last line ended: 0 QUIT, 1 completed, 2 an error */
#define PORT (BUF0_W - 32) /* the node's ports (node.h): V4_PORTS of them, then "any port" and "which port". Port 0 is where its requests go. */
#define CONSOLE (BUF0_W - 16) /* the node what this one prints is sent to; 0: whoever sent the text being served */
#define ROUTE_COUNT (BUF0_W - 17) /* how many entries the table of ways holds */
#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 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 */
#define OUT_PTR (BUF0_W - 14) /* where the next character printed goes: a cell of the output buffer */
#define REPLY (BUF0_W - 15) /* the address of the port the message being served came on */
@@ -156,6 +165,14 @@ static int host_load(v4_text *tx, v4_node *n, const char *const *files, unsigned
v4_text_constant(tx, "(LINE-STATUS)", LINE_STATUS);
v4_text_constant(tx, "(PORT)", PORT);
v4_text_constant(tx, "(ME)", ME);
v4_text_constant(tx, "(CONSOLE)", CONSOLE);
v4_text_constant(tx, "(ROUTE#)", ROUTE_COUNT);
v4_text_constant(tx, "(ROUTE-DEFAULT)", ROUTE_DEFAULT);
v4_text_constant(tx, "(LOST)", LOST);
v4_text_constant(tx, "(PRINT-TO)", PRINT_TO);
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, "(OUT^)", OUT_PTR);
v4_text_constant(tx, "(REPLY)", REPLY);
v4_text_constant(tx, "(MSG)", MSG);
v4/tests/test_host_mesh.c
+218
View File
@@ -0,0 +1,218 @@
/* test_host_mesh.c -- StarForth nodes that talk: a console wired to one
* node, and two more in a row behind it. docs/v4.0.0/MESH.md sections 6
* and 7, steps 3 and 4.
*
* console --1 [10] 2--2 [11] 3--2 [12]
*
* Each node is the nucleus (v4/capsule/ *.v4) and nothing else. They start
* alike, numbered 0 and knowing no way anywhere; everything they come to
* know they are told by text sent from the console, as whoever wires a node
* tells it. The console is a device on a port and speaks messages
* (v4/include/v4/message.h).
*/
#include "v4/fabric.h"
#include "v4/message.h"
#include "v4/text.h"
#include <stdio.h>
#include <string.h>
#include "host_map.h"
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)
static v4_text tx;
static v4_node nucleus; /* one node with the nucleus in it: what every node here starts as */
static v4_cell w_idle, w_fault;
static v4_fabric_node pool[3];
static v4_place places[3];
static v4_fabric f;
/* ---- the console: a device on a port ---- */
#define CONSOLE_ID 1
static v4_message going, coming;
static unsigned going_at;
static char printed[8192]; /* what has come back since the console last sent */
static unsigned printed_len;
static v4_cell printed_from; /* which node the last of it came from */
static int ended; /* how many messages of how text ended have come, */
static v4_cell ended_from, ended_how; /* and the last of them */
static int console_give(void *self, v4_cell *value)
{
(void)self;
if (going_at >= going.count) return 0;
*value = going.word[going_at++];
return 1;
}
static int console_take(void *self, v4_cell value)
{
(void)self;
if (v4_message_word(&coming, value)) {
if (v4_message_type(&coming) == V4_MSG_OUTPUT) {
unsigned i, chars = v4_message_length(&coming);
for (i = 0; i < chars && printed_len + 1 < sizeof printed; i++) printed[printed_len++] = v4_message_char(&coming, i);
printed[printed_len] = 0;
printed_from = v4_message_from(&coming);
} else if (v4_message_type(&coming) == V4_MSG_DONE) {
ended++;
ended_from = v4_message_from(&coming);
ended_how = coming.word[V4_MSG_HEADER];
}
coming.count = 0;
}
return 1;
}
static const v4_device console = { console_take, console_give, 0 };
static int is_empty(const char *s) { return s[0] == 0; }
/* Send text to a node and let everything that follows from it happen. */
static const char *tell(v4_cell node, const char *text)
{
unsigned steps = 0;
printed_len = 0; printed[0] = 0; printed_from = -1;
ended = 0; ended_from = -1; ended_how = -1;
if (!v4_message_text(&going, node, CONSOLE_ID, V4_MSG_TEXT, text, (unsigned)strlen(text))) return "(too long)";
going_at = 0;
while (steps < 20000000 && v4_fabric_step(&f) != 0) steps++;
if (steps >= 20000000) return "(still running)";
return printed;
}
/* A StarForth node in the fabric: born, then given the nucleus and the
* registers the nucleus expects, waiting for a message. */
static unsigned starforth_node(unsigned k)
{
int id = v4_fabric_add(&f, &pool[k], PORT);
v4_node *n = &pool[k].n;
memcpy(n->mem, nucleus.mem, sizeof n->mem);
v4_node_stack_regs_attach(n, DSTACK_REG, RSTACK_REG);
v4_node_error_attach(n, NODE_ERROR);
v4_node_fault_attach(n, w_fault);
n->p = w_idle;
return (unsigned)id;
}
static int waiting(unsigned id)
{
const v4_node *n = &v4_fabric_node_at(&f, id)->n;
return n->reading && !n->given && n->read_port == V4_PORT_ANY;
}
int main(void)
{
unsigned hera, mid, far, i;
printf("v4 mesh tests: V4_CELL_BITS=%d, V4_NODE_WORDS=%u\n", V4_CELL_BITS, (unsigned)V4_NODE_WORDS);
{
static const char *const files[] = { "core.v4", "input.v4", "dict.v4", "codegen.v4", "compile.v4", "quit.v4", "forth.v4",
"numout.v4", "words.v4", "system.v4", "qmath.v4", "blocks.v4", "log.v4", "acl.v4" };
CHECK(host_load(&tx, &nucleus, files, 14), "the nucleus assembles");
}
CHECK(v4_text_finish(&tx), "everything is defined: %s", v4_text_error(&tx));
if (failures) { printf(" %d checks, %d failures\n", checks, failures); return 1; }
w_idle = v4_text_word(&tx, "(IDLE)");
w_fault = v4_text_word(&tx, "(FAULTS)");
nucleus.mem[DP] = DICT_W * 4; /* the variables, as at switch-on (tools/mkimage.c) */
nucleus.mem[LATEST] = v4_text_latest(&tx);
nucleus.mem[CFP] = CFS_W;
nucleus.mem[BASE] = 10;
nucleus.mem[FENCE] = DICT_W;
nucleus.mem[BOOT_CELLS] = nucleus.mem[DP];
nucleus.mem[BOOT_CELLS + 1] = nucleus.mem[LATEST];
nucleus.mem[LOG_LEVEL] = 2;
nucleus.mem[CONTEXT] = LATEST;
nucleus.mem[CURRENT] = LATEST;
nucleus.mem[SRC] = TIB;
nucleus.mem[LINE_STATUS] = 1;
nucleus.mem[OUT_PTR] = OUT_W;
v4_fabric_init(&f, places, 3);
hera = starforth_node(0);
mid = starforth_node(1);
far = starforth_node(2);
CHECK(v4_fabric_wire_device(&f, hera, 1, &console), "the console is wired to one node's port 1");
CHECK(v4_fabric_wire(&f, hera, 2, mid, 2) && v4_fabric_wire(&f, mid, 3, far, 2), "and the three nodes in a row");
going.count = 0; going_at = 0;
for (i = 0; i < 20; i++) (void)v4_fabric_step(&f);
CHECK(waiting(hera) && waiting(mid) && waiting(far), "all three wait at their ports");
/* ---- they are told who they are and the way to each other, by text ---- */
CHECK(is_empty(tell(0, "10 (ME) ! 1 (CONSOLE) ! 1 1 ROUTE 0 2 ROUTE")) && ended == 1 && ended_how == V4_TEXT_COMPLETED && ended_from == 10,
"the node at the console takes text sent to 0, and is 10 from then on: %ld", (long)ended_from);
CHECK(is_empty(tell(0, "11 (ME) ! 1 (CONSOLE) ! 2 DEFAULT-ROUTE 0 3 ROUTE")) && ended == 1 && ended_from == 11 && ended_how == V4_TEXT_COMPLETED,
"text sent to 0 now passes through 10 to the next, which is 11 from then on: %ld", (long)ended_from);
CHECK(is_empty(tell(0, "12 (ME) ! 1 (CONSOLE) ! 2 DEFAULT-ROUTE")) && ended == 1 && ended_from == 12 && ended_how == V4_TEXT_COMPLETED,
"and then through both to the last, 12: %ld", (long)ended_from);
CHECK(is_empty(tell(10, "11 2 ROUTE 12 2 ROUTE")) && ended_from == 10 && is_empty(tell(11, "12 3 ROUTE")) && ended_from == 11,
"each is told the way to the others");
/* ---- they talk ---- */
CHECK(strcmp(tell(10, "1 2 + ."), "3 ") == 0 && printed_from == 10 && ended_how == V4_TEXT_COMPLETED, "text for the node at the console is done there");
CHECK(strcmp(tell(11, "20 22 + ."), "42 ") == 0 && printed_from == 11 && ended_from == 11, "text for the next node is done there, and what it prints comes back");
CHECK(strcmp(tell(12, "7 8 * ."), "56 ") == 0 && printed_from == 12 && ended_from == 12 && ended_how == V4_TEXT_COMPLETED,
"text for the last passes through two nodes, and what it prints comes back through two: \"%s\" from %ld", printed, (long)printed_from);
CHECK(strcmp(tell(12, "NOSUCH"), "UNKNOWN WORD: 'NOSUCH'\n") == 0 && ended_from == 12 && ended_how == V4_TEXT_ERROR, "an error there is reported from there");
CHECK(strcmp(tell(12, ": SQ DUP * ;"), "") == 0 && strcmp(tell(12, "9 SQ ."), "81 ") == 0 && strstr(tell(11, "9 SQ ."), "UNKNOWN WORD") != NULL,
"each node has its own dictionary: a word defined on one is not on another");
{
const char *all = tell(12, "WORDS");
CHECK(strlen(all) > 1000 && printed_from == 12 && ended == 1, "more than a message holds comes back in several: %u characters", (unsigned)strlen(all));
}
{
static char line[1100];
memset(line, ' ', 1024);
memcpy(line, "66 EMIT", 7);
memcpy(line + 1017, "67 EMIT", 7);
line[1024] = 0;
CHECK(strcmp(tell(12, line), "BC") == 0, "a message as long as a message may be is passed on whole: 1024 characters");
}
/* ---- one node sends to another ---- */
CHECK(strcmp(tell(10, ": TELL S\" 65 EMIT 12 . \" 12 SEND ; TELL"), "A12 ") == 0 && printed_from == 12,
"text one node SENDs another is done there, and what that prints goes to its console: \"%s\" from %ld", printed, (long)printed_from);
CHECK(strstr(tell(10, ": NOWAY S\" 1\" 99 SEND ; NOWAY"), "Argument out of range") != NULL && ended_how == V4_TEXT_ERROR,
"SEND to a node there is no way to is an error");
/* ---- no way ---- */
CHECK(is_empty(tell(99, "1 2 + .")) && ended == 0, "text for a node there is no way to: nothing comes back");
CHECK(strcmp(tell(10, "(LOST) @ ."), "1 ") == 0, "and the node that could not pass it on has counted it");
CHECK(strcmp(tell(11, "(LOST) @ ."), "0 ") == 0 && strcmp(tell(12, "(LOST) @ ."), "0 ") == 0, "the others have lost nothing");
/* ---- waiting ---- */
{
v4_uheat_t c0 = pool[0].es.anticlock, c1 = pool[1].es.anticlock, c2 = pool[2].es.anticlock;
for (i = 0; i < 100; i++) (void)v4_fabric_step(&f);
CHECK(waiting(hera) && waiting(mid) && waiting(far), "with nothing to do, all three wait at their ports");
CHECK(pool[0].es.anticlock == c0 && pool[1].es.anticlock == c1 && pool[2].es.anticlock == c2, "and execute nothing");
}
/* ---- the ways are forgotten and told again: the wiring has changed ---- */
CHECK(v4_fabric_wire(&f, hera, 3, far, 3), "the far node is wired straight to the one at the console as well");
CHECK(is_empty(tell(10, "NO-ROUTES 1 1 ROUTE 11 2 ROUTE 12 3 ROUTE")) && is_empty(tell(12, "NO-ROUTES 3 DEFAULT-ROUTE")), "and both are told");
{
v4_uheat_t before = pool[1].es.anticlock;
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 ----
* 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. */
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");
printf(" %d checks, %d failures\n", checks, failures);
return failures != 0;
}