Files
LithosAnanke/src/word_source/block_words.c
T
Robert Allan JamesandClaude Sonnet 5 c7c9332321 Stadium: real block-patron admission + MIGRATE dispatch (FABRIC-3.md §B)
stadium_admit()'s mass==1 refusal looked like a hard blocker for 1024-byte
blocks, but stadium_word_dispatch()'s real candidate construction proves
Stadium cells carry pure identity/heat/bookkeeping, never the resident's
actual content -- a block patron follows the same shape (identity=LBN,
payload unused), so this was real, scoped work, not a case for stubbing.

New stadium_blocks.h/.c mirror stadium_words.c's admission/cooling shape,
keyed by (quota_slot, lbn) in a fixed-capacity open-addressing hash table
(tombstone deletion) instead of a dense array, since LBN space isn't
densely bounded like word_id. Wired into block_word_block()/buffer()/
update() (block_words.c), __STARKERNEL__-guarded. stadium_dispatch()'s
MIGRATE case now calls blk_flush(lbn) for real instead of printing
"(stub)". Three new Kconfig constants (STADIUM_BLOCK_HEAT_QUANTUM/
STADIUM_BLOCK_COOL_RATE_Q48/STADIUM_BLOCK_TRACK_CAP_MULT) mirror the
word-patron ones, same three-layer wiring.

VM-COOL/DELIVER/EXPIRE stay explicit punch-list items -- VM-COOL
deferred pending the still-iterating Tripod/Zuse/messaging vision,
DELIVER/EXPIRE are their own future subsystem integrations per
FABRIC.md's own "open, not resolved" notes.

Verified clean compile (zero warnings) and clean boot to REPL with
conservation intact (resident_sum + reservoir == Q48_ONE) on all three
architectures (amd64/aarch64/riscv64); BLOCK/BUFFER touches exercised
live from the REPL with no crash; a 22,000-distinct-block flood loop
against an artificially shrunk Stadium ran clean under heavy admission
load. A live MIGRATE console fire was not directly observed this
session (root-caused to a pre-existing reservoir-floor/density-eviction
interaction unrelated to this change, documented in FABRIC-3.md) --
flagged as an honest follow-up, not silently claimed.

Co-Authored-By: Claude Sonnet 5 <noreply@anthropic.com>
Claude-Session: https://claude.ai/code/session_01CXjAPTEKrgY2Mrk25KoLDn
2026-08-25 23:28:59 -04:00

574 lines
19 KiB
C
Raw Blame History

This file contains ambiguous Unicode characters
This file contains Unicode characters that might be confused with other characters. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.
/*
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.
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.
*/
/*
*** StarForth ***
block_words.c - FORTH-79 Block Words (Layer 3: Forth Interface)
Last modified - 10/02/25, 03:55 PM ET
Author: Robert A. James (rajames) - StarshipOS Forth Project.
License: Creative Commons Zero v1.0 Universal
<http://creativecommons.org/publicdomain/zero/1.0/>
*/
#include "include/block_words.h"
#include "../../include/word_registry.h"
#include "../../include/vm.h"
#include "../../include/block_subsystem.h"
#include <string.h>
#include <stdio.h>
#ifdef __STARKERNEL__
#include "starkernel/vm/stadium_blocks.h" /* stadium_block_dispatch() -- FABRIC-3.md §B */
#endif
/* ----------------------------------------------------------------------
* Architecture:
* - Layer 1: blkio (vtable abstraction)
* - Layer 2: block_subsystem (RAM 0-1023, disk 1024+, 4KB packing)
* - Layer 3: block_words (THIS FILE - Forth interface)
*
* All block I/O now goes through block_subsystem.h API.
* Block 0 is RESERVED for volume metadata.
* ---------------------------------------------------------------------- */
static void set_scr(VM *vm, cell_t blk) {
if (!vm) return;
vm_store_cell(vm, vm->scr_addr, (cell_t) blk);
}
/* Optional utility surface (matches your header) */
/*
* @brief Initializes the block system
* @param vm Pointer to the VM instance
*/
void init_block_system(VM *vm) {
(void) vm;
/* Subsystem initialization happens in main.c via blk_subsys_init() */
}
/**
* @brief Gets a buffer for the specified block
* @param vm Pointer to the VM instance
* @param block_num Block number to retrieve
* @return Pointer to block buffer or NULL if invalid
*/
unsigned char *get_block_buffer(VM *vm, int block_num) {
if (!vm) return NULL;
if (block_num == 0) return NULL; /* Block 0 reserved */
uint8_t *buf = blk_get_buffer((uint32_t) block_num, 0); /* read-only */
if (buf) {
set_scr(vm, (cell_t) block_num);
}
return buf;
}
/**
* @brief Gets an empty buffer for the specified block
* @param vm Pointer to the VM instance
* @param block_num Block number to create
* @return Pointer to empty block buffer or NULL if invalid
*/
unsigned char *get_empty_buffer(VM *vm, int block_num) {
if (!vm) return NULL;
if (block_num == 0) return NULL; /* Block 0 reserved */
uint8_t *buf = blk_get_empty_buffer((uint32_t) block_num);
if (buf) {
set_scr(vm, (cell_t) block_num);
}
return buf;
}
/*
* @brief Marks the current block buffer as dirty
* @param vm Pointer to the VM instance
*/
void mark_buffer_dirty(VM *vm) {
if (!vm) return;
cell_t blk = vm_load_cell(vm, vm->scr_addr);
if (blk > 0) {
blk_update((uint32_t) blk);
}
}
/*
* @brief Saves all dirty buffers
* @param vm Pointer to the VM instance
*/
void save_all_buffers(VM *vm) {
(void) vm;
blk_flush(0); /* flush all */
}
/**
* @brief Empties all user block buffers
* @param vm Pointer to the VM instance
*/
void empty_all_buffers(VM *vm) {
if (!vm) return;
/* Zero blocks USER_BLOCKS_START through max available */
uint32_t total = blk_get_total_blocks();
for (uint32_t blk = USER_BLOCKS_START; blk < total; ++blk) {
uint8_t *buf = blk_get_buffer(blk, 1); /* writable */
if (buf) {
memset(buf, 0, BLOCK_SIZE);
}
}
}
/* --- Block I/O window helpers ----------------------------------------- */
/* Discard the whole VM block window if the device chain has changed since
* it was last validated (Milestone 2h). A device hot-detach followed by a
* later re-attach can reuse both the exact same LBN range
* (block_subsystem.c's chain always appends at the current tail) *and* the
* exact same blk_get_buffer() return address (confirmed live: this
* kernel's own first-fit kmalloc, src/starkernel/memory/kmalloc.c, hands
* the just-freed slot straight back to the very next same-size
* calloc()), so neither LBN nor a cached pointer is a reliable
* "still the same device" signal on its own. Any epoch change discards
* every cached slot outright -- no flush attempt, matching
* blk_subsys_detach_device()'s own reasoning: whatever device the stale
* content belonged to may already be gone by the time this runs. Called at
* the top of every function below that reads vm->blk_vm_lbn[]/
* vm->blk_vm_cbuf[] directly, not just blk_vm_find() -- blk_vm_flush_all()
* walks the same arrays without going through blk_vm_find() first. */
static void blk_vm_check_epoch(VM *vm) {
uint64_t epoch = blk_subsys_epoch();
if (epoch == vm->blk_vm_epoch) return;
for (int i = 0; i < BLK_VM_SLOTS; i++) {
vm->blk_vm_lbn[i] = 0;
vm->blk_vm_cbuf[i] = NULL;
vm->blk_vm_dirty[i] = 0;
}
vm->blk_vm_epoch = epoch;
}
/* Find the slot holding lbn; return slot index or -1 if not loaded. */
static int blk_vm_find(VM *vm, uint32_t lbn) {
blk_vm_check_epoch(vm);
for (int i = 0; i < BLK_VM_SLOTS; i++) {
if (vm->blk_vm_lbn[i] == lbn && vm->blk_vm_cbuf[i] != NULL)
return i;
}
return -1;
}
/* Evict one slot (write back if dirty), return the freed slot index. */
static int blk_vm_evict(VM *vm) {
/* Prefer a clean slot to avoid unnecessary writeback. */
for (int i = 0; i < BLK_VM_SLOTS; i++) {
int s = (vm->blk_vm_next + i) % BLK_VM_SLOTS;
if (vm->blk_vm_cbuf[s] == NULL || !vm->blk_vm_dirty[s]) {
vm->blk_vm_lbn[s] = 0;
vm->blk_vm_cbuf[s] = NULL;
vm->blk_vm_dirty[s] = 0;
vm->blk_vm_next = (s + 1) % BLK_VM_SLOTS;
return s;
}
}
/* All slots dirty: evict round-robin, sync back to C buffer first.
* Re-resolve the buffer pointer by LBN rather than trusting the
* stored one -- the block-subsystem's own devblock cache may have
* shifted (struct-copy eviction) since this slot was populated,
* which silently invalidates any raw pointer captured earlier. */
int s = vm->blk_vm_next;
vm->blk_vm_next = (vm->blk_vm_next + 1) % BLK_VM_SLOTS;
vaddr_t base = BLK_VM_WINDOW_BASE + (vaddr_t)s * BLOCK_SIZE;
uint8_t* fresh = blk_get_buffer(vm->blk_vm_lbn[s], 1);
if (fresh)
{
memcpy(fresh, vm->memory + base, BLOCK_SIZE);
blk_update(vm->blk_vm_lbn[s]);
}
vm->blk_vm_lbn[s] = 0;
vm->blk_vm_cbuf[s] = NULL;
vm->blk_vm_dirty[s] = 0;
return s;
}
/* Load lbn into a window slot (reads C buffer), return VM offset or 0 on err. */
static vaddr_t blk_vm_load(VM *vm, uint32_t lbn, int writable) {
int s = blk_vm_find(vm, lbn);
if (s < 0) {
s = -1;
for (int i = 0; i < BLK_VM_SLOTS; i++) {
if (vm->blk_vm_cbuf[i] == NULL) { s = i; break; }
}
if (s < 0) s = blk_vm_evict(vm);
uint8_t *cbuf = blk_get_buffer(lbn, writable);
if (!cbuf) return 0;
vaddr_t base = BLK_VM_WINDOW_BASE + (vaddr_t)s * BLOCK_SIZE;
memcpy(vm->memory + base, cbuf, BLOCK_SIZE);
vm->blk_vm_lbn[s] = lbn;
vm->blk_vm_cbuf[s] = cbuf;
vm->blk_vm_dirty[s] = 0;
}
return BLK_VM_WINDOW_BASE + (vaddr_t)s * BLOCK_SIZE;
}
/* Assign lbn to a slot WITHOUT reading block content (BUFFER semantics).
* Returns VM offset or 0 on error. Slot is zeroed and marked dirty. */
static vaddr_t blk_vm_assign(VM *vm, uint32_t lbn) {
int s = blk_vm_find(vm, lbn);
if (s < 0) {
s = -1;
for (int i = 0; i < BLK_VM_SLOTS; i++) {
if (vm->blk_vm_cbuf[i] == NULL) { s = i; break; }
}
if (s < 0) s = blk_vm_evict(vm);
uint8_t *cbuf = blk_get_empty_buffer(lbn);
if (!cbuf) return 0;
vaddr_t base = BLK_VM_WINDOW_BASE + (vaddr_t)s * BLOCK_SIZE;
memset(vm->memory + base, 0, BLOCK_SIZE);
vm->blk_vm_lbn[s] = lbn;
vm->blk_vm_cbuf[s] = cbuf;
}
vm->blk_vm_dirty[s] = 1;
return BLK_VM_WINDOW_BASE + (vaddr_t)s * BLOCK_SIZE;
}
/* Sync all dirty slots to their C buffers and flush the subsystem.
* Re-resolve each buffer pointer by LBN rather than trusting the stored
* one -- see blk_vm_evict for why a stored pointer can go stale. Checks
* the epoch first (Milestone 2h, see blk_vm_check_epoch()) since this
* function walks vm->blk_vm_lbn[]/vm->blk_vm_cbuf[] directly rather than
* through blk_vm_find() -- a stale-epoch dirty slot must be discarded, not
* flushed onto whatever device now owns that LBN.
*
* Non-static: this is the entire implementation behind SAVE-BUFFERS
* (block_word_save_buffers() below is a one-line wrapper) -- exposed
* (declared in block_words.h) so kernel-side code can reuse the exact
* same flush path outside the word-dispatch mechanism, e.g. sk_repl_idle()
* (see FABRIC.md/FABRIC-2.md Section V item 6). Cheap to call when
* nothing is dirty: every check below is a small fixed-size scan
* (BLK_VM_SLOTS here, DISK_CACHE_SLOTS per device inside blk_flush()),
* no I/O happens unless something actually needs writing. */
void blk_vm_flush_all(VM *vm) {
blk_vm_check_epoch(vm);
for (int i = 0; i < BLK_VM_SLOTS; i++) {
if (vm->blk_vm_cbuf[i] != NULL && vm->blk_vm_dirty[i]) {
vaddr_t base = BLK_VM_WINDOW_BASE + (vaddr_t)i * BLOCK_SIZE;
uint8_t* fresh = blk_get_buffer(vm->blk_vm_lbn[i], 1);
if (fresh)
{
memcpy(fresh, vm->memory + base, BLOCK_SIZE);
blk_update(vm->blk_vm_lbn[i]);
}
vm->blk_vm_dirty[i] = 0;
}
}
blk_flush(0);
}
/* --- Words ------------------------------------------------------------ */
/* BLOCK ( u -- addr ) : VM address of block u content (no dirty mark) */
void block_word_block(VM *vm) {
if (vm->dsp < 0) { vm->error = 1; return; }
cell_t blk = vm_pop(vm);
if (blk == 0 || !blk_is_valid((uint32_t) blk)) { vm->error = 1; return; }
#ifdef __STARKERNEL__
stadium_block_dispatch(vm->stadium_vm_id, (uint32_t) blk, vm->heartbeat.tick_count);
#endif
vaddr_t vaddr = blk_vm_load(vm, (uint32_t) blk, 0);
if (!vaddr) { vm->error = 1; return; }
set_scr(vm, blk);
vm_push(vm, CELL(vaddr));
}
/* BUFFER ( u -- addr ) : VM address of block u; content unread, mark dirty */
void block_word_buffer(VM *vm) {
if (vm->dsp < 0) { vm->error = 1; return; }
cell_t blk = vm_pop(vm);
if (blk == 0 || !blk_is_valid((uint32_t) blk)) { vm->error = 1; return; }
#ifdef __STARKERNEL__
stadium_block_dispatch(vm->stadium_vm_id, (uint32_t) blk, vm->heartbeat.tick_count);
#endif
vaddr_t vaddr = blk_vm_assign(vm, (uint32_t) blk);
if (!vaddr) { vm->error = 1; return; }
set_scr(vm, blk);
vm_push(vm, CELL(vaddr));
}
/* UPDATE ( -- ) : sync current SCR slot to C layer and mark dirty.
* Re-resolve the buffer pointer by LBN rather than trusting the stored
* one -- see blk_vm_evict for why a stored pointer can go stale. */
void block_word_update(VM *vm) {
cell_t blk = vm_load_cell(vm, vm->scr_addr);
if (blk == 0 || !blk_is_valid((uint32_t) blk)) { vm->error = 1; return; }
#ifdef __STARKERNEL__
stadium_block_dispatch(vm->stadium_vm_id, (uint32_t) blk, vm->heartbeat.tick_count);
#endif
int s = blk_vm_find(vm, (uint32_t) blk);
if (s < 0) { vm->error = 1; return; }
vaddr_t base = BLK_VM_WINDOW_BASE + (vaddr_t)s * BLOCK_SIZE;
uint8_t* fresh = blk_get_buffer((uint32_t)blk, 1);
if (!fresh)
{
vm->error = 1;
return;
}
memcpy(fresh, vm->memory + base, BLOCK_SIZE);
vm->blk_vm_cbuf[s] = fresh;
vm->blk_vm_dirty[s] = 1;
blk_update((uint32_t) blk);
}
/* BLK-CONFIRM-FORMAT ( lbn -- ) : commit the low-level disk container
* format for the slot owning lbn. Must be called by the disk's owner
* (e.g. Artemis) only after classifying disk content as safe to touch —
* never on the path that halts for unrecognized content. Until this is
* called, all writes to that disk slot are refused by the block layer. */
void block_word_confirm_format(VM *vm) {
if (vm->dsp < 0) { vm->error = 1; return; }
cell_t blk = vm_pop(vm);
if (blk_subsys_confirm_format((uint32_t) blk) != BLK_OK) { vm->error = 1; return; }
}
/* RELOCATE-BLOCK ( home target -- ) : relocate home's content to target,
* redirecting all future access to home transparently through target
* from now on. See blk_subsys_relocate_block()'s own doc comment
* (block_subsystem.h) for the full contract -- this word performs no
* policy validation of its own (is target actually free? does the
* caller actually own it?), matching this project's "ACL owns policy,
* this is a mechanical primitive" direction. */
void block_word_relocate(VM *vm) {
if (vm->dsp < 1) { vm->error = 1; return; }
cell_t target = vm_pop(vm);
cell_t home = vm_pop(vm);
if (blk_subsys_relocate_block((uint32_t) home, (uint32_t) target) != BLK_OK) {
vm->error = 1;
}
}
/* SAVE-BUFFERS ( -- ) : sync and write all dirty blocks */
void block_word_save_buffers(VM *vm) {
blk_vm_flush_all(vm);
}
/* EMPTY-BUFFERS ( -- ) : invalidate all window slots then zero user blocks */
void block_word_empty_buffers(VM *vm) {
for (int i = 0; i < BLK_VM_SLOTS; i++) {
vm->blk_vm_lbn[i] = 0;
vm->blk_vm_cbuf[i] = NULL;
vm->blk_vm_dirty[i] = 0;
}
empty_all_buffers(vm);
}
/* FLUSH ( -- ) : save and invalidate all buffers */
void block_word_flush(VM *vm) {
blk_vm_flush_all(vm);
}
/* LOAD ( u -- ) : set SCR and (future: interpret block) */
void block_word_load(VM *vm) {
if (vm->dsp < 0) {
vm->error = 1;
return;
}
cell_t blk = vm_pop(vm);
if (blk == 0 || !blk_is_valid((uint32_t) blk)) {
vm->error = 1;
return;
}
uint8_t *buf = blk_get_buffer((uint32_t) blk, 0);
if (!buf) {
vm->error = 1;
return;
}
set_scr(vm, blk);
/* Interpret the block content as Forth source */
/* Block is 1024 bytes, null-terminate it for interpretation */
char block_text[1025];
memcpy(block_text, buf, 1024);
block_text[1024] = '\0';
/* Interpret the block content */
vm_interpret(vm, block_text);
}
/* LIST ( u -- ) : set SCR and (optionally) print the block */
void block_word_list(VM *vm) {
if (vm->dsp < 0) {
vm->error = 1;
return;
}
cell_t blk = vm_pop(vm);
if (blk == 0 || !blk_is_valid((uint32_t) blk)) {
vm->error = 1;
return;
}
uint8_t *buf = blk_get_buffer((uint32_t) blk, 0);
if (!buf) {
vm->error = 1;
return;
}
set_scr(vm, blk);
/* Print formatted block output with line numbers */
printf("\nBlock %ld\n", (long) blk);
/* FORTH blocks are typically 16 lines of 64 characters */
for (int line = 0; line < 16; line++) {
printf("%02d: ", line);
for (int col = 0; col < 64; col++) {
int idx = line * 64 + col;
char ch = (char) buf[idx];
/* Print printable characters, show spaces as-is */
if (ch >= 32 && ch < 127) {
putchar(ch);
} else if (ch == 0) {
/* Null bytes shown as spaces for readability */
putchar(' ');
} else {
/* Non-printable shown as '.' */
putchar('.');
}
}
printf("\n");
}
printf("\n");
}
/* THRU ( u1 u2 -- ) : LOAD each block from u1..u2 inclusive */
void block_word_thru(VM *vm) {
if (vm->dsp < 1) {
vm->error = 1;
return;
}
cell_t u2 = vm_pop(vm);
cell_t u1 = vm_pop(vm);
if (u1 > u2) {
cell_t t = u1;
u1 = u2;
u2 = t;
}
if (u1 == 0 || !blk_is_valid((uint32_t) u1) || !blk_is_valid((uint32_t) u2)) {
vm->error = 1;
return;
}
for (cell_t blk = u1; blk <= u2; ++blk) {
vm_push(vm, blk);
block_word_load(vm);
if (vm->error) return;
if (vm->abort_requested) return;
}
}
/* SCR ( -- addr ) : push VM address of SCR variable */
void block_word_scr(VM *vm) {
vm_push(vm, CELL(vm->scr_addr));
}
/* --> ( -- ) : continue interpretation on next sequential block */
void block_word_next_block(VM *vm) {
cell_t current_scr = vm_load_cell(vm, vm->scr_addr);
cell_t next_blk = current_scr + 1;
if (next_blk == 0 || !blk_is_valid((uint32_t) next_blk)) {
vm->error = 1;
return;
}
/* Get the next block's content */
uint8_t *buf = blk_get_buffer((uint32_t) next_blk, 0);
if (!buf) {
vm->error = 1;
return;
}
/* Update SCR to next block */
set_scr(vm, next_blk);
/* Interpret the next block's content line-by-line (same as LOAD) */
char block_text[1025];
memcpy(block_text, buf, 1024);
block_text[1024] = '\0';
char *p = block_text;
while (!vm->error && !vm->abort_requested && *p != '\0') {
char *nl = (char *)memchr(p, '\n', (size_t)(block_text + 1024 - p));
if (nl) {
*nl = '\0';
if (p != nl)
vm_interpret(vm, p);
p = nl + 1;
} else {
if (*p != '\0')
vm_interpret(vm, p);
break;
}
}
}
/* --- Registration ----------------------------------------------------- */
/*
* @brief Registers all block-related FORTH words
* @param vm Pointer to the VM instance
*/
void register_block_words(VM *vm) {
register_word(vm, "BLOCK", block_word_block);
register_word(vm, "BUFFER", block_word_buffer);
register_word(vm, "UPDATE", block_word_update);
register_word(vm, "BLK-CONFIRM-FORMAT", block_word_confirm_format);
register_word(vm, "RELOCATE-BLOCK", block_word_relocate);
register_word(vm, "SAVE-BUFFERS", block_word_save_buffers);
register_word(vm, "EMPTY-BUFFERS", block_word_empty_buffers);
register_word(vm, "FLUSH", block_word_flush);
register_word(vm, "LOAD", block_word_load);
register_word(vm, "LIST", block_word_list);
register_word(vm, "THRU", block_word_thru);
register_word(vm, "SCR", block_word_scr);
register_word(vm, "-->", block_word_next_block);
}