LithosAnanake/src/starkernel/capsule/mama_forth_words.c

/*
  StarForth — Steady-State Virtual Machine Runtime

  Copyright (c) 2023–2025 Robert A. James
  All rights reserved.

  This file is part of the StarForth project.

  Licensed under the StarForth License, Version 1.0 (the "License");
  you may not use this file except in compliance with the License.

  You may obtain a copy of the License at:
      https://github.com/star.4th@proton.me/StarForth/LICENSE.txt

  This software is provided "AS IS", WITHOUT WARRANTY OF ANY KIND,
  express or implied, including but not limited to the warranties of
  merchantability, fitness for a particular purpose, and noninfringement.

  See the License for the specific language governing permissions and
  limitations under the License.
*/

/**
 * @file mama_forth_words.c
 * @brief Mama FORTH vocabulary implementation for kernel capsule system (M7.1)
 *
 * Implements the MAMA vocabulary - kernel-only words for the LithosAnanke
 * capsule birth protocol. This file is ONLY compiled for __STARKERNEL__ builds.
 *
 * The MAMA vocabulary provides:
 *   - Capsule directory enumeration
 *   - Baby VM birth from production capsules
 *   - Experiment execution on Mama
 *   - VM registry queries
 */

#ifdef __STARKERNEL__

#include "platform_alloc.h"
#include <string.h>
#include "starkernel/capsule.h"
#include "starkernel/capsule_birth.h"
#include "starkernel/capsule_runcap.h"
#include "starkernel/capsule_console.h"
#include "starkernel/capsule_wirebind.h"
#include "starkernel/capsule_zuse_boot.h" /* capsule_zuse_boot_logout() -- FABRIC-2.md §I.8 EJECT */
#include "starkernel/homeblocks_sig.h"
#include "freestanding/stdio.h"
#include "starkernel/capsule_mint.h"
#include "starkernel/user_identity_seed.h"
#include "starkernel/zuse_eligibility.h"
#include "starkernel/capsule_loader.h"
#include "starkernel/capsule_run.h"
#include "starkernel/capsule_loader.h"
#include "starkernel/capsule_vm_physics.h"
#include "starkernel/vm/vm_internal.h"
#include "starkernel/vm/stadium.h" /* item 4.2 -- STADIUM-* words */
#include "starkernel/vm/stadium_words.h" /* item 4.2 -- stadium_words_resident_heat() */
#include "starkernel/repl.h"
#include "starkernel/capsule_generated.h"
#include "starkernel/console.h"
#include "starkernel/arch.h"
#include "starkernel/timer.h"
#include "log.h"
#include "vm.h"
#include "word_registry.h"
#include "word_source/include/vocabulary_words.h"

/* Forward declarations for functions defined in vm_bootstrap.c and vocabulary_words.c */
extern void vm_bootstrap_root_vocabulary(VM *vm, const char *name);
extern void vocabulary_word_forth(VM *vm);
extern void vocabulary_word_definitions(VM *vm);

/* ============================================================================
 * Capsule Directory Words
 * ============================================================================ */

/**
 * @brief CAPSULE-COUNT ( -- n )
 * Push number of capsules in the capsule directory.
 */
void mama_word_capsule_count(VM *vm)
{
    vm_push(vm, (cell_t)capsule_get_desc_count());
}

/**
 * @brief CAPSULE@ ( idx -- desc )
 * Get capsule descriptor address by index.
 * Returns 0 if index is out of bounds.
 */
void mama_word_capsule_fetch(VM *vm)
{
    if (vm->dsp < 0) {
        vm->error = 1;
        return;
    }

    cell_t idx = vm_pop(vm);

    if ((uint32_t)idx >= capsule_get_desc_count()) {
        vm_push(vm, 0);  /* Out of bounds */
        return;
    }

    /* Push address of descriptor */
    vm_push(vm, (cell_t)(uintptr_t)&capsule_get_descriptors()[idx]);
}

/**
 * @brief CAPSULE-HASH@ ( desc -- hash )
 * Get content hash from capsule descriptor.
 */
void mama_word_capsule_hash_fetch(VM *vm)
{
    if (vm->dsp < 0) {
        vm->error = 1;
        return;
    }

    cell_t desc_addr = vm_pop(vm);
    const CapsuleDesc *desc = (const CapsuleDesc *)(uintptr_t)desc_addr;

    if (!desc) {
        vm_push(vm, 0);
        return;
    }

    vm_push(vm, (cell_t)desc->content_hash);
}

/**
 * @brief CAPSULE-FLAGS@ ( desc -- flags )
 * Get flags from capsule descriptor.
 */
void mama_word_capsule_flags_fetch(VM *vm)
{
    if (vm->dsp < 0) {
        vm->error = 1;
        return;
    }

    cell_t desc_addr = vm_pop(vm);
    const CapsuleDesc *desc = (const CapsuleDesc *)(uintptr_t)desc_addr;

    if (!desc) {
        vm_push(vm, 0);
        return;
    }

    vm_push(vm, (cell_t)desc->flags);
}

/**
 * @brief CAPSULE-LEN@ ( desc -- len )
 * Get payload length from capsule descriptor.
 */
void mama_word_capsule_len_fetch(VM *vm)
{
    if (vm->dsp < 0) {
        vm->error = 1;
        return;
    }

    cell_t desc_addr = vm_pop(vm);
    const CapsuleDesc *desc = (const CapsuleDesc *)(uintptr_t)desc_addr;

    if (!desc) {
        vm_push(vm, 0);
        return;
    }

    vm_push(vm, (cell_t)desc->length);
}

/* ============================================================================
 * VM Lifecycle State Stack
 *
 * Save/restore Hera's ECW interpreter state around lifecycle primitives
 * (BIRTH, VM-EXEC, START).  ECW pushes a resume IP onto vm->rsp before
 * each word call and pops it after; if any lifecycle primitive corrupts
 * vm->rsp the pop returns garbage and ip → fault.  The state stack is
 * dynamically allocated (sf_realloc) so its depth is unbounded.
 * ============================================================================ */

static int vm_state_push(VM *vm)
{
    if (vm->call_sp >= vm->call_stack_cap) {
        int new_cap = vm->call_stack_cap ? vm->call_stack_cap * 2 : 8;
        VMCallState *ns = (VMCallState *)sf_realloc(vm->call_stack,
                                                     (size_t)new_cap * sizeof(VMCallState));
        if (!ns) {
            log_message(LOG_ERROR, "vm_state_push: allocation failed at depth %d", vm->call_sp);
            return 0;
        }
        vm->call_stack     = ns;
        vm->call_stack_cap = new_cap;
    }
    VMCallState *s  = &vm->call_stack[vm->call_sp++];
    s->rsp          = vm->rsp;
    s->exit_colon   = vm->exit_colon;
    s->ecw_nesting  = vm->ecw_nesting;
    if (vm->call_sp > vm->call_stack_max)
        vm->call_stack_max = vm->call_sp;
    return 1;
}

static void vm_state_pop(VM *vm)
{
    if (vm->call_sp <= 0) return;
    VMCallState *s  = &vm->call_stack[--vm->call_sp];
    vm->rsp         = s->rsp;
    vm->exit_colon  = s->exit_colon;
    vm->ecw_nesting = s->ecw_nesting;
}

/* ============================================================================
 * VM Birth and Experiment Words
 * ============================================================================ */

/**
 * @brief BIRTH ( c-addr u -- )
 * Birth a named VM from its capsule.  Idempotent — if a live VM with
 * that name already exists (case-insensitive), logs and returns.
 *
 * Name mapping: S" Artemis" → capsule "artemis:init.4th"
 * Exception:    S" Hera"    → rejected (cannot re-birth Mama)
 */
void mama_word_birth(VM *vm)
{
    char            name_buf[VM_NAME_MAX];
    char            capsule_name[VM_NAME_MAX + 12]; /* name + ":init.4th" + NUL */
    VMRegistryEntry existing;
    uint32_t        i, j;
    cell_t          u, caddr;
    const char     *src;
    char            lower[VM_NAME_MAX];
    CapsuleRunResult result;
    VMUuid          new_vm_id;

    if (vm->dsp < 1) {
        vm->error = 1;
        return;
    }

    u     = vm_pop(vm);
    caddr = vm_pop(vm);

    if (u <= 0 || (uint32_t)u >= VM_NAME_MAX) {
        console_println("BIRTH: name too long or empty");
        return;
    }

    /* caddr is a VM address; S" ( -- c-addr u ) stores chars directly at caddr */
    {
        const uint8_t *p = vm_ptr(vm, (vaddr_t)caddr);
        if (!p) { vm->error = 1; return; }
        src = (const char *)p;
    }
    for (i = 0; i < (uint32_t)u; i++) name_buf[i] = src[i];
    name_buf[u] = '\0';

    /* Idempotency: live VM with same name → skip */
    if (capsule_vm_find_by_name_nocase(name_buf, &existing) == 0 &&
        existing.state == VM_STATE_LIVE) {
        console_puts("BIRTH: ");
        console_puts(name_buf);
        console_println(" already live (idempotent)");
        return;
    }

    /* Lowercase name for capsule path */
    for (i = 0; name_buf[i]; i++) {
        char c = name_buf[i];
        lower[i] = (c >= 'A' && c <= 'Z') ? (char)(c + 32) : c;
    }
    lower[i] = '\0';

    /* Hera cannot be re-birthed */
    if (lower[0]=='h' && lower[1]=='e' && lower[2]=='r' && lower[3]=='a' && lower[4]=='\0') {
        console_println("BIRTH: cannot re-birth Hera");
        return;
    }

    /* Build "lower:init.4th" */
    j = 0;
    for (i = 0; lower[i]; i++) capsule_name[j++] = lower[i];
    capsule_name[j++] = ':';
    { const char *suf = "init.4th"; for (i = 0; suf[i]; i++) capsule_name[j++] = suf[i]; }
    capsule_name[j] = '\0';

    new_vm_id = vm_uuid_none();

    /* Switch console prefix to the baby's name so its init capsule output
     * appears tagged [Hermes] / [Artemis] rather than [Hera]. */
    {
        char saved_prefix[VM_NAME_MAX];
        console_save_vm_name(saved_prefix, sizeof(saved_prefix));
        console_set_vm_name(name_buf);

        vm_state_push(vm);
        result = capsule_birth_baby(
            capsule_name,
            capsule_get_directory(),
            capsule_get_descriptors(),
            capsule_get_names(),
            capsule_get_arena(),
            vm->stadium_vm_id, /* §H.12 step 7: who is birthing this VM */
            0,  /* skip_pki_sig: normal build-time capsule */
            &new_vm_id,
            (void **)0
        );
        vm_state_pop(vm);

        console_set_vm_name(saved_prefix);  /* restore [Hera] (or whoever called BIRTH) */
    }

    if (result == CAPSULE_RUN_OK) {
        capsule_vm_registry_set_name(new_vm_id, name_buf);
        vm_physics_init(new_vm_id);
        console_puts("BIRTH: ");
        console_puts(name_buf);
        console_println(" live");
    } else {
        console_puts("BIRTH: ");
        console_puts(name_buf);
        console_println(" FAILED");
    }
    /* D3: stack clean on exit */
}

/**
 * @brief START ( c-addr u -- )
 * Enter a named VM's REPL loop synchronously.  The calling VM blocks
 * inside sk_repl_run() until the target halts (via STOP or BYE).
 * Cannot start a LIVE, DEAD, or STILLBORN VM.
 */
void mama_word_start(VM *vm)
{
    char             name_buf[VM_NAME_MAX];
    VMRegistryEntry  entry;
    uint32_t         i;
    cell_t           u, caddr;
    const char      *src;
    const char      *caller_name;
    VM              *target;

    if (vm->dsp < 1) {
        vm->error = 1;
        return;
    }

    u     = vm_pop(vm);
    caddr = vm_pop(vm);

    if (u <= 0 || (uint32_t)u >= VM_NAME_MAX) {
        console_println("START: name too long or empty");
        return;
    }

    /* caddr is a VM address; S" ( -- c-addr u ) stores chars directly at caddr */
    {
        const uint8_t *p = vm_ptr(vm, (vaddr_t)caddr);
        if (!p) { vm->error = 1; return; }
        src = (const char *)p;
    }
    for (i = 0; i < (uint32_t)u; i++) name_buf[i] = src[i];
    name_buf[u] = '\0';

    if (capsule_vm_find_by_name_nocase(name_buf, &entry) != 0) {
        console_puts("START: ");
        console_puts(name_buf);
        console_println(" not found");
        return;
    }

    if (entry.state == VM_STATE_LIVE) {
        console_puts("START: ");
        console_puts(name_buf);
        console_println(" already live");
        return;
    }

    if (entry.state == VM_STATE_DEAD || entry.state == VM_STATE_STILLBORN) {
        console_puts("START: ");
        console_puts(name_buf);
        console_println(" dead/stillborn — BIRTH first");
        return;
    }

    target = (VM *)entry.vm_ptr;
    if (!target) {
        console_puts("START: ");
        console_puts(name_buf);
        console_println(" no VM pointer");
        return;
    }

    /* Switch console prefix to target VM's name */
    caller_name = console_get_vm_name();
    console_set_vm_name(entry.name);

    capsule_vm_set_state(entry.vm_id, VM_STATE_LIVE);

    console_puts("START: entering ");
    console_println(entry.name);

    /* Run target's REPL — blocks until target->halted */
    vm_state_push(vm);
    sk_repl_run(target);
    vm_state_pop(vm);

    /* Target halted (STOP or BYE) — restore caller's context */
    capsule_vm_set_state(entry.vm_id, VM_STATE_STOPPED);
    console_set_vm_name(caller_name);

    console_puts("START: ");
    console_puts(entry.name);
    console_println(" stopped");
    /* Stack clean on exit */
}

/**
 * @brief STOP ( -- )
 * Self-stop: set vm->halted so sk_repl_run() exits on the next iteration.
 * State is updated to VM_STATE_STOPPED by the START word after the REPL
 * returns.  STOP is registered in every VM's dictionary (including children)
 * so any VM can stop itself.
 */
void mama_word_stop(VM *vm)
{
    vm->halted = 1;
    /* sk_repl_run's while(!vm->halted) loop exits after this word returns */
}

/**
 * @brief USE ( c-addr u -- )
 * Redirect system-wide REPL input to a named VM without touching the C
 * call stack.  The console prefix changes to [VMName].
 * USE Hera (vm_id 0) resets dispatch to the default (Mama's VM, NULL slot).
 */
void mama_word_use(VM *vm)
{
    char            name_buf[VM_NAME_MAX];
    VMRegistryEntry entry;
    uint32_t        i;
    cell_t          u, caddr;
    const char     *src;

    if (vm->dsp < 1) {
        vm->error = 1;
        return;
    }

    u     = vm_pop(vm);
    caddr = vm_pop(vm);

    if (u <= 0 || (uint32_t)u >= VM_NAME_MAX) {
        console_println("USE: name too long or empty");
        return;
    }

    /* caddr is a VM address; S" ( -- c-addr u ) stores chars directly at caddr */
    {
        const uint8_t *p = vm_ptr(vm, (vaddr_t)caddr);
        if (!p) { vm->error = 1; return; }
        src = (const char *)p;
    }
    for (i = 0; i < (uint32_t)u; i++) name_buf[i] = src[i];
    name_buf[u] = '\0';

    if (capsule_vm_find_by_name_nocase(name_buf, &entry) != 0) {
        console_puts("USE: ");
        console_puts(name_buf);
        console_println(" not found");
        return;
    }

    if (entry.state == VM_STATE_DEAD || entry.state == VM_STATE_STILLBORN) {
        console_puts("USE: ");
        console_puts(name_buf);
        console_println(" dead/stillborn");
        return;
    }

    /* Found live 2026-09-10: WIREBIND announces "attached and ready --
     * USE it to begin" the moment the target VM is registered, but
     * vm_enable_interpreter() is a separate, later step of that same
     * birth sequence. USE redirecting here before that step lands means
     * the very next line typed hits vm_assert_interpreter_enabled()
     * inside vm_interpret() and calls host->panic() -- a hard, whole-
     * machine halt, not the per-session-recoverable fault path the REPL
     * loop otherwise gives a redirected VM. Refuse the redirect instead;
     * the caller can just retry USE a moment later once birth finishes. */
    if (entry.vm_ptr && !((VM *)entry.vm_ptr)->interpreter_enabled) {
        console_puts("USE: ");
        console_puts(name_buf);
        console_println(" not ready yet -- still bootstrapping, try again");
        return;
    }

    /* BINDSTEP (FABRIC-2.md §F.9/§F.24): if the target has a real
     * installed identity (WIREBIND set this at attach time), re-verify
     * it against whatever drive is CURRENTLY attached -- live, not
     * cached (decision 1: this is a rare, human-triggered, interactive
     * operation, the re-verify cost is a non-issue, and it avoids any
     * staleness question if a drive was swapped without a clean
     * detach). A target with installed=0 (Hera/Hermes/Artemis today,
     * or any VM WIREBIND never touched) stays freely targetable, no
     * check applied -- decision 2, preserves USE's existing behavior
     * exactly for VMs that were never in scope for this lock. */
    if (entry.vm_ptr && ((VM *)entry.vm_ptr)->identity.installed) {
        struct blkio_dev *bdev = sk_repl_get_attached_blk_dev();
        homeblocks_sig_t  live_sig;
        VMIdentity        live_identity;
        int               ok = 0;

        if (bdev &&
            homeblocks_sig_check(bdev, HOMEBLOCKS_SIG_START_FBLOCK, &live_sig) == HOMEBLOCKS_SIG_OK &&
            capsule_wirebind_verify_cert(bdev, &live_sig, vm, &live_identity) == 0 &&
            memcmp(live_identity.owner_pubkey, ((VM *)entry.vm_ptr)->identity.owner_pubkey, 32) == 0) {
            ok = 1;
        }

        if (!ok) {
            console_puts("USE: ");
            console_puts(name_buf);
            console_println(" refused -- no matching identity currently attached");
            return;
        }
    }

    /* Hera — restore default dispatch (NULL = use REPL's own vm) */
    if (vm_uuid_is_hera(entry.vm_id)) {
        sk_repl_set_active_vm((void *)0);
    } else {
        sk_repl_set_active_vm((VM *)entry.vm_ptr);
    }

    console_set_vm_name(entry.name);

    console_puts("USE: now using ");
    console_println(entry.name);
    /* Stack clean on exit */
}

/**
 * @brief KILL ( c-addr u -- )
 * Destroy a named VM unconditionally.  Hera cannot be killed.
 * Idempotent: killing an already-dead VM is a no-op.
 */
void mama_word_kill(VM *vm)
{
    char        name_buf[VM_NAME_MAX];
    uint32_t    i;
    cell_t      u, caddr;
    const char *src;

    if (vm->dsp < 1) {
        vm->error = 1;
        return;
    }

    u     = vm_pop(vm);
    caddr = vm_pop(vm);

    if (u <= 0 || (uint32_t)u >= VM_NAME_MAX) {
        console_println("KILL: name too long or empty");
        return;
    }

    /* caddr is a VM address; S" ( -- c-addr u ) stores chars directly at caddr */
    {
        const uint8_t *p = vm_ptr(vm, (vaddr_t)caddr);
        if (!p) { vm->error = 1; return; }
        src = (const char *)p;
    }
    for (i = 0; i < (uint32_t)u; i++) name_buf[i] = src[i];
    name_buf[u] = '\0';

    /* Resolve vm_id and fan out its heat to survivors before the registry
     * entry is torn down -- capsule_vm_kill() only takes a name and
     * leaves no live entry to query afterward. Excludes Hera: her
     * self-referential parent_vm_id makes vm_physics_retire() treat her
     * as her own unreachable root and zero the fleet's entire heat sum,
     * before capsule_vm_kill()'s own Hera guard below ever runs. */
    {
        VMRegistryEntry entry;
        if (capsule_vm_find_by_name_nocase(name_buf, &entry) == 0 &&
            entry.state == VM_STATE_LIVE) {
            if (!vm_uuid_is_hera(entry.vm_id)) {
                vm_physics_retire(entry.vm_id);
            }
            /* FABRIC-2.md §F.10, real bug found and reported 2026-08-27,
             * fixed 2026-09-05: capsule_vm_kill() never touches
             * g_repl_active_vm -- killing the VM the console is currently
             * USE'd onto left it dangling (the REPL would fault on the
             * next command dispatched through it). EJECT/UNCLEAN
             * (capsule_wirebind.c) already reset-before-kill this way;
             * plain KILL's own call site never did. */
            if (entry.vm_ptr && sk_repl_get_active_vm() == (VM *) entry.vm_ptr) {
                sk_repl_set_active_vm((VM *) 0);
            }
        }
    }

    capsule_vm_kill(name_buf);
    /* Stack clean on exit */
}

/**
 * @brief EJECT ( -- )
 * Graceful detach of whatever identity is currently attached via the
 * home-blocks USB path (FABRIC-2.md §F.10, extended §I.8 2026-09-04) --
 * a regular WIREBIND user VM or Zuse herself, no identity handled any
 * differently. Single-USB-device constraint (§F.8) means there is only
 * ever one candidate, so at most one of the two calls below actually
 * does anything; the other is a no-op. capsule_wirebind_eject() flushes,
 * resets the console's active VM if bound to it, then kills a user VM;
 * capsule_zuse_boot_logout() clears zuse_session (no flush/kill -- Zuse
 * owns no separate VM or blocks of her own).
 */
void mama_word_eject(VM *vm)
{
    capsule_wirebind_eject();
    /* FABRIC-3.md §VII follow-on, 2026-09-06: capsule_zuse_boot_logout()
     * now requires the departing device to match the one tracked as
     * hers (the abrupt hot-unplug path's own fix) -- EJECT isn't reacting
     * to any specific device's detach event, so it passes her own tracked
     * device straight back in, which trivially matches when she's
     * genuinely attached and no-ops via the existing g_zuse_attached_
     * this_device check otherwise. */
    capsule_zuse_boot_logout(vm, capsule_zuse_boot_attached_dev());
    /* Stack clean on exit */
}

/**
 * @brief VM-STEP ( c-addr u -- )
 * Give one REPL quantum to a named VM.
 * Prints the VM's prompt, reads one line, executes it, returns to caller.
 * This is the Compudynamics context-switch primitive — Hera yields one
 * REPL turn to the named VM without surrendering the outer loop.
 */
static void mama_word_vm_step(VM *vm)
{
    char        name_buf[VM_NAME_MAX];
    uint32_t    i;
    cell_t      u, caddr;
    const char *src;
    VMRegistryEntry entry;
    VM         *target;
    char        saved_name[VM_NAME_MAX];

    if (vm->dsp < 1) { vm->error = 1; return; }

    u     = vm_pop(vm);
    caddr = vm_pop(vm);

    if (u <= 0 || (uint32_t)u >= VM_NAME_MAX) {
        console_println("VM-STEP: name too long or empty");
        return;
    }

    {
        const uint8_t *p = vm_ptr(vm, (vaddr_t)caddr);
        if (!p) { vm->error = 1; return; }
        src = (const char *)p;
    }
    for (i = 0; i < (uint32_t)u; i++) name_buf[i] = src[i];
    name_buf[u] = '\0';

    if (capsule_vm_find_by_name_nocase(name_buf, &entry) != 0) {
        console_puts("VM-STEP: VM not found: ");
        console_println(name_buf);
        return;
    }

    target = (VM *)entry.vm_ptr;
    if (!target || entry.state == VM_STATE_DEAD || entry.state == VM_STATE_STILLBORN) {
        console_puts("VM-STEP: VM not available: ");
        console_println(name_buf);
        return;
    }

    vm_physics_touch(entry.vm_id);

    console_save_vm_name(saved_name, sizeof(saved_name));
    console_set_vm_name(entry.name);
    sk_repl_step(target);
    console_set_vm_name(saved_name);
    /* Stack clean on exit */
}

/**
 * @brief VM-EXEC ( cmd-caddr cmd-u vm-name-caddr vm-name-u -- )
 * Inject a command string into a named VM and execute it immediately —
 * no readline, no blocking.  This is the autonomous Compudynamics primitive:
 * Hera can drive a FORTH command into any child VM without surrendering the
 * outer loop.  Console prefix is saved/restored around the call.
 *
 * Stack order: push cmd string first, then VM name.  Example:
 *   S" DOE-WORK" S" Hermes" VM-EXEC
 */
static void mama_word_vm_exec(VM *vm)
{
    char        vm_name[VM_NAME_MAX];
    char        cmd_buf[INPUT_BUFFER_SIZE];
    uint32_t    i;
    cell_t      vm_u, vm_caddr, cmd_u, cmd_caddr;
    const char *src;
    VMRegistryEntry entry;
    VM         *target;
    char        saved_name[VM_NAME_MAX];

    if (vm->dsp < 3) { vm->error = 1; return; }

    /* TOS: vm-name-u, vm-name-caddr, cmd-u, cmd-caddr */
    vm_u     = vm_pop(vm);
    vm_caddr = vm_pop(vm);
    cmd_u    = vm_pop(vm);
    cmd_caddr = vm_pop(vm);

    if (vm_u <= 0 || (uint32_t)vm_u >= VM_NAME_MAX) {
        console_println("VM-EXEC: VM name too long or empty");
        return;
    }
    if (cmd_u < 0 || (uint32_t)cmd_u >= INPUT_BUFFER_SIZE) {
        console_println("VM-EXEC: command too long");
        return;
    }

    {
        const uint8_t *p = vm_ptr(vm, (vaddr_t)vm_caddr);
        if (!p) { vm->error = 1; return; }
        src = (const char *)p;
    }
    for (i = 0; i < (uint32_t)vm_u; i++) vm_name[i] = src[i];
    vm_name[vm_u] = '\0';

    {
        const uint8_t *p = vm_ptr(vm, (vaddr_t)cmd_caddr);
        if (!p) { vm->error = 1; return; }
        src = (const char *)p;
    }
    for (i = 0; i < (uint32_t)cmd_u; i++) cmd_buf[i] = src[i];
    cmd_buf[cmd_u] = '\0';

    if (capsule_vm_find_by_name_nocase(vm_name, &entry) != 0) {
        console_puts("VM-EXEC: VM not found: ");
        console_println(vm_name);
        return;
    }

    target = (VM *)entry.vm_ptr;
    if (!target || entry.state == VM_STATE_DEAD || entry.state == VM_STATE_STILLBORN) {
        console_puts("VM-EXEC: VM not available: ");
        console_println(vm_name);
        return;
    }

    vm_physics_touch(entry.vm_id);

    log_message(LOG_INFO, "VM-EXEC: '%s' -> '%s'", cmd_buf, vm_name);
    console_save_vm_name(saved_name, sizeof(saved_name));
    console_set_vm_name(entry.name);
    vm_state_push(vm);
    vm_interpret(target, cmd_buf);
    vm_state_pop(vm);
    console_set_vm_name(saved_name);

    if (target->error) {
        console_puts("VM-EXEC: ERROR in ");
        console_println(vm_name);
        target->error = 0;
    }
    /* Stack clean on exit */
}

/**
 * @brief VM-CALL ( cmd-caddr cmd-u vm-name-caddr vm-name-u -- n )
 * Like VM-EXEC but pops one cell from the target VM's TOS and pushes
 * it onto the caller's stack after execution.  Used for cross-VM
 * queries (e.g. HERMES-K in K-FLEET).  Pushes 0 on error or empty
 * target stack and sets vm->error if target left nothing.
 */
static void mama_word_vm_call(VM *vm)
{
    char        vm_name[VM_NAME_MAX];
    char        cmd_buf[INPUT_BUFFER_SIZE];
    uint32_t    i;
    cell_t      vm_u, vm_caddr, cmd_u, cmd_caddr;
    const char *src;
    VMRegistryEntry entry;
    VM         *target;
    char        saved_name[VM_NAME_MAX];

    if (vm->dsp < 3) { vm->error = 1; return; }

    vm_u      = vm_pop(vm);
    vm_caddr  = vm_pop(vm);
    cmd_u     = vm_pop(vm);
    cmd_caddr = vm_pop(vm);

    if (vm_u <= 0 || (uint32_t)vm_u >= VM_NAME_MAX) {
        console_println("VM-CALL: VM name too long or empty");
        vm_push(vm, 0); return;
    }
    if (cmd_u < 0 || (uint32_t)cmd_u >= INPUT_BUFFER_SIZE) {
        console_println("VM-CALL: command too long");
        vm_push(vm, 0); return;
    }

    {
        const uint8_t *p = vm_ptr(vm, (vaddr_t)vm_caddr);
        if (!p) { vm->error = 1; return; }
        src = (const char *)p;
    }
    for (i = 0; i < (uint32_t)vm_u; i++) vm_name[i] = src[i];
    vm_name[vm_u] = '\0';

    {
        const uint8_t *p = vm_ptr(vm, (vaddr_t)cmd_caddr);
        if (!p) { vm->error = 1; return; }
        src = (const char *)p;
    }
    for (i = 0; i < (uint32_t)cmd_u; i++) cmd_buf[i] = src[i];
    cmd_buf[cmd_u] = '\0';

    if (capsule_vm_find_by_name_nocase(vm_name, &entry) != 0) {
        console_puts("VM-CALL: VM not found: ");
        console_println(vm_name);
        vm_push(vm, 0); return;
    }

    target = (VM *)entry.vm_ptr;
    if (!target || entry.state == VM_STATE_DEAD || entry.state == VM_STATE_STILLBORN) {
        console_puts("VM-CALL: VM not available: ");
        console_println(vm_name);
        vm_push(vm, 0); return;
    }

    vm_physics_touch(entry.vm_id);

    log_message(LOG_DEBUG, "VM-CALL: '%s' -> '%s'", cmd_buf, vm_name);
    console_save_vm_name(saved_name, sizeof(saved_name));
    console_set_vm_name(entry.name);
    vm_state_push(vm);
    vm_interpret(target, cmd_buf);
    vm_state_pop(vm);
    console_set_vm_name(saved_name);

    if (target->error) {
        console_puts("VM-CALL: ERROR in ");
        console_println(vm_name);
        target->error = 0;
        vm_push(vm, 0); return;
    }

    if (target->dsp >= 0) {
        vm_push(vm, vm_pop(target));
    } else {
        console_println("VM-CALL: target left empty stack");
        vm->error = 1;
        vm_push(vm, 0);
    }
}

/**
 * @brief VM-HEAT ( c-addr u -- heat-q48 )
 * Push the named VM's current execution_heat_q48 (Q48.16, 0 if the VM is
 * unknown/dead), via vm_physics_heat_of() -- previously C-internal only
 * (doe_log_heat_by_name(), doe_log.c), never exposed to FORTH. Added
 * 2026-09-12 for a compudynamic turn-attractor (FABRIC-3.md §XIX): "whose
 * turn is next" decided by comparing live candidates' own current heat via
 * this word, the same density-comparison judgment stadium_admit() already
 * makes for eviction, rather than a fixed round-robin order. Silent on an
 * unknown name (returns 0, does not print/error) -- callers scanning many
 * VM names each turn to find the coolest one should not have to filter
 * console noise for names that are simply not currently live.
 */
static void mama_word_vm_heat(VM *vm)
{
    char        vm_name[VM_NAME_MAX];
    uint32_t    i;
    cell_t      vm_u, vm_caddr;
    const char *src;
    VMRegistryEntry entry;

    if (vm->dsp < 1) { vm->error = 1; return; }

    vm_u     = vm_pop(vm);
    vm_caddr = vm_pop(vm);

    if (vm_u <= 0 || (uint32_t)vm_u >= VM_NAME_MAX) {
        vm_push(vm, 0);
        return;
    }

    {
        const uint8_t *p = vm_ptr(vm, (vaddr_t)vm_caddr);
        if (!p) { vm->error = 1; return; }
        src = (const char *)p;
    }
    for (i = 0; i < (uint32_t)vm_u; i++) vm_name[i] = src[i];
    vm_name[vm_u] = '\0';

    if (capsule_vm_find_by_name_nocase(vm_name, &entry) != 0) {
        vm_push(vm, 0);
        return;
    }

    vm_push(vm, (cell_t)vm_physics_heat_of(entry.vm_id));
}

/**
 * @brief MINT ( -- ok? )
 * Mint a fresh identity onto the currently attached USB drive
 * (FABRIC-2.md §F.8/§F.19). Deliberately no name/string argument despite
 * F.8's original "S\" name\" MINT" sketch: this design never binds a VM
 * name at mint time -- the drive holds an anonymous, self-contained
 * identity, and a name is only assigned later, at RUNCAP birth (a
 * WIREBIND decision, not MINT's). Refuses cleanly (prints why) if
 * there's no attached drive, the drive already reads as a recognized
 * home-blocks drive, Zuse has no installed cert to sign with, or there's
 * no entropy source. Real, working code -- not the eventual Console
 * onboarding flow (§D.6), which will call this same C function.
 */
/* Pop one ( caddr u ) string pair and copy it, NUL-terminated, into
 * dst (capacity dst_cap). Returns 0 on success, -1 on underflow/bounds/
 * unmapped-address failure (vm->error is set in that case). */
static int mint_pop_string(VM *vm, char *dst, size_t dst_cap)
{
    if (vm->dsp < 1) { vm->error = 1; return -1; }
    cell_t u     = vm_pop(vm);
    cell_t caddr = vm_pop(vm);
    if (u < 0 || (size_t)u >= dst_cap) { vm->error = 1; return -1; }
    if (u > 0) {
        const uint8_t *p = vm_ptr(vm, (vaddr_t)caddr);
        if (!p) { vm->error = 1; return -1; }
        memcpy(dst, p, (size_t)u);
    }
    dst[u] = '\0';
    return 0;
}

/**
 * @brief MINT ( fname-c fname-u uname-c uname-u email-c email-u phone-c phone-u restrict? -- ok? )
 * Mint a fresh identity onto the currently attached USB drive, with a
 * real human profile (FABRIC-2.md §F.20). full_name/username required
 * and non-empty; pass a zero-length string (S" ") for email/phone to
 * leave them null. restrict? nonzero mints with the FORTH-79/83-only
 * lockdown personality (MINT_PERSONALITY_STD79_LOCKDOWN,
 * capsules/acl-std79.4th applies the actual restriction at that VM's own
 * first birth) instead of the default, unrestricted one -- Captain Bob,
 * 2026-09-07: "give access only to FORTH 79 and 83 standard words,
 * everything else is locked down."
 */
static void mama_word_mint(VM *vm)
{
    char phone[USER_IDENTITY_PHONE_MAX];
    char email[USER_IDENTITY_EMAIL_MAX];
    char username[USER_IDENTITY_USERNAME_MAX];
    char full_name[USER_IDENTITY_FULL_NAME_MAX];

    /* Stack order: fname pushed first, restrict? last -- pop in reverse. */
    if (vm->dsp < 0) { vm->error = 1; return; }
    cell_t restrict_flag = vm_pop(vm);
    if (mint_pop_string(vm, phone, sizeof(phone)) != 0) return;
    if (mint_pop_string(vm, email, sizeof(email)) != 0) return;
    if (mint_pop_string(vm, username, sizeof(username)) != 0) return;
    if (mint_pop_string(vm, full_name, sizeof(full_name)) != 0) return;

    struct blkio_dev *dev = sk_repl_get_attached_blk_dev();
    if (!dev) {
        console_println("MINT: no drive attached");
        vm_push(vm, 0);
        return;
    }

    MintPersonality personality = restrict_flag
                                   ? MINT_PERSONALITY_STD79_LOCKDOWN
                                   : MINT_PERSONALITY_DEFAULT;
    MintResult r = capsule_mint_identity(dev, vm, full_name, username, email, phone,
                                          (uint8_t *)0, (uint8_t *)0,
                                          personality,
                                          0 /* not pre-checked -- keep the safety check */);
    switch (r) {
        case MINT_OK:
            console_println("MINT: identity minted");
            vm_push(vm, 1);
            return;
        case MINT_ERR_ALREADY_MINTED:
            console_println("MINT: refused -- drive already a recognized home-blocks drive");
            break;
        case MINT_ERR_NO_ZUSE_CERT:
            console_println("MINT: refused -- Zuse has no installed cert to sign with");
            break;
        case MINT_ERR_NO_ENTROPY:
            console_println("MINT: refused -- no entropy source");
            break;
        case MINT_ERR_CERT_BUILD:
            console_println("MINT: FAILED -- cert construction error");
            break;
        case MINT_ERR_WRITE_FAIL:
            console_println("MINT: FAILED -- devblock write error (drive may be partially minted)");
            break;
        case MINT_ERR_INVALID_PROFILE:
            console_println("MINT: refused -- full_name/username missing or a field too long");
            break;
        case MINT_ERR_VERIFY_FAILED:
            console_println("MINT: FAILED -- wrote identity but post-write verification failed "
                             "(see log for which check)");
            break;
    }
    vm_push(vm, 0);
}

/**
 * @brief ZUSE-ELIGIBILITY-ADD ( c-addr -- ok? )
 * Add the 32-byte Ed25519 public key at c-addr to Zuse's elevation
 * eligibility list (FABRIC-2.md §H.5/§H.12 item 19). Plain, unconditional
 * primitive -- no authorization check here or anywhere else in this
 * codebase gates on vm->zuse_session. Zuse's authority is the *absence*
 * of any ACL restricting her, not a bit this or any other word checks;
 * restricting who may call this word, if ever wanted, is the same
 * standing word-level ACL mechanism (acl_allow/ACL-PIN in ACL.4th) any
 * other word would use, applied later if and when actually needed --
 * not invented here.
 */
static void mama_word_zuse_eligibility_add(VM *vm)
{
    if (vm->dsp < 0) {
        vm->error = 1;
        vm_push(vm, 0);
        return;
    }
    cell_t caddr = vm_pop(vm);
    const uint8_t *pubkey = vm_ptr(vm, (vaddr_t)caddr);
    if (!pubkey) {
        vm->error = 1;
        vm_push(vm, 0);
        return;
    }

    if (zuse_eligibility_add(pubkey) != 0) {
        console_println("ZUSE-ELIGIBILITY-ADD: FAILED -- fence write error");
        vm_push(vm, 0);
        return;
    }

    vm_push(vm, 1);
}

/**
 * @brief ZUSE-ELIGIBLE? ( c-addr -- flag )
 * Membership check over Zuse's elevation eligibility list (FABRIC-2.md
 * §H.5/§H.12 item 21). Plain, unconditional wrapper over
 * zuse_eligibility_is_member() -- same "no bespoke gate" convention as
 * ZUSE-ELIGIBILITY-ADD above; is_member() itself is already fail-closed.
 */
static void mama_word_zuse_eligible_query(VM *vm)
{
    if (vm->dsp < 0) {
        vm->error = 1;
        vm_push(vm, 0);
        return;
    }
    cell_t caddr = vm_pop(vm);
    const uint8_t *pubkey = vm_ptr(vm, (vaddr_t)caddr);
    if (!pubkey) {
        vm->error = 1;
        vm_push(vm, 0);
        return;
    }
    vm_push(vm, zuse_eligibility_is_member(pubkey) ? -1 : 0);
}

/**
 * @brief NAME>XT ( c-addr u -- xt|0 )
 * Dynamic dictionary lookup for a name already sitting in a data buffer
 * (e.g. a message payload's argument), as opposed to `FIND`/`'` which
 * parse the next word from the live input stream -- FIND itself is never
 * modified, per this project's standing rule; this is a separate,
 * mechanism-only primitive for the same lookup from a data-stack string.
 * Miss (word not found) is not an error: pushes 0, matching FIND's own
 * "miss is NOT an error" convention.
 */
static void mama_word_name_to_xt(VM *vm)
{
    if (vm->dsp < 1) {
        vm->error = 1;
        vm_push(vm, 0);
        return;
    }
    cell_t u = vm_pop(vm);
    cell_t caddr = vm_pop(vm);
    if (u < 0 || u > 127) {
        vm_push(vm, 0);
        return;
    }
    const uint8_t *name = vm_ptr(vm, (vaddr_t)caddr);
    if (!name) {
        vm->error = 1;
        vm_push(vm, 0);
        return;
    }
    DictEntry *e = vm_find_word(vm, (const char *)name, (size_t)u);
    vm_push(vm, (cell_t)(uintptr_t)e);
}

/**
 * @brief ELEVATE-PUBKEY-UNPACK ( pk0 pk1 pk2 pk3 buf-addr -- )
 * Reconstructs a 32-byte Ed25519 pubkey from 4 cells into the 32-byte
 * buffer at buf-addr, matching ZUSE-PUBKEY@'s own convention exactly:
 * chunk i (0..3) is the 8-byte little-endian encoding of pubkey bytes
 * [i*8 .. i*8+7] -- this is that packing's inverse, so a pubkey sent as
 * 4 cells (see common:messaging.4th's SEND-ELEVATE-REQUEST) round-trips
 * byte-exact regardless of any individual chunk's sign bit.
 */
static void mama_word_elevate_pubkey_unpack(VM *vm)
{
    if (vm->dsp < 4) {
        vm->error = 1;
        return;
    }
    cell_t buf_addr = vm_pop(vm);
    cell_t pk[4];
    for (int i = 3; i >= 0; i--) pk[i] = vm_pop(vm);

    uint8_t *buf = vm_ptr(vm, (vaddr_t)buf_addr);
    if (!buf) {
        vm->error = 1;
        return;
    }
    for (int i = 0; i < 4; i++) {
        uint64_t chunk = (uint64_t)pk[i];
        for (int b = 0; b < 8; b++) {
            buf[i * 8 + b] = (uint8_t)(chunk >> (8 * b));
        }
    }
}

/**
 * @brief RUNCAP-TEST ( caddr u -- ok? rc )
 * Diagnostic-only word (FABRIC-2.md §F.6/§F.18): calls
 * capsule_runcap_birth() against whatever drive sk_repl_get_homeblocks_
 * dev()/sig() currently report, naming the new VM from the given string.
 * Not the real RUNCAP call site -- that's WIREBIND (still unbuilt); this
 * exists to exercise capsule_runcap_birth() live before WIREBIND exists.
 * ok? is 1/0; rc is the raw CapsuleRunResult for diagnosis either way.
 */
static void mama_word_runcap_test(VM *vm)
{
    char        vm_name[VM_NAME_MAX];
    cell_t      u, caddr;
    uint32_t    i;

    if (vm->dsp < 1) { vm->error = 1; return; }
    u     = vm_pop(vm);
    caddr = vm_pop(vm);

    if (u <= 0 || (uint32_t)u >= VM_NAME_MAX) {
        console_println("RUNCAP-TEST: name too long or empty");
        vm_push(vm, 0); vm_push(vm, (cell_t)CAPSULE_RUN_ERR_INVALID);
        return;
    }
    {
        const uint8_t *p = vm_ptr(vm, (vaddr_t)caddr);
        if (!p) { vm->error = 1; return; }
        for (i = 0; i < (uint32_t)u; i++) vm_name[i] = (char)p[i];
    }
    vm_name[u] = '\0';

    struct blkio_dev        *dev = sk_repl_get_homeblocks_dev();
    const homeblocks_sig_t  *sig = sk_repl_get_homeblocks_sig();
    if (!dev || !sig) {
        console_println("RUNCAP-TEST: no home-blocks drive attached");
        vm_push(vm, 0); vm_push(vm, (cell_t)CAPSULE_RUN_ERR_INVALID);
        return;
    }

    VMUuid new_vm_id;
    CapsuleRunResult r = capsule_runcap_birth(dev, sig, vm_name, vm->stadium_vm_id,
                                               &new_vm_id, (void **)0);
    vm_push(vm, r == CAPSULE_RUN_OK ? 1 : 0);
    vm_push(vm, (cell_t)r);
}

/**
 * @brief PAIR-TEST ( caddr u -- ok? )
 * Diagnostic-only word (FABRIC-2.md Phase F, 2026-08-28): births a
 * console VM (bare, capsule_console.h) named by the given string, and a
 * user VM (capsule_runcap_birth(), from whatever drive sk_repl_get_
 * homeblocks_dev()/sig() currently report) named "<string>~user" --
 * the pairing convention sk_repl_dispatch_line() (repl.c) looks for.
 * Registers the pairing in the console's own VM-name routing table at
 * the fixed index (3) that relay uses. Not the real pairing call site
 * -- that's the eventual attach/onboarding flow; this exists to
 * exercise the console-VM + user-VM relay live before that exists.
 */
static void mama_word_pair_test(VM *vm)
{
    char        console_name[VM_NAME_MAX];
    char        user_name[VM_NAME_MAX + 8];
    cell_t      u, caddr;
    uint32_t    i;

    if (vm->dsp < 1) { vm->error = 1; return; }
    u     = vm_pop(vm);
    caddr = vm_pop(vm);

    if (u <= 0 || (uint32_t)u >= VM_NAME_MAX) {
        console_println("PAIR-TEST: name too long or empty");
        vm_push(vm, 0);
        return;
    }
    {
        const uint8_t *p = vm_ptr(vm, (vaddr_t)caddr);
        if (!p) { vm->error = 1; return; }
        for (i = 0; i < (uint32_t)u; i++) console_name[i] = (char)p[i];
    }
    console_name[u] = '\0';

    memcpy(user_name, console_name, (size_t)u);
    memcpy(user_name + u, "~user", 6); /* includes NUL */

    struct blkio_dev        *dev = sk_repl_get_homeblocks_dev();
    const homeblocks_sig_t  *sig = sk_repl_get_homeblocks_sig();
    if (!dev || !sig) {
        console_println("PAIR-TEST: no home-blocks drive attached");
        vm_push(vm, 0);
        return;
    }

    VMUuid console_id, user_id;
    void  *console_ctx = (void *)0;
    if (capsule_console_birth(console_name, vm->stadium_vm_id, &console_id, &console_ctx)
        != CAPSULE_RUN_OK) {
        console_println("PAIR-TEST: console birth FAILED");
        vm_push(vm, 0);
        return;
    }
    if (capsule_runcap_birth(dev, sig, user_name, vm->stadium_vm_id, &user_id, (void **)0)
        != CAPSULE_RUN_OK) {
        console_println("PAIR-TEST: user birth FAILED");
        vm_push(vm, 0);
        return;
    }

    /* Register the pairing in the console's own routing table, index 3
     * -- the fixed convention sk_repl_dispatch_line()'s constructed
     * MSG-SEND text uses. */
    {
        char reg_cmd[VM_NAME_MAX + 32];
        int  n = snprintf(reg_cmd, sizeof(reg_cmd), "S\" %s\" 3 VM-NAME-REG", user_name);
        if (n > 0 && (size_t)n < sizeof(reg_cmd)) {
            vm_interpret((VM *)console_ctx, reg_cmd);
        }
    }

    console_println("PAIR-TEST: console + user VM pair live");
    vm_push(vm, 1);
}

/**
 * @brief CAPSULE-BIRTH ( capsule-id -- vm-id-hi vm-id-lo )
 * Birth a baby VM from a production (p) capsule.
 * Returns the new VM's 128-bit ID as a double (item 3.8 -- FORTH already
 * has double-cell words for exactly this), high cell on top, or
 * vm_uuid_none()'s hi/lo (both all-ones) on failure.
 */
void mama_word_capsule_birth(VM *vm)
{
    if (vm->dsp < 0) {
        vm->error = 1;
        return;
    }

    cell_t capsule_idx = vm_pop(vm);
    VMUuid new_vm_id = vm_uuid_none();

    if ((uint64_t)capsule_idx >= capsule_get_desc_count()) {
        vm_push(vm, (cell_t)new_vm_id.lo);
        vm_push(vm, (cell_t)new_vm_id.hi);
        return;
    }
    const char *cap_name = capsule_get_names()[(uint32_t)capsule_idx].name;

    CapsuleRunResult result = capsule_birth_baby(
        cap_name,
        capsule_get_directory(),
        capsule_get_descriptors(),
        capsule_get_names(),
        capsule_get_arena(),
        vm->stadium_vm_id, /* §H.12 step 7: who is birthing this VM */
        0,  /* skip_pki_sig: normal build-time capsule */
        &new_vm_id,
        (void **)0  /* Don't need VM context back */
    );

    if (result != CAPSULE_RUN_OK) {
        new_vm_id = vm_uuid_none();  /* Birth failed */
    }
    vm_push(vm, (cell_t)new_vm_id.lo);
    vm_push(vm, (cell_t)new_vm_id.hi);
}

/**
 * @brief CAPSULE-RUN ( capsule-id -- )
 * Run an experiment (e) capsule on Mama.
 */
void mama_word_capsule_run(VM *vm)
{
    if (vm->dsp < 0) {
        vm->error = 1;
        return;
    }

    cell_t capsule_idx = vm_pop(vm);

    if ((uint64_t)capsule_idx >= capsule_get_desc_count()) {
        vm->error = 1;
        return;
    }
    const char *cap_name = capsule_get_names()[(uint32_t)capsule_idx].name;

    /* Run experiment on Mama (this VM) */
    capsule_run_experiment(
        vm,
        cap_name,
        capsule_get_directory(),
        capsule_get_descriptors(),
        capsule_get_names(),
        capsule_get_arena(),
        (uint64_t *)0  /* Don't need run_id back */
    );
}

/* ============================================================================
 * VM Registry Words
 * ============================================================================ */

/**
 * @brief MAMA-VM-ID ( -- 0 0 )
 * Push Mama's VM ID as a double (item 3.8): vm_uuid_hera() is all-zero,
 * so both cells are 0. High cell on top, matching CAPSULE-BIRTH.
 */
void mama_word_mama_vm_id(VM *vm)
{
    vm_push(vm, 0);
    vm_push(vm, 0);
}

/**
 * @brief VM-COUNT ( -- n )
 * Push number of registered VMs.
 */
void mama_word_vm_count(VM *vm)
{
    vm_push(vm, (cell_t)capsule_vm_registry_count());
}

/**
 * @brief VM-CONSERVED? ( -- flag )
 * FORTH-79 boolean: TRUE (-1) if |fleet_heat_sum - Q.1| < epsilon, else
 * FALSE (0). Replaces fleet-k.4th's K-CONSERVED?.
 */
static void mama_word_vm_conserved(VM *vm)
{
    vm_push(vm, vm_physics_conserved() ? (cell_t)-1 : (cell_t)0);
}

/**
 * @brief VM-PHYSICS-STATUS ( -- )
 * Print the fleet physics diagnostic report. Replaces fleet-k.4th's
 * K-STATUS and compudynamics.4th's VM-STATUS.
 */
static void mama_word_vm_physics_status(VM *vm)
{
    (void)vm;
    vm_physics_status();
}

/* ============================================================================
 * Diagnostic Words
 * ============================================================================ */

/**
 * @brief CAPSULE-TEST ( -- )
 * Print diagnostic message confirming capsule system is active.
 */
void mama_word_capsule_test(VM *vm)
{
    (void)vm;
    console_println("Mama FORTH Capsule System (M7.1)");
    console_puts("  Capsules: ");
    console_println("");
    console_puts("  VMs: ");
    console_println("");
}

/* ============================================================================
 * Vocabulary Registration
 * ============================================================================ */

/**
 * @brief EXEC ( c-addr u -- )
 * Execute a named capsule in the current VM — same path as mama init auto-run.
 */
void mama_word_exec(VM *vm)
{
    char         name_buf[VM_NAME_MAX];
    uint32_t     i;
    cell_t       u, caddr;
    const char  *src;
    CapsuleRunResult result;
    int          saved_dsp;
    int          saved_rsp;

    if (vm->dsp < 1) { vm->error = 1; return; }

    u     = vm_pop(vm);
    caddr = vm_pop(vm);

    if (u <= 0 || (uint32_t)u >= VM_NAME_MAX) {
        console_println("EXEC: name too long or empty");
        return;
    }

    {
        const uint8_t *p = vm_ptr(vm, (vaddr_t)caddr);
        if (!p) { vm->error = 1; return; }
        src = (const char *)p;
    }
    for (i = 0; i < (uint32_t)u; i++) name_buf[i] = src[i];
    name_buf[u] = '\0';

    /* Save both stacks so a crashing capsule cannot corrupt the caller.
     * DSP: any partial pushes by the capsule are discarded.
     * RSP: DO-LOOP indices pushed by the caller (e.g. the DoE loop) are
     * preserved; a capsule that crashed mid->R/R> cannot corrupt them. */
    saved_dsp = vm->dsp;
    saved_rsp = vm->rsp;

    log_message(LOG_INFO, "EXEC: capsule '%s'", name_buf);
    result = capsule_exec_init(
        vm,
        name_buf,
        capsule_get_directory(),
        capsule_get_descriptors(),
        capsule_get_names(),
        capsule_get_arena());

    /* Restore stacks and clear error/exit flags so the DoE loop survives
     * a workload crash and continues cleanly to the next run. */
    vm->dsp        = saved_dsp;
    vm->rsp        = saved_rsp;
    vm->error      = 0;
    vm->exit_colon = 0;

    if (result != CAPSULE_RUN_OK) {
        console_puts("EXEC: failed: ");
        console_println(name_buf);
    }
}

/**
 * @brief CONNECT-ARTEMIS ( -- ) — Enter Artemis's REPL, birthing it first if needed.
 */
static void mama_word_connect_artemis(VM *vm)
{
    VMRegistryEntry  entry;
    VM              *artemis;
    char             saved_name[VM_NAME_MAX];

    if (capsule_vm_find_by_name_nocase("Artemis", &entry) != 0 ||
        entry.state == VM_STATE_DEAD ||
        entry.state == VM_STATE_STILLBORN) {
        VMUuid new_vm_id = vm_uuid_none();
        char saved[VM_NAME_MAX]; console_save_vm_name(saved, sizeof(saved));
        CapsuleRunResult r;

        console_set_vm_name("Artemis");
        r = capsule_birth_baby(
            "artemis:init.4th",
            capsule_get_directory(),
            capsule_get_descriptors(),
            capsule_get_names(),
            capsule_get_arena(),
            vm->stadium_vm_id, /* §H.12 step 7: who is birthing this VM */
            0,  /* skip_pki_sig: normal build-time capsule */
            &new_vm_id, (void **)0);
        console_set_vm_name(saved);

        if (r != CAPSULE_RUN_OK) {
            console_println("CONNECT-ARTEMIS: birth failed");
            return;
        }
        capsule_vm_registry_set_name(new_vm_id, "Artemis");
        if (capsule_vm_find_by_name_nocase("Artemis", &entry) != 0) {
            console_println("CONNECT-ARTEMIS: registry error");
            return;
        }
    }

    artemis = (VM *)entry.vm_ptr;
    if (!artemis) {
        console_println("CONNECT-ARTEMIS: no VM pointer");
        return;
    }

    console_save_vm_name(saved_name, sizeof(saved_name));
    console_set_vm_name(entry.name);
    capsule_vm_set_state(entry.vm_id, VM_STATE_LIVE);

    sk_repl_run(artemis);

    capsule_vm_set_state(entry.vm_id, VM_STATE_STOPPED);
    console_set_vm_name(saved_name);
}

/**
 * @brief BYE ( -- ) — Hera-only: reap all children then cold-restart the machine.
 *
 * In child VMs this word is never registered; children use the standard
 * system_word_bye which sets vm->halted and returns to the parent's REPL.
 */
static void mama_word_bye(VM *vm __attribute__((unused)))
{
    console_println("BYE: reaping children");
    capsule_vm_kill_all_nonmama();
    console_println("BYE: cold restart");
    arch_cold_reset();
}

/**
 * @brief CONNECT-HERMES ( -- ) — Enter Hermes's REPL, birthing it first if needed.
 *
 * Idempotent: if Hermes is already born (LIVE or STOPPED) it is entered
 * directly without re-birthing.  On BYE from Hermes, control returns here.
 */
static void mama_word_connect_hermes(VM *vm)
{
    VMRegistryEntry  entry;
    VM              *hermes;
    char             saved_name[VM_NAME_MAX];

    /* Birth if not found or previously dead/stillborn */
    if (capsule_vm_find_by_name_nocase("Hermes", &entry) != 0 ||
        entry.state == VM_STATE_DEAD ||
        entry.state == VM_STATE_STILLBORN) {
        VMUuid new_vm_id = vm_uuid_none();
        char saved[VM_NAME_MAX]; console_save_vm_name(saved, sizeof(saved));
        CapsuleRunResult r;

        console_set_vm_name("Hermes");
        r = capsule_birth_baby(
            "hermes:init.4th",
            capsule_get_directory(),
            capsule_get_descriptors(),
            capsule_get_names(),
            capsule_get_arena(),
            vm->stadium_vm_id, /* §H.12 step 7: who is birthing this VM */
            0,  /* skip_pki_sig: normal build-time capsule */
            &new_vm_id, (void **)0);
        console_set_vm_name(saved);

        if (r != CAPSULE_RUN_OK) {
            console_println("CONNECT-HERMES: birth failed");
            return;
        }
        capsule_vm_registry_set_name(new_vm_id, "Hermes");
        if (capsule_vm_find_by_name_nocase("Hermes", &entry) != 0) {
            console_println("CONNECT-HERMES: registry error");
            return;
        }
    }

    hermes = (VM *)entry.vm_ptr;
    if (!hermes) {
        console_println("CONNECT-HERMES: no VM pointer");
        return;
    }

    console_save_vm_name(saved_name, sizeof(saved_name));
    console_set_vm_name(entry.name);
    capsule_vm_set_state(entry.vm_id, VM_STATE_LIVE);

    sk_repl_run(hermes);

    capsule_vm_set_state(entry.vm_id, VM_STATE_STOPPED);
    console_set_vm_name(saved_name);
}

/* Forward declarations: these 8 are defined later in this file (originally
 * only ever used from register_child_vm_words(), which comes after them),
 * but FABRIC-3.md SXX now also registers them here, earlier in the file. */
static void mama_word_stadium_admit(VM *vm);
static void mama_word_stadium_evict(VM *vm);
static void mama_word_stadium_res_fetch(VM *vm);
static void mama_word_stadium_res_pull(VM *vm);
static void mama_word_stadium_res_push(VM *vm);
static void mama_word_stadium_heat_fetch(VM *vm);
static void mama_word_stadium_heat_store(VM *vm);
static void mama_word_stadium_word_heat(VM *vm);

/**
 * @brief Register Mama FORTH vocabulary words with the VM
 *
 * Creates the MAMA vocabulary and registers all capsule-related words.
 *
 * @param vm Pointer to the VM instance
 */
void register_mama_forth_words(VM *vm)
{
    /* Register words in FORTH vocabulary first */
    register_word(vm, "BYE", mama_word_bye);
    register_word(vm, "CONNECT-HERMES", mama_word_connect_hermes);
    register_word(vm, "CONNECT-ARTEMIS", mama_word_connect_artemis);
    register_word(vm, "BIRTH", mama_word_birth);
    register_word(vm, "KILL", mama_word_kill);
    register_word(vm, "EJECT", mama_word_eject);
    register_word(vm, "START", mama_word_start);
    register_word(vm, "STOP", mama_word_stop);
    register_word(vm, "USE", mama_word_use);
    register_word(vm, "EXEC", mama_word_exec);
    register_word(vm, "CAPSULE-COUNT", mama_word_capsule_count);
    register_word(vm, "CAPSULE@", mama_word_capsule_fetch);
    register_word(vm, "CAPSULE-HASH@", mama_word_capsule_hash_fetch);
    register_word(vm, "CAPSULE-FLAGS@", mama_word_capsule_flags_fetch);
    register_word(vm, "CAPSULE-LEN@", mama_word_capsule_len_fetch);
    register_word(vm, "CAPSULE-BIRTH", mama_word_capsule_birth);
    register_word(vm, "CAPSULE-RUN", mama_word_capsule_run);
    register_word(vm, "MINT", mama_word_mint);
    register_word(vm, "ZUSE-ELIGIBILITY-ADD", mama_word_zuse_eligibility_add);
    register_word(vm, "ZUSE-ELIGIBLE?", mama_word_zuse_eligible_query);
    register_word(vm, "NAME>XT", mama_word_name_to_xt);
    register_word(vm, "ELEVATE-PUBKEY-UNPACK", mama_word_elevate_pubkey_unpack);
    register_word(vm, "RUNCAP-TEST", mama_word_runcap_test);
    register_word(vm, "PAIR-TEST", mama_word_pair_test);
    register_word(vm, "MAMA-VM-ID", mama_word_mama_vm_id);
    register_word(vm, "VM-COUNT", mama_word_vm_count);
    register_word(vm, "VM-CONSERVED?", mama_word_vm_conserved);
    register_word(vm, "VM-PHYSICS-STATUS", mama_word_vm_physics_status);
    register_word(vm, "VM-STEP", mama_word_vm_step);
    register_word(vm, "VM-EXEC", mama_word_vm_exec);
    register_word(vm, "VM-CALL", mama_word_vm_call);
    register_word(vm, "VM-HEAT", mama_word_vm_heat);
    /* FABRIC-3.md SXX: the 8 STADIUM-* primitives register_child_vm_words()
     * gives every other VM, added here too -- root cause of "Hera cannot
     * load common:messaging.4th" (kernel_main.c's old Phase C comment):
     * messaging.4th's own colon-definitions (MSG-HEAT@, CH-HEAT@,
     * MSG-COOL-ALL, MSG-TICK, etc.) reference these, and referencing an
     * undefined word during compilation silently drops the definition
     * rather than raising a compile error -- not a messaging bug, a
     * missing-primitive gap in Hera's own dictionary specifically. Fixed
     * by symmetry, not a special case: Hera's dictionary is now a proper
     * superset of every child VM's, plus her own extra privileges
     * (BIRTH, the capsule-repository words, MINT) -- not structurally
     * different from any other VM, just additionally privileged. */
    register_word(vm, "STADIUM-ADMIT",     mama_word_stadium_admit);
    register_word(vm, "STADIUM-EVICT",     mama_word_stadium_evict);
    register_word(vm, "STADIUM-RES@",      mama_word_stadium_res_fetch);
    register_word(vm, "STADIUM-RES-PULL",  mama_word_stadium_res_pull);
    register_word(vm, "STADIUM-RES-PUSH",  mama_word_stadium_res_push);
    register_word(vm, "STADIUM-HEAT@",     mama_word_stadium_heat_fetch);
    register_word(vm, "STADIUM-HEAT!",     mama_word_stadium_heat_store);
    register_word(vm, "STADIUM-WORD-HEAT", mama_word_stadium_word_heat);
    register_word(vm, "CAPSULE-TEST", mama_word_capsule_test);

    /* Create and switch to MAMA vocabulary */
    vm_bootstrap_root_vocabulary(vm, "MAMA");

    /* Re-register in MAMA vocabulary context */
    register_word(vm, "BYE", mama_word_bye);
    register_word(vm, "CONNECT-HERMES", mama_word_connect_hermes);
    register_word(vm, "CONNECT-ARTEMIS", mama_word_connect_artemis);
    register_word(vm, "BIRTH", mama_word_birth);
    register_word(vm, "KILL", mama_word_kill);
    register_word(vm, "EJECT", mama_word_eject);
    register_word(vm, "START", mama_word_start);
    register_word(vm, "STOP", mama_word_stop);
    register_word(vm, "USE", mama_word_use);
    register_word(vm, "EXEC", mama_word_exec);
    register_word(vm, "CAPSULE-COUNT", mama_word_capsule_count);
    register_word(vm, "CAPSULE@", mama_word_capsule_fetch);
    register_word(vm, "CAPSULE-HASH@", mama_word_capsule_hash_fetch);
    register_word(vm, "CAPSULE-FLAGS@", mama_word_capsule_flags_fetch);
    register_word(vm, "CAPSULE-LEN@", mama_word_capsule_len_fetch);
    register_word(vm, "CAPSULE-BIRTH", mama_word_capsule_birth);
    register_word(vm, "CAPSULE-RUN", mama_word_capsule_run);
    register_word(vm, "MINT", mama_word_mint);
    register_word(vm, "ZUSE-ELIGIBILITY-ADD", mama_word_zuse_eligibility_add);
    register_word(vm, "ZUSE-ELIGIBLE?", mama_word_zuse_eligible_query);
    register_word(vm, "NAME>XT", mama_word_name_to_xt);
    register_word(vm, "ELEVATE-PUBKEY-UNPACK", mama_word_elevate_pubkey_unpack);
    register_word(vm, "RUNCAP-TEST", mama_word_runcap_test);
    register_word(vm, "PAIR-TEST", mama_word_pair_test);
    register_word(vm, "MAMA-VM-ID", mama_word_mama_vm_id);
    register_word(vm, "VM-COUNT", mama_word_vm_count);
    register_word(vm, "VM-CONSERVED?", mama_word_vm_conserved);
    register_word(vm, "VM-PHYSICS-STATUS", mama_word_vm_physics_status);
    register_word(vm, "VM-STEP", mama_word_vm_step);
    register_word(vm, "VM-EXEC", mama_word_vm_exec);
    register_word(vm, "VM-CALL", mama_word_vm_call);
    register_word(vm, "VM-HEAT", mama_word_vm_heat);
    /* FABRIC-3.md SXX: the 8 STADIUM-* primitives register_child_vm_words()
     * gives every other VM, added here too -- root cause of "Hera cannot
     * load common:messaging.4th" (kernel_main.c's old Phase C comment):
     * messaging.4th's own colon-definitions (MSG-HEAT@, CH-HEAT@,
     * MSG-COOL-ALL, MSG-TICK, etc.) reference these, and referencing an
     * undefined word during compilation silently drops the definition
     * rather than raising a compile error -- not a messaging bug, a
     * missing-primitive gap in Hera's own dictionary specifically. Fixed
     * by symmetry, not a special case: Hera's dictionary is now a proper
     * superset of every child VM's, plus her own extra privileges
     * (BIRTH, the capsule-repository words, MINT) -- not structurally
     * different from any other VM, just additionally privileged. */
    register_word(vm, "STADIUM-ADMIT",     mama_word_stadium_admit);
    register_word(vm, "STADIUM-EVICT",     mama_word_stadium_evict);
    register_word(vm, "STADIUM-RES@",      mama_word_stadium_res_fetch);
    register_word(vm, "STADIUM-RES-PULL",  mama_word_stadium_res_pull);
    register_word(vm, "STADIUM-RES-PUSH",  mama_word_stadium_res_push);
    register_word(vm, "STADIUM-HEAT@",     mama_word_stadium_heat_fetch);
    register_word(vm, "STADIUM-HEAT!",     mama_word_stadium_heat_store);
    register_word(vm, "STADIUM-WORD-HEAT", mama_word_stadium_word_heat);
    register_word(vm, "CAPSULE-TEST", mama_word_capsule_test);
    register_word(vm, "EXEC", mama_word_exec);

    /* Return to FORTH vocabulary */
    vocabulary_word_forth(vm);
    vocabulary_word_definitions(vm);
}

/* ============================================================================
 * Stadium Words (FABRIC-0.md punch list item 4.2)
 *
 * The entire C surface item 4.2 is permitted to add, per HERMES.md's
 * language constraint: all eight operate on the CALLING VM's own identity
 * (vm->stadium_vm_id) implicitly, never a FORTH-supplied vm-id. A
 * stack-passed vm-id could only ever be the caller's own (redundant) or
 * another VM's (stadium_admit()/stadium_evict() would refuse it via quota
 * isolation, except STADIUM-RES-PUSH, which has no such guard and would be
 * an outright heat-forgery primitive against another VM's reservoir).
 * Conservation is the invariant this item is verified against, so implicit
 * self is not an optimization -- it's the only version that can't break it.
 *
 * STADIUM-ADMIT does not itself pull the candidate's heat from the
 * reservoir -- that's STADIUM-RES-PULL's job, composed in FORTH by the
 * caller (e.g. a rewritten MSG-ALLOC): pull first, admit with the pulled
 * amount, and STADIUM-RES-PUSH it back if admission refuses. Mirrors
 * stadium_words.c's C-side Option B starter-grant pattern, but the
 * composition itself lives in StarForth, not here, per HERMES.md.
 * ============================================================================ */

/**
 * @brief STADIUM-ADMIT ( identity heat behaviour -- cell | -1 )
 * Admits a mass-1 patron into the calling VM's own Stadium quota.
 * `behaviour` must be a valid StadiumBehaviour tag (0..3); anything else
 * refuses without calling stadium_admit() at all. `contains` is always
 * explicitly STADIUM_CONTAINS_NONE -- stadium_admit()'s own doc warns a
 * zero-initialized `contains` reads as "contains Hera" (index 0) and
 * permanently blocks eviction, so this is never left to a zero-fill.
 */
static void mama_word_stadium_admit(VM *vm)
{
    cell_t behaviour_cell, heat_cell, identity_cell;
    StadiumPatronHeader candidate;
    uint8_t *raw = (uint8_t *)&candidate;
    size_t i;
    size_t idx;

    if (vm->dsp < 2) { vm->error = 1; return; }

    behaviour_cell = vm_pop(vm);
    heat_cell      = vm_pop(vm);
    identity_cell  = vm_pop(vm);

    if (behaviour_cell < STADIUM_BEHAVIOUR_MIGRATE || behaviour_cell > STADIUM_BEHAVIOUR_COOL) {
        vm_push(vm, (cell_t)-1);
        return;
    }

    for (i = 0; i < sizeof(candidate); i++) raw[i] = 0;
    candidate.identity  = (uint64_t)identity_cell;
    candidate.heat      = (uint64_t)heat_cell;
    candidate.ttl       = 0;
    candidate.link      = 0;
    candidate.contains  = STADIUM_CONTAINS_NONE;
    candidate.mass      = 1;
    candidate.flags     = 0;
    candidate.behaviour = (uint8_t)behaviour_cell;

    idx = stadium_admit(vm->stadium_vm_id, &candidate);
    vm_push(vm, (idx == STADIUM_CELL_NONE) ? (cell_t)-1 : (cell_t)idx);
}

/**
 * @brief STADIUM-EVICT ( cell -- flag )
 * Reaps the patron header at `cell`. flag is FORTH true (-1) on success,
 * false (0) if refused (out of range, not resident, pinned, or contains-
 * gated) -- stadium_evict()'s own refusal set, unchanged here.
 */
static void mama_word_stadium_evict(VM *vm)
{
    cell_t cell_cell;

    if (vm->dsp < 0) { vm->error = 1; return; }

    cell_cell = vm_pop(vm);
    if (cell_cell < 0) {
        vm_push(vm, (cell_t)0);
        return;
    }
    vm_push(vm, (stadium_evict((size_t)cell_cell) == 0) ? (cell_t)-1 : (cell_t)0);
}

/**
 * @brief STADIUM-RES@ ( -- heat )
 * Read-only peek at the calling VM's own reservoir balance (Q48.16).
 */
static void mama_word_stadium_res_fetch(VM *vm)
{
    vm_push(vm, (cell_t)stadium_reservoir_peek(vm->stadium_vm_id));
}

/**
 * @brief STADIUM-WORD-HEAT ( -- heat )
 * Sum of heat held by the calling VM's own word-execution residents
 * (item 4.1's cells) -- the term a VM's own application-level conservation
 * check (e.g. Hermes's HERMES-K) needs to close exactly, since word patrons
 * are otherwise invisible to FORTH (FABRIC-0.md §25.7, ruling 2026-08-06).
 */
static void mama_word_stadium_word_heat(VM *vm)
{
    vm_push(vm, (cell_t)stadium_words_resident_heat(vm->stadium_vm_id));
}

/**
 * @brief STADIUM-RES-PULL ( qty -- heat )
 * Pulls up to `qty` (Q48.16) from the calling VM's own reservoir. Returns
 * the amount actually pulled, which may be less than requested -- never
 * negative, never invents heat, mirrors stadium_reservoir_pull()'s own
 * clamping exactly.
 */
static void mama_word_stadium_res_pull(VM *vm)
{
    cell_t qty_cell;

    if (vm->dsp < 0) { vm->error = 1; return; }

    qty_cell = vm_pop(vm);
    if (qty_cell < 0) {
        vm_push(vm, (cell_t)0);
        return;
    }
    vm_push(vm, (cell_t)stadium_reservoir_pull(vm->stadium_vm_id, (uint64_t)qty_cell));
}

/**
 * @brief STADIUM-RES-PUSH ( heat -- )
 * Credits `heat` (Q48.16) back into the calling VM's own reservoir -- the
 * other half of every reservoir transfer (cooling, refused-admission
 * rollback, or a departing patron's remaining heat after eviction).
 */
static void mama_word_stadium_res_push(VM *vm)
{
    cell_t heat_cell;

    if (vm->dsp < 0) { vm->error = 1; return; }

    heat_cell = vm_pop(vm);
    if (heat_cell < 0) return;
    stadium_reservoir_push(vm->stadium_vm_id, (uint64_t)heat_cell);
}

/**
 * @brief STADIUM-HEAT@ ( cell -- heat )
 * Reads a resident cell's own heat. Requires the cell to be resident and
 * owned by the calling VM's own quota -- returns 0 otherwise (out of range,
 * not resident, or belongs to a different VM).
 */
static void mama_word_stadium_heat_fetch(VM *vm)
{
    cell_t cell_cell;

    if (vm->dsp < 0) { vm->error = 1; return; }

    cell_cell = vm_pop(vm);
    if (cell_cell < 0) {
        vm_push(vm, (cell_t)0);
        return;
    }
    vm_push(vm, (cell_t)stadium_cell_heat_get(vm->stadium_vm_id, (size_t)cell_cell));
}

/**
 * @brief STADIUM-HEAT! ( new-heat cell -- )
 * Writes a resident cell's own heat, reconciling the reservoir delta
 * atomically in C (pulls on an increase, refusing silently if the
 * calling VM's reservoir can't cover it; pushes back on a decrease).
 * Requires the cell to be resident and owned by the calling VM's own
 * quota -- silently refused otherwise, same as every other write here.
 */
static void mama_word_stadium_heat_store(VM *vm)
{
    cell_t cell_cell, new_heat_cell;

    if (vm->dsp < 1) { vm->error = 1; return; }

    cell_cell     = vm_pop(vm);
    new_heat_cell = vm_pop(vm);
    if (cell_cell < 0 || new_heat_cell < 0) return;
    (void)stadium_cell_heat_set(vm->stadium_vm_id, (size_t)cell_cell, (uint64_t)new_heat_cell);
}

/**
 * register_child_vm_words - Register the minimal word set needed by child VMs.
 *
 * Child VMs are not bootstrapped through sk_vm_bootstrap_parity, so they
 * do not get register_mama_forth_words().  They only need STOP (self-halt)
 * and EXEC (load a capsule) -- plus, as of item 4.2, the eight STADIUM-*
 * primitives Hermes needs to migrate her message/channel lifecycle onto the
 * Stadium.  Keeping the registrations here — in the same translation unit
 * as the word functions — avoids cross-TU function-pointer loads that
 * produce R_X86_64_REX_GOTPCRELX relocations; those are not relaxed by the
 * PE32+ linker, causing the function code bytes to be read as the pointer
 * value instead of the actual address.
 *
 * Deliberately NOT added to register_mama_forth_words(): that would put
 * these words in Hera's own dictionary too and move dict_hash off item
 * 4.1's baseline (0x3d4e1daf289da94f) -- a deliberate baseline change to
 * state this item does not make as a side effect.
 */
void register_child_vm_words(VM *vm)
{
    register_word(vm, "STOP",    mama_word_stop);
    register_word(vm, "EXEC",    mama_word_exec);
    register_word(vm, "VM-EXEC", mama_word_vm_exec);
    register_word(vm, "VM-CALL", mama_word_vm_call);
    register_word(vm, "VM-HEAT", mama_word_vm_heat);
    /* USE (FABRIC-2.md §F.24): not console-specific -- any VM can
     * redirect the physical REPL to any other VM it has ACL access to
     * (BINDSTEP re-verifies on every call, §F.9), including a console
     * VM switching back to Hera or to a different session entirely.
     * mama_word_use() itself is already VM-agnostic (sk_repl_set_
     * active_vm() is a plain C global, capsule_vm_find_by_name_nocase()
     * likewise) -- this was simply never registered here before. */
    register_word(vm, "USE", mama_word_use);
    register_word(vm, "STADIUM-ADMIT",    mama_word_stadium_admit);
    register_word(vm, "STADIUM-EVICT",    mama_word_stadium_evict);
    register_word(vm, "STADIUM-RES@",     mama_word_stadium_res_fetch);
    register_word(vm, "STADIUM-RES-PULL", mama_word_stadium_res_pull);
    register_word(vm, "STADIUM-RES-PUSH", mama_word_stadium_res_push);
    register_word(vm, "STADIUM-HEAT@",    mama_word_stadium_heat_fetch);
    register_word(vm, "STADIUM-HEAT!",    mama_word_stadium_heat_store);
    register_word(vm, "STADIUM-WORD-HEAT", mama_word_stadium_word_heat);
    /* FABRIC-3.md SXXV (2026-09-12): BIRTH/CAPSULE-BIRTH were Hera-only by
     * registration alone -- both mama_word_birth() and mama_word_capsule_
     * birth() were already genuinely VM-agnostic underneath (the latter
     * explicitly passes vm->stadium_vm_id, "who is birthing this VM," not
     * a hardcoded Hera constant -- confirmed by reading the C before
     * assuming it). Symmetric registration alone can't weaken any
     * personality's own ACL lockdown: acl-std79.4th's ACL-LOCKDOWN-STD79
     * is allowlist-based, deny-by-default -- it walks the WHOLE
     * dictionary and denies+pins anything not on ACL-STD79-LIST, so a
     * newly-registered word is auto-denied there unless a human
     * deliberately adds it (which acl-std79.4th now does, explicitly,
     * for exactly these two -- see its own updated comment). */
    register_word(vm, "BIRTH",         mama_word_birth);
    register_word(vm, "CAPSULE-BIRTH", mama_word_capsule_birth);
}

#endif /* __STARKERNEL__ */