ABORT is documented and tested in this codebase as standard FORTH-79 behavior -- system_words_test.c:63: "Should clear stacks and return to QUIT" -- meaning it should unwind all the way back to the outermost interpreter loop, abandoning whatever's left of the current line/block. The implementation only unwound one level: every place that checked vm->abort_requested cleared it the instant it saw it, so it never survived to propagate past the first nested frame. This surfaced via Artemis's ART-HALT-UNRECOG (capsules/artemis/init.4th): on an unrecognized disk it correctly printed "ARTEMIS HALT: unrecognized disk content" and called ABORT, but WELCOME (the next line in the same block) ran anyway, and Artemis announced ready to Hermes and joined the fleet normally -- contradicting .claude/ARTEMIS.md's "Refuse to mount... do not overwrite it" requirement. Root cause is general, not Artemis-specific, and present identically in both the hosted and kernel VM cores. Fixed at every level execution can nest through, verified by exhaustively grepping every !vm->error-gated continuation loop and adding the parallel !vm->abort_requested check: - execute_colon_word (src/vm.c, src/starkernel/vm/vm_core.c): stop clearing the flag on return -- every colon-word call is a recursive call to this same function, so leaving it set lets every enclosing frame's own check also unwind. - vm_interpret (src/vm.c, src/starkernel/vm/vm_core.c): stop parsing further words in the current input string once the flag is set. - exec_block_with_retry (src/starkernel/capsule/capsule_loader.c): capsule birth's line-by-line block executor -- stop processing further lines in the current block, but return 0 (not -1), so capsule_exec_payload still loads later blocks in the same capsule payload. Returning -1 here would have silently broken word definitions in blocks that come after the aborting one for reasons unrelated to why it aborted (concretely, Artemis's ART-PING/LOAD-DOE in blocks 4851/4852, which follow the entry block 4133). - THRU and --> (src/word_source/block_words.c): stop processing further blocks/lines in their own loops. - DODOES (src/word_source/defining_words.c): the CREATE...DOES> runtime has its own hand-rolled execution loop, separate from execute_colon_word -- same bug class, same fix. Also guarded the post-loop "if (vm->rsp < base_rsp) vm->rsp = base_rsp" clamp so it doesn't fire on an abort exit -- ABORT's own reset_vm_state() already set rsp; restoring it to base_rsp would have partially undone that. - Both REPL loops (src/repl.c, src/starkernel/repl.c x2 call sites): clear the flag after each line, mirroring the existing vm->error pattern, so a mid-line abort doesn't silently freeze subsequent interactive input. Verified directly: ": AB-TEST 1 2 3 ABORT 999 . ; AB-TEST 42 . CR 777 . CR" -- 999 never prints (stops mid-colon-word), 42 never prints (stops the rest of the same line), 777 prints fine (next line unaffected). Artemis: WELCOME/"Artemis ready" no longer fires after the halt message. No regression: all three architectures still show PASS: persist-read, PASS: E2E msg flow, and matching dict_hash on the normal (non-aborted) boot path; hosted test suite 965 passed / 0 failed. Known follow-up, not fixed here (see memory for details): Artemis still announces ready to Hermes via a separate call path (CD-INIT, block 4141) that never went through capsule_exec_payload's block chain in the first place, and the disk file still picks up incidental writes even on a correctly-halted boot -- likely generic block-subsystem housekeeping, not traced yet. Co-Authored-By: Claude Sonnet 5 <noreply@anthropic.com>
468 lines
14 KiB
C
468 lines
14 KiB
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>
|
||
|
||
/* ----------------------------------------------------------------------
|
||
* 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 ----------------------------------------- */
|
||
|
||
/* Find the slot holding lbn; return slot index or -1 if not loaded. */
|
||
static int blk_vm_find(VM *vm, uint32_t lbn) {
|
||
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. */
|
||
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;
|
||
memcpy(vm->blk_vm_cbuf[s], 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. */
|
||
static void blk_vm_flush_all(VM *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;
|
||
memcpy(vm->blk_vm_cbuf[i], 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; }
|
||
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; }
|
||
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 */
|
||
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; }
|
||
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;
|
||
memcpy(vm->blk_vm_cbuf[s], vm->memory + base, BLOCK_SIZE);
|
||
vm->blk_vm_dirty[s] = 1;
|
||
blk_update((uint32_t) blk);
|
||
}
|
||
|
||
/* 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, "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);
|
||
} |