Stage M-A: manual messaging words -- CHANNEL, CHANNEL-CLOSE, JOIN/UNJOIN, JOIN-VM/LEAVE-VM, PUBLISH, INJECT, MAIL?, .MAIL, .CHANNELS (FABRIC-3.9.0 §7.2)
- Eleven words in repl.c over the existing kernel-Hermes C API, registered for every VM; `from` always derived in C. Names as ruled (M-1) except UNJOIN for LEAVE, which is FORTH-79's DO-loop exit (Captain Bob). - INJECT (M-2) sends as the root, funded from Hera's reservoir, as new type 31; pinned STRICT in kernel_main.c beside BIRTH. - Read-only accessors sk_hermes_pending_at() / sk_hermes_channel_member_at() for .MAIL / .CHANNELS. Console evidence identical on amd64/aarch64/riscv64: PUBLISH delivers 2 (both print), LEAVE-VM then PUBLISH delivers 1, INJECT shows in MAIL?/.MAIL as type 31 from Hera before the recipient runs, CHANNEL-CLOSE succeeds and refuses channel 0, JOIN/UNJOIN, refusals 0/-1. dict_hash set changes by the 11 words (542 words) and is identical across ISAs; acceptance passes. Co-Authored-By: Claude Opus 5.5 <noreply@anthropic.com>
This commit is contained in:
Robert Allan James
co-authored by
Claude Opus 5.5
Claude Opus 5.5
parent
d8358a3011
commit
879d00dcf9
@@ -813,6 +813,15 @@ static void kernel_main_deep(BootInfo *boot_info) {
|
||||
birth->acl_pinned = 1;
|
||||
console_println("ACL: BIRTH pinned STRICT");
|
||||
}
|
||||
/* FABRIC-3.9.8 Stage M-A, ruling M-2: INJECT sends as the root
|
||||
* (Hera) from her reservoir, so it is ACL-gated -- kernel-only,
|
||||
* so pinned here like BIRTH, not in ACL.4th. */
|
||||
DictEntry *inject = vm_find_word(mama_vm_ptr, "INJECT", 6);
|
||||
if (inject) {
|
||||
inject->acl_mode = ACL_MODE_STRICT;
|
||||
inject->acl_pinned = 1;
|
||||
console_println("ACL: INJECT pinned STRICT");
|
||||
}
|
||||
}
|
||||
}
|
||||
#else
|
||||
|
||||
@@ -550,11 +550,236 @@ static void sk_word_send(VM *vm) {
|
||||
vm_push(vm, rc == 0 ? 1 : 0);
|
||||
}
|
||||
|
||||
/*===========================================================================
|
||||
* FABRIC-3.9.8 Stage M-A (FABRIC-3.9.0.md §7.2, rulings M-1/M-2): manual
|
||||
* messaging words over the existing kernel-Hermes C API. Registered for
|
||||
* every VM; who may use which is ACL's job, never a C check here -- except
|
||||
* that INJECT is pinned STRICT in kernel_main.c, the sanctioned home for
|
||||
* kernel-only words ACL.4th can't reach portably. `from` is always the
|
||||
* calling VM, derived here, never taken from the stack; INJECT alone
|
||||
* records the root (Hera), by design (M-2). Names as ruled (M-1), except
|
||||
* UNJOIN, not LEAVE: LEAVE is FORTH-79's DO-loop exit (Captain Bob,
|
||||
* 2026-09-24: "UNJOIN").
|
||||
*===========================================================================*/
|
||||
|
||||
static char g_ma_buf[SK_HERMES_CHUNK_MAX_PAYLOAD];
|
||||
|
||||
/* A live VM named on the stack. 0 and *out set, or -1. */
|
||||
static int ma_resolve_vm(VM *vm, cell_t name_c, cell_t name_u, VMRegistryEntry *out) {
|
||||
char name[VM_NAME_MAX];
|
||||
const char *src;
|
||||
int i;
|
||||
|
||||
if (name_u <= 0 || (uint32_t)name_u >= VM_NAME_MAX) return -1;
|
||||
src = (const char *)vm_ptr(vm, (vaddr_t)name_c);
|
||||
if (!src) return -1;
|
||||
for (i = 0; i < (int)name_u; i++) name[i] = src[i];
|
||||
name[name_u] = '\0';
|
||||
if (capsule_vm_find_by_name_nocase(name, out) != 0 || !out->vm_ptr ||
|
||||
out->state == VM_STATE_DEAD || out->state == VM_STATE_STILLBORN) return -1;
|
||||
return 0;
|
||||
}
|
||||
|
||||
/* Copy a payload into g_ma_buf, NUL-terminated. Same bound as SEND: an
|
||||
* oversized payload is refused, never truncated. Returns 0 or -1. */
|
||||
static int ma_copy_payload(VM *vm, cell_t paddr, cell_t plen) {
|
||||
const char *src;
|
||||
int i;
|
||||
if (plen < 0 || plen > SK_HERMES_CHUNK_MAX_PAYLOAD - 1) return -1;
|
||||
if (plen > 0) {
|
||||
src = (const char *)vm_ptr(vm, (vaddr_t)paddr);
|
||||
if (!src) return -1;
|
||||
for (i = 0; i < (int)plen; i++) g_ma_buf[i] = src[i];
|
||||
}
|
||||
g_ma_buf[plen] = '\0';
|
||||
return 0;
|
||||
}
|
||||
|
||||
/* A VM's name for printing, from its id. */
|
||||
static void ma_name_of(VMUuid id, char *buf, size_t cap) {
|
||||
VMRegistryEntry e;
|
||||
if (capsule_vm_registry_get(id, &e) == 0 && e.name[0]) {
|
||||
snprintf(buf, cap, "%s", e.name);
|
||||
} else {
|
||||
snprintf(buf, cap, "?%llx", (unsigned long long)id.lo);
|
||||
}
|
||||
}
|
||||
|
||||
static int ma_underflow(VM *vm, int need, const char *usage) {
|
||||
if (vm->dsp < need - 1) {
|
||||
console_println(usage);
|
||||
vm->error = 1;
|
||||
return 1;
|
||||
}
|
||||
return 0;
|
||||
}
|
||||
|
||||
/* CHANNEL ( -- ch | -1 ) */
|
||||
static void sk_word_channel(VM *vm) {
|
||||
vm_push(vm, (cell_t)sk_hermes_channel_create());
|
||||
}
|
||||
|
||||
/* CHANNEL-CLOSE ( ch -- ok? ) refuses channel 0 (common, permanent) */
|
||||
static void sk_word_channel_close(VM *vm) {
|
||||
cell_t ch;
|
||||
if (ma_underflow(vm, 1, "CHANNEL-CLOSE: expects ch CHANNEL-CLOSE")) return;
|
||||
ch = vm_pop(vm);
|
||||
if (ch == SK_HERMES_CHANNEL_COMMON) { vm_push(vm, 0); return; }
|
||||
vm_push(vm, sk_hermes_channel_destroy((int)ch) == 0 ? 1 : 0);
|
||||
}
|
||||
|
||||
/* JOIN ( ch -- ok? ) subscribe the calling VM */
|
||||
static void sk_word_join(VM *vm) {
|
||||
cell_t ch;
|
||||
if (ma_underflow(vm, 1, "JOIN: expects ch JOIN")) return;
|
||||
ch = vm_pop(vm);
|
||||
vm_push(vm, sk_hermes_channel_subscribe((int)ch, vm->stadium_vm_id) == 0 ? 1 : 0);
|
||||
}
|
||||
|
||||
/* UNJOIN ( ch -- ok? ) unsubscribe the calling VM */
|
||||
static void sk_word_unjoin(VM *vm) {
|
||||
cell_t ch;
|
||||
if (ma_underflow(vm, 1, "UNJOIN: expects ch UNJOIN")) return;
|
||||
ch = vm_pop(vm);
|
||||
vm_push(vm, sk_hermes_channel_unsubscribe((int)ch, vm->stadium_vm_id) == 0 ? 1 : 0);
|
||||
}
|
||||
|
||||
/* JOIN-VM ( ch name-c name-u -- ok? ) subscribe a named VM */
|
||||
static void sk_word_join_vm(VM *vm) {
|
||||
cell_t name_u, name_c, ch;
|
||||
VMRegistryEntry t;
|
||||
if (ma_underflow(vm, 3, "JOIN-VM: expects ch S\" name\" JOIN-VM")) return;
|
||||
name_u = vm_pop(vm);
|
||||
name_c = vm_pop(vm);
|
||||
ch = vm_pop(vm);
|
||||
if (ma_resolve_vm(vm, name_c, name_u, &t) != 0) { vm_push(vm, 0); return; }
|
||||
vm_push(vm, sk_hermes_channel_subscribe((int)ch, t.vm_id) == 0 ? 1 : 0);
|
||||
}
|
||||
|
||||
/* LEAVE-VM ( ch name-c name-u -- ok? ) unsubscribe a named VM */
|
||||
static void sk_word_leave_vm(VM *vm) {
|
||||
cell_t name_u, name_c, ch;
|
||||
VMRegistryEntry t;
|
||||
if (ma_underflow(vm, 3, "LEAVE-VM: expects ch S\" name\" LEAVE-VM")) return;
|
||||
name_u = vm_pop(vm);
|
||||
name_c = vm_pop(vm);
|
||||
ch = vm_pop(vm);
|
||||
if (ma_resolve_vm(vm, name_c, name_u, &t) != 0) { vm_push(vm, 0); return; }
|
||||
vm_push(vm, sk_hermes_channel_unsubscribe((int)ch, t.vm_id) == 0 ? 1 : 0);
|
||||
}
|
||||
|
||||
/* PUBLISH ( paddr plen ch -- n ) a copy to every member, from the calling
|
||||
* VM; n delivered, or -1 if the channel is invalid or the payload too big. */
|
||||
static void sk_word_publish(VM *vm) {
|
||||
cell_t ch, plen, paddr;
|
||||
if (ma_underflow(vm, 3, "PUBLISH: expects paddr plen ch PUBLISH")) return;
|
||||
ch = vm_pop(vm);
|
||||
plen = vm_pop(vm);
|
||||
paddr = vm_pop(vm);
|
||||
if (ma_copy_payload(vm, paddr, plen) != 0) { vm_push(vm, -1); return; }
|
||||
vm_push(vm, (cell_t)sk_hermes_publish(vm->stadium_vm_id, (int)ch, SK_HERMES_MSG_TYPE_SEND,
|
||||
g_ma_buf, (uint32_t)(plen + 1)));
|
||||
}
|
||||
|
||||
/* INJECT ( paddr plen name-c name-u -- ok? ) into a VM's queue as if from
|
||||
* the kernel: sender recorded as the root (Hera), funded from her
|
||||
* reservoir (ruling M-2). ACL-gated: pinned STRICT in kernel_main.c. */
|
||||
static void sk_word_inject(VM *vm) {
|
||||
cell_t name_u, name_c, plen, paddr;
|
||||
VMRegistryEntry t;
|
||||
VM *root = (VM *)sk_get_mama_vm();
|
||||
int rc;
|
||||
if (ma_underflow(vm, 4, "INJECT: expects paddr plen S\" name\" INJECT")) return;
|
||||
name_u = vm_pop(vm);
|
||||
name_c = vm_pop(vm);
|
||||
plen = vm_pop(vm);
|
||||
paddr = vm_pop(vm);
|
||||
if (!root || ma_resolve_vm(vm, name_c, name_u, &t) != 0 ||
|
||||
ma_copy_payload(vm, paddr, plen) != 0) { vm_push(vm, 0); return; }
|
||||
rc = sk_hermes_send_one(root->stadium_vm_id, t.vm_id, SK_HERMES_MSG_TYPE_INJECT, 0,
|
||||
g_ma_buf, (uint32_t)(plen + 1));
|
||||
vm_push(vm, rc == 0 ? 1 : 0);
|
||||
}
|
||||
|
||||
/* MAIL? ( name-c name-u -- n ) a VM's pending count; -1 if no such VM */
|
||||
static void sk_word_mail_q(VM *vm) {
|
||||
cell_t name_u, name_c;
|
||||
VMRegistryEntry t;
|
||||
if (ma_underflow(vm, 2, "MAIL?: expects S\" name\" MAIL?")) return;
|
||||
name_u = vm_pop(vm);
|
||||
name_c = vm_pop(vm);
|
||||
if (ma_resolve_vm(vm, name_c, name_u, &t) != 0) { vm_push(vm, -1); return; }
|
||||
vm_push(vm, (cell_t)sk_hermes_pending_count(t.vm_id));
|
||||
}
|
||||
|
||||
/* .MAIL ( name-c name-u -- ) list a VM's pending messages, oldest first:
|
||||
* type, sender, length, first bytes. Read-only. */
|
||||
static void sk_word_dot_mail(VM *vm) {
|
||||
cell_t name_u, name_c;
|
||||
VMRegistryEntry t;
|
||||
SkHermesMessage *m;
|
||||
char line[160], from[VM_NAME_MAX + 20], text[33];
|
||||
size_t i, k;
|
||||
if (ma_underflow(vm, 2, ".MAIL: expects S\" name\" .MAIL")) return;
|
||||
name_u = vm_pop(vm);
|
||||
name_c = vm_pop(vm);
|
||||
if (ma_resolve_vm(vm, name_c, name_u, &t) != 0) {
|
||||
console_println(".MAIL: no such VM");
|
||||
return;
|
||||
}
|
||||
snprintf(line, sizeof line, "MAIL %s: %d pending", t.name, sk_hermes_pending_count(t.vm_id));
|
||||
console_println(line);
|
||||
for (i = 0; (m = sk_hermes_pending_at(t.vm_id, i)) != (SkHermesMessage *)0; i++) {
|
||||
const char *p = (const char *)m->payload_addr;
|
||||
for (k = 0; k < 32 && p && k < m->payload_len && p[k]; k++) {
|
||||
text[k] = (p[k] >= 32 && p[k] < 127) ? p[k] : '.';
|
||||
}
|
||||
text[k] = '\0';
|
||||
ma_name_of(m->from, from, sizeof from);
|
||||
snprintf(line, sizeof line, " #%u type=%u from=%s len=%u \"%s\"",
|
||||
(unsigned)i, (unsigned)m->type, from, (unsigned)m->payload_len, text);
|
||||
console_println(line);
|
||||
}
|
||||
}
|
||||
|
||||
/* .CHANNELS ( -- ) every channel in use, with its members */
|
||||
static void sk_word_dot_channels(VM *vm) {
|
||||
int ch, n, cap = sk_hermes_channel_capacity();
|
||||
size_t i;
|
||||
VMUuid id;
|
||||
char name[VM_NAME_MAX + 20], line[64];
|
||||
(void)vm;
|
||||
for (ch = 0; ch < cap; ch++) {
|
||||
n = sk_hermes_channel_member_count(ch);
|
||||
if (n < 0) continue;
|
||||
snprintf(line, sizeof line, "ch %d (%d members):", ch, n);
|
||||
console_puts(line);
|
||||
for (i = 0; sk_hermes_channel_member_at(ch, i, &id) == 0; i++) {
|
||||
ma_name_of(id, name, sizeof name);
|
||||
console_puts(" ");
|
||||
console_puts(name);
|
||||
}
|
||||
console_println("");
|
||||
}
|
||||
}
|
||||
|
||||
void sk_repl_register_words(VM *vm) {
|
||||
register_word(vm, "BLK-ATTACH-ACK", sk_word_blk_attach_ack);
|
||||
register_word(vm, "KH-BLK-ATTACH-SEND", sk_word_kh_blk_attach_send);
|
||||
register_word(vm, "KH-ELEVATE-SEND", sk_word_kh_elevate_send);
|
||||
register_word(vm, "SEND", sk_word_send); /* FABRIC-3.8.md §3.8 */
|
||||
/* FABRIC-3.9.8 Stage M-A (§7.2) */
|
||||
register_word(vm, "CHANNEL", sk_word_channel);
|
||||
register_word(vm, "CHANNEL-CLOSE", sk_word_channel_close);
|
||||
register_word(vm, "JOIN", sk_word_join);
|
||||
register_word(vm, "UNJOIN", sk_word_unjoin);
|
||||
register_word(vm, "JOIN-VM", sk_word_join_vm);
|
||||
register_word(vm, "LEAVE-VM", sk_word_leave_vm);
|
||||
register_word(vm, "PUBLISH", sk_word_publish);
|
||||
register_word(vm, "INJECT", sk_word_inject);
|
||||
register_word(vm, "MAIL?", sk_word_mail_q);
|
||||
register_word(vm, ".MAIL", sk_word_dot_mail);
|
||||
register_word(vm, ".CHANNELS", sk_word_dot_channels);
|
||||
}
|
||||
|
||||
/*===========================================================================
|
||||
|
||||
@@ -474,6 +474,13 @@ int sk_hermes_channel_member_count(int channel_id) {
|
||||
return (int)sk_hermes_channels[channel_id].membership.count;
|
||||
}
|
||||
|
||||
int sk_hermes_channel_member_at(int channel_id, size_t i, VMUuid *out) {
|
||||
if (!channel_valid(channel_id) || !out) return -1;
|
||||
if (i >= sk_hermes_channels[channel_id].membership.count) return -1;
|
||||
*out = sk_hermes_channels[channel_id].membership.members[i];
|
||||
return 0;
|
||||
}
|
||||
|
||||
/* Task 3.3: per-subscriber pending queue table. See kernel_hermes.h's own
|
||||
* doc comment on sk_hermes_queues_boot_init() for scope and sizing
|
||||
* reasoning (each queue's depth grows on demand since Stage M-0; the table
|
||||
@@ -682,6 +689,12 @@ SkHermesMessage *sk_hermes_pending_peek(VMUuid vm_id) {
|
||||
return msg_at(q->slots[q->head]);
|
||||
}
|
||||
|
||||
SkHermesMessage *sk_hermes_pending_at(VMUuid vm_id, size_t i) {
|
||||
SkHermesPendingQueue *q = find_queue(vm_id);
|
||||
if (!q || i >= q->count) return (SkHermesMessage *)0;
|
||||
return msg_at(q->slots[(q->head + i) % q->cap]);
|
||||
}
|
||||
|
||||
int sk_hermes_pending_pop(VMUuid vm_id) {
|
||||
SkHermesPendingQueue *q = find_queue(vm_id);
|
||||
if (!q || q->count == 0) return -1;
|
||||
|
||||
Reference in New Issue
Block a user