StarForth/src/word_source/block_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.

 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;
        }
    }
}

/* --- BMAPFMT block-ACL words (FABRIC-3.md §F.4/§H.6/§H.12 step 15) ----
 * Raw C-primitive accessors, matching the word-level ACL system's own
 * split: policy is composed in FORTH on top of these (a new capsule,
 * §H.12 step 16), not here. block_num validated the same way BLOCK/
 * BUFFER above already do. */

/* BLK-ACL-ALLOW@ ( block# -- allow ) */
static void block_word_acl_allow_fetch(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 allow;
    if (blk_acl_allow_get((uint32_t) blk, &allow) != BLK_OK) { vm->error = 1; return; }
    vm_push(vm, (cell_t) allow);
}

/* BLK-ACL-ALLOW! ( allow block# -- ) */
static void block_word_acl_allow_store(VM *vm) {
    if (vm->dsp < 1) { vm->error = 1; return; }
    cell_t blk   = vm_pop(vm);
    cell_t allow = vm_pop(vm);
    if (blk == 0 || !blk_is_valid((uint32_t) blk)) { vm->error = 1; return; }
    if (blk_acl_allow_set((uint32_t) blk, (uint8_t)(allow ? 1 : 0)) != BLK_OK) {
        vm->error = 1;
    }
}

/* BLK-ACL-TTL@ ( block# -- ttl ) */
static void block_word_acl_ttl_fetch(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; }
    uint32_t ttl;
    if (blk_acl_ttl_get((uint32_t) blk, &ttl) != BLK_OK) { vm->error = 1; return; }
    vm_push(vm, (cell_t) ttl);
}

/* BLK-ACL-TTL! ( ttl block# -- ) */
static void block_word_acl_ttl_store(VM *vm) {
    if (vm->dsp < 1) { vm->error = 1; return; }
    cell_t blk = vm_pop(vm);
    cell_t ttl = vm_pop(vm);
    if (blk == 0 || !blk_is_valid((uint32_t) blk)) { vm->error = 1; return; }
    if (blk_acl_ttl_set((uint32_t) blk, (uint32_t) ttl) != BLK_OK) { vm->error = 1; }
}

/* BLK-OWNER@ ( block# -- fp ) : 8-byte owner fingerprint packed into one
 * cell (cell_t is 8 bytes, int64_t -- see vm.h) -- raw bit reinterpretation,
 * not a numeric value. Read-only from FORTH: only step 15's own list, no
 * BLK-OWNER! -- setting ownership happens at a more controlled point
 * (MINT/birth), in C, not exposed as a general FORTH write. */
static void block_word_owner_fetch(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 fp[8];
    if (blk_owner_fp_get((uint32_t) blk, fp) != BLK_OK) { vm->error = 1; return; }
    cell_t packed;
    memcpy(&packed, fp, sizeof(packed));
    vm_push(vm, packed);
}

/* --- 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);
    register_word(vm, "BLK-ACL-ALLOW@", block_word_acl_allow_fetch);
    register_word(vm, "BLK-ACL-ALLOW!", block_word_acl_allow_store);
    register_word(vm, "BLK-ACL-TTL@", block_word_acl_ttl_fetch);
    register_word(vm, "BLK-ACL-TTL!", block_word_acl_ttl_store);
    register_word(vm, "BLK-OWNER@", block_word_owner_fetch);
}