admin/LithosAnanake
1
0
Fork 0
Code Issues Pull Requests Actions 30 Packages Projects Releases Wiki Activity

Move vocabulary and control-flow state off file-scope statics onto VM

Browse Source 
proof/FINDINGS.md's Isabelle/HOL word-source sweep (§1) found the two
defects severe enough to actively corrupt the live Tripod multi-VM fleet:
file-scope C statics standing in for state that belongs on struct VM.

- vocabulary_words.c (highest severity in the sweep): forth_vocab/
  context_vocab/current_vocab, context_var_addr/current_var_addr, the
  ctx_fc/forth_fc first-char search index, and the `initialized` guard
  were all process-wide statics. Only the first VM to touch any
  vocabulary word ever ran setup; every VM after that silently shared
  VM #1's dictionary-chain pointers and reused VM #1's byte-offset
  addresses as if valid in its own vm->memory. One VM's VOCABULARY/
  DEFINITIONS/FORTH silently changed where every other VM looked up and
  defined words.

- control_words.c: cf_stack/cf_sp/cf_last_mode (IF/THEN/BEGIN/DO/CASE
  compile-time nesting) and the LEAVE/ENDOF patch-site bookkeeping
  (leave_addrs/leave_sp/leave_mark_*, endof_addrs/endof_sp/endof_mark_*)
  were also process-wide statics. Two VMs compiling colon definitions at
  overlapping times would corrupt each other's nesting state.

Both moved onto struct VM, following the existing hold_addr/hold_pos
precedent in include/vm.h ("lives in each VM's own memory... so child
VMs never alias Hera's buffer"):

- New VocabularyState struct (vm->vocab): chain heads, VM-cell addresses,
  first-char index, initialized flag.
- New ControlFlowState struct (vm->cf): cf_stack/cf_sp/cf_last_mode plus
  the LEAVE/ENDOF patch-site stacks. cf_tag_t/cf_item_t/CF_STACK_MAX
  moved from control_words.c into include/vm.h since they're now part of
  the struct VM field's type.
- Sentinel fields (-1/-999, meaning "empty") explicitly initialized in
  both vm_init_with_host() implementations (hosted src/vm_bootstrap.c and
  kernel src/starkernel/vm/vm_bootstrap.c) alongside the existing
  dsp/rsp = -1 initialization, since the preceding zero-init leaves them
  at 0 rather than their empty sentinel.

Every word function in both files already took VM *vm, so no call sites
outside these two files needed to change; cf_push_item/cf_pop_item/
cf_peek_item gained a VM* parameter to reach vm->cf.

Verified: hosted (amd64) and kernel (amd64, __STARKERNEL__) both build
clean with -Wall -Werror after a full clean rebuild (struct VM's layout
changed size, and this Makefile has no header-dependency tracking, so a
stale incremental build would have linked mismatched object layouts).
Hosted POST suite 1012/1012 passing (0 regressions). Manually exercised
VOCABULARY/DEFINITIONS/FORTH/ORDER, and IF/ELSE, DO/LOOP/LEAVE,
BEGIN/WHILE/REPEAT, and CASE/OF/ENDOF/ENDCASE (including nested DO with
I/J) in the REPL -- all correct and unchanged from pre-refactor behavior.

Note: a pre-existing CASE/ENDCASE default-clause bug (the code after the
last OF...ENDOF pair does not correctly become the "default" value once
DROP runs) was found while testing this refactor and confirmed present
on unmodified master too -- not touched here, out of scope for this pass.

Co-Authored-By: Claude Sonnet 5 <noreply@anthropic.com>
Claude-Session: https://claude.ai/code/session_014Qf6YcnHgaEtEygq3knx19
This commit is contained in:
Claude
2026-09-05 14:07:41 +00:00
parent c36bd99e1e
commit d6895bdd15
6 changed files with 230 additions and 173 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/word_source/control_words.c
+80 -121
View File
@@ -87,100 +87,59 @@ static void control_forth_EXIT(VM * vm);
/**
* @defgroup cf Control Flow Stack
* Compile-time control flow stack for tracking branch targets and loop structures
* Compile-time control flow stack for tracking branch targets and loop
* structures. The types (cf_tag_t, cf_item_t, ControlFlowState) and the
* CF_STACK_MAX constant live in include/vm.h and the storage itself lives
* per-VM at vm->cf, so two VMs compiling colon definitions concurrently
* never share nesting state (see include/vm.h's ControlFlowState comment).
* @{
*/
/** Maximum depth of control flow stack */
#define CF_STACK_MAX 64
/** Control flow item types */
typedef enum {
CF_BEGIN, /**< Address of BEGIN target */
CF_IF, /**< Address of IF's 0BRANCH literal */
CF_ELSE, /**< Address of ELSE's BRANCH literal */
CF_WHILE, /**< Address of WHILE's 0BRANCH literal (paired with prior BEGIN) */
CF_DO, /**< Address of loop body start (back target for LOOP/+LOOP) */
CF_CASE, /**< Marker for CASE statement start */
CF_OF /**< Address of OF's 0BRANCH literal */
} cf_tag_t;
/** @} */
typedef struct {
size_t addr; /* byte offset in vm->memory used for patching/back edges */
cf_tag_t tag;
} cf_item_t;
static cf_item_t cf_stack[CF_STACK_MAX];
static int cf_sp = -1;
/* Reset CF stack on mode transitions (between INTERPRET/COMPILE) */
static int cf_last_mode = -999;
static inline void cf_epoch_sync(VM *vm) {
if (!vm) return;
if (cf_last_mode == -999) {
cf_last_mode = vm->mode;
if (vm->cf.cf_last_mode == -999) {
vm->cf.cf_last_mode = vm->mode;
return;
}
if ((int)vm->mode != cf_last_mode) {
cf_sp = -1;
cf_last_mode = vm->mode;
if ((int)vm->mode != vm->cf.cf_last_mode) {
vm->cf.cf_sp = -1;
vm->cf.cf_last_mode = vm->mode;
log_message(LOG_DEBUG, "CF: reset (mode transition)");
}
}
static inline int cf_push_item(cf_tag_t tag, size_t mark) {
if (cf_sp + 1 >= CF_STACK_MAX) {
static inline int cf_push_item(VM *vm, cf_tag_t tag, size_t mark) {
if (vm->cf.cf_sp + 1 >= CF_STACK_MAX) {
log_message(LOG_ERROR, "CF: overflow");
return 0;
}
++cf_sp;
cf_stack[cf_sp].tag = tag;
cf_stack[cf_sp].addr = mark;
++vm->cf.cf_sp;
vm->cf.cf_stack[vm->cf.cf_sp].tag = tag;
vm->cf.cf_stack[vm->cf.cf_sp].addr = mark;
return 1;
}
static inline int cf_pop_item(cf_item_t *out) {
if (cf_sp < 0) {
static inline int cf_pop_item(VM *vm, cf_item_t *out) {
if (vm->cf.cf_sp < 0) {
log_message(LOG_ERROR, "CF: underflow");
return 0;
}
if (out) {
*out = cf_stack[cf_sp];
*out = vm->cf.cf_stack[vm->cf.cf_sp];
}
--cf_sp;
--vm->cf.cf_sp;
return 1;
}
static inline int cf_peek_item(cf_item_t *out) {
if (cf_sp < 0) return 0;
static inline int cf_peek_item(VM *vm, cf_item_t *out) {
if (vm->cf.cf_sp < 0) return 0;
if (out) {
*out = cf_stack[cf_sp];
*out = vm->cf.cf_stack[vm->cf.cf_sp];
}
return 1;
}
/* ===================== LEAVE patching (compile-time) ===================== */
/* We collect BRANCH literals for LEAVE sites and patch them at LOOP/+LOOP. */
static size_t leave_addrs[CF_STACK_MAX];
static int leave_sp = -1;
/* One mark per DO nesting: record leave_sp at DO/?DO; at LOOP/+LOOP patch and restore. */
static int leave_mark_stack[CF_STACK_MAX];
static int leave_mark_sp = -1;
/* ===================== CASE/ENDOF patching (compile-time) ===================== */
/* We collect BRANCH literals for ENDOF sites and patch them at ENDCASE. */
static size_t endof_addrs[CF_STACK_MAX];
static int endof_sp = -1;
/* One mark per CASE nesting: record endof_sp at CASE; at ENDCASE patch and restore. */
static int endof_mark_stack[CF_STACK_MAX];
static int endof_mark_sp = -1;
/** @} */
/* ===================== Low-level compile helpers ===================== */
@@ -459,7 +418,7 @@ static void control_forth_if(VM *vm) {
}
vm_compile_call(vm, control_forth_0branch);
size_t lit = emit_cell(vm, 0);
if (!cf_push_item(CF_IF, lit)) {
if (!cf_push_item(vm, CF_IF, lit)) {
vm->error = 1;
return;
}
@@ -474,17 +433,17 @@ static void control_forth_else(VM *vm) {
return;
}
cf_item_t it;
if (!cf_peek_item(&it) || it.tag != CF_IF) {
if (!cf_peek_item(vm, &it) || it.tag != CF_IF) {
vm->error = 1;
log_message(LOG_ERROR, "ELSE: missing IF");
return;
}
(void) cf_pop_item(&it);
(void) cf_pop_item(vm, &it);
vm_compile_call(vm, control_forth_branch);
size_t new_lit = emit_cell(vm, 0);
cell_t off = (cell_t)((size_t) vm->here - it.addr);
*(cell_t *) (vm->memory + it.addr) = off;
if (!cf_push_item(CF_ELSE, new_lit)) {
if (!cf_push_item(vm, CF_ELSE, new_lit)) {
vm->error = 1;
return;
}
@@ -499,7 +458,7 @@ static void control_forth_then(VM *vm) {
return;
}
cf_item_t it;
if (!cf_pop_item(&it) || (it.tag != CF_IF && it.tag != CF_ELSE)) {
if (!cf_pop_item(vm, &it) || (it.tag != CF_IF && it.tag != CF_ELSE)) {
vm->error = 1;
log_message(LOG_ERROR, "THEN: unmatched");
return;
@@ -516,7 +475,7 @@ static void control_forth_begin(VM *vm) {
log_message(LOG_ERROR, "BEGIN: compile-only");
return;
}
if (!cf_push_item(CF_BEGIN, vm->here)) {
if (!cf_push_item(vm, CF_BEGIN, vm->here)) {
vm->error = 1;
return;
}
@@ -531,7 +490,7 @@ static void control_forth_until(VM *vm) {
return;
}
cf_item_t begin;
if (!cf_pop_item(&begin) || begin.tag != CF_BEGIN) {
if (!cf_pop_item(vm, &begin) || begin.tag != CF_BEGIN) {
vm->error = 1;
log_message(LOG_ERROR, "UNTIL: missing BEGIN");
return;
@@ -550,7 +509,7 @@ static void control_forth_again(VM *vm) {
return;
}
cf_item_t begin;
if (!cf_pop_item(&begin) || begin.tag != CF_BEGIN) {
if (!cf_pop_item(vm, &begin) || begin.tag != CF_BEGIN) {
vm->error = 1;
log_message(LOG_ERROR, "AGAIN: missing BEGIN");
return;
@@ -569,14 +528,14 @@ static void control_forth_while(VM *vm) {
return;
}
cf_item_t b;
if (!cf_peek_item(&b) || b.tag != CF_BEGIN) {
if (!cf_peek_item(vm, &b) || b.tag != CF_BEGIN) {
vm->error = 1;
log_message(LOG_ERROR, "WHILE: needs BEGIN");
return;
}
vm_compile_call(vm, control_forth_0branch);
size_t lit = emit_cell(vm, 0);
if (!cf_push_item(CF_WHILE, lit)) {
if (!cf_push_item(vm, CF_WHILE, lit)) {
vm->error = 1;
return;
}
@@ -591,12 +550,12 @@ static void control_forth_repeat(VM *vm) {
return;
}
cf_item_t w, b;
if (!cf_pop_item(&w) || w.tag != CF_WHILE) {
if (!cf_pop_item(vm, &w) || w.tag != CF_WHILE) {
vm->error = 1;
log_message(LOG_ERROR, "REPEAT: missing WHILE");
return;
}
if (!cf_pop_item(&b) || b.tag != CF_BEGIN) {
if (!cf_pop_item(vm, &b) || b.tag != CF_BEGIN) {
vm->error = 1;
log_message(LOG_ERROR, "REPEAT: missing BEGIN");
return;
@@ -619,16 +578,16 @@ static void control_forth_qdo(VM *vm) {
}
vm_compile_call(vm, control_forth_runtime_qdo);
size_t fwd_lit = emit_cell(vm, 0);
if (!cf_push_item(CF_DO, vm->here)) {
if (!cf_push_item(vm, CF_DO, vm->here)) {
vm->error = 1;
return;
} /* back target for LOOP */
if (!cf_push_item(CF_WHILE, fwd_lit)) {
if (!cf_push_item(vm, CF_WHILE, fwd_lit)) {
vm->error = 1;
return;
} /* forward to loop-end */
leave_mark_stack[++leave_mark_sp] = leave_sp;
log_message(LOG_DEBUG, "?DO: fwd lit @ %zu; back mark=%d", fwd_lit, leave_mark_stack[leave_mark_sp]);
vm->cf.leave_mark_stack[++vm->cf.leave_mark_sp] = vm->cf.leave_sp;
log_message(LOG_DEBUG, "?DO: fwd lit @ %zu; back mark=%d", fwd_lit, vm->cf.leave_mark_stack[vm->cf.leave_mark_sp]);
}
/* DO ( limit index -- ) compile */
@@ -640,12 +599,12 @@ static void control_forth_do(VM *vm) {
return;
}
vm_compile_call(vm, control_forth_runtime_do);
if (!cf_push_item(CF_DO, vm->here)) {
if (!cf_push_item(vm, CF_DO, vm->here)) {
vm->error = 1;
return;
}
leave_mark_stack[++leave_mark_sp] = leave_sp;
log_message(LOG_DEBUG, "DO: mark @ %zu; leave_mark=%d", vm->here, leave_mark_stack[leave_mark_sp]);
vm->cf.leave_mark_stack[++vm->cf.leave_mark_sp] = vm->cf.leave_sp;
log_message(LOG_DEBUG, "DO: mark @ %zu; leave_mark=%d", vm->here, vm->cf.leave_mark_stack[vm->cf.leave_mark_sp]);
}
/* LEAVE — compile runtime LEAVE plus BRANCH <placeholder>, collect patch site */
@@ -659,13 +618,13 @@ static void control_forth_leave(VM *vm) {
/* verify inside DO */
int seen_do = 0;
for (int i = cf_sp; i >= 0; --i) {
if (cf_stack[i].tag == CF_DO) {
for (int i = vm->cf.cf_sp; i >= 0; --i) {
if (vm->cf.cf_stack[i].tag == CF_DO) {
seen_do = 1;
break;
}
}
if (!seen_do || leave_mark_sp < 0) {
if (!seen_do || vm->cf.leave_mark_sp < 0) {
vm->error = 1;
log_message(LOG_ERROR, "LEAVE: needs DO");
return;
@@ -674,13 +633,13 @@ static void control_forth_leave(VM *vm) {
vm_compile_call(vm, control_forth_runtime_leave);
vm_compile_call(vm, control_forth_branch);
size_t lit = emit_cell(vm, 0);
if (leave_sp + 1 >= CF_STACK_MAX) {
if (vm->cf.leave_sp + 1 >= CF_STACK_MAX) {
vm->error = 1;
log_message(LOG_ERROR, "LEAVE: too many sites");
return;
}
leave_addrs[++leave_sp] = lit;
log_message(LOG_DEBUG, "LEAVE: site lit @ %zu (leave_sp=%d)", lit, leave_sp);
vm->cf.leave_addrs[++vm->cf.leave_sp] = lit;
log_message(LOG_DEBUG, "LEAVE: site lit @ %zu (leave_sp=%d)", lit, vm->cf.leave_sp);
}
/* LOOP — compile runtime LOOP + backoffset; patch ?DO fwd and LEAVE sites */
@@ -696,14 +655,14 @@ static void control_forth_loop(VM *vm) {
cf_item_t maybe_qdo;
int have_qdo = 0;
cf_item_t top;
if (cf_peek_item(&top) && top.tag == CF_WHILE) {
(void) cf_pop_item(&maybe_qdo);
if (cf_peek_item(vm, &top) && top.tag == CF_WHILE) {
(void) cf_pop_item(vm, &maybe_qdo);
have_qdo = 1;
}
/* Required DO back mark */
cf_item_t do_mark;
if (!cf_pop_item(&do_mark) || do_mark.tag != CF_DO) {
if (!cf_pop_item(vm, &do_mark) || do_mark.tag != CF_DO) {
vm->error = 1;
log_message(LOG_ERROR, "LOOP: missing DO");
return;
@@ -719,19 +678,19 @@ static void control_forth_loop(VM *vm) {
log_message(LOG_DEBUG, "LOOP: patched ?DO @ %zu -> +%ld", maybe_qdo.addr, (long) fwd);
}
if (leave_mark_sp < 0) {
if (vm->cf.leave_mark_sp < 0) {
vm->error = 1;
log_message(LOG_ERROR, "LOOP: LEAVE mark underflow");
return;
}
int mark = leave_mark_stack[leave_mark_sp--];
for (int i = leave_sp; i > mark; --i) {
size_t addr = leave_addrs[i];
int mark = vm->cf.leave_mark_stack[vm->cf.leave_mark_sp--];
for (int i = vm->cf.leave_sp; i > mark; --i) {
size_t addr = vm->cf.leave_addrs[i];
cell_t fwd = (cell_t)((size_t) vm->here - addr);
*(cell_t *) (vm->memory + addr) = fwd;
log_message(LOG_DEBUG, "LEAVE: patched @ %zu -> +%ld", addr, (long) fwd);
}
leave_sp = mark;
vm->cf.leave_sp = mark;
log_message(LOG_DEBUG, "LOOP: back -> %zu (%ld bytes)", do_mark.addr, (long) back);
}
@@ -748,13 +707,13 @@ static void control_forth_plus_loop(VM *vm) {
cf_item_t maybe_qdo;
int have_qdo = 0;
cf_item_t top;
if (cf_peek_item(&top) && top.tag == CF_WHILE) {
(void) cf_pop_item(&maybe_qdo);
if (cf_peek_item(vm, &top) && top.tag == CF_WHILE) {
(void) cf_pop_item(vm, &maybe_qdo);
have_qdo = 1;
}
cf_item_t do_mark;
if (!cf_pop_item(&do_mark) || do_mark.tag != CF_DO) {
if (!cf_pop_item(vm, &do_mark) || do_mark.tag != CF_DO) {
vm->error = 1;
log_message(LOG_ERROR, "+LOOP: missing DO");
return;
@@ -770,19 +729,19 @@ static void control_forth_plus_loop(VM *vm) {
log_message(LOG_DEBUG, "+LOOP: patched ?DO @ %zu -> +%ld", maybe_qdo.addr, (long) fwd);
}
if (leave_mark_sp < 0) {
if (vm->cf.leave_mark_sp < 0) {
vm->error = 1;
log_message(LOG_ERROR, "+LOOP: LEAVE mark underflow");
return;
}
int mark = leave_mark_stack[leave_mark_sp--];
for (int i = leave_sp; i > mark; --i) {
size_t addr = leave_addrs[i];
int mark = vm->cf.leave_mark_stack[vm->cf.leave_mark_sp--];
for (int i = vm->cf.leave_sp; i > mark; --i) {
size_t addr = vm->cf.leave_addrs[i];
cell_t fwd = (cell_t)((size_t) vm->here - addr);
*(cell_t *) (vm->memory + addr) = fwd;
log_message(LOG_DEBUG, "LEAVE: patched @ %zu -> +%ld", addr, (long) fwd);
}
leave_sp = mark;
vm->cf.leave_sp = mark;
log_message(LOG_DEBUG, "+LOOP: back -> %zu (%ld bytes)", do_mark.addr, (long) back);
}
@@ -810,18 +769,18 @@ static void control_forth_case(VM *vm) {
log_message(LOG_ERROR, "CASE: compile-only");
return;
}
if (!cf_push_item(CF_CASE, 0)) {
if (!cf_push_item(vm, CF_CASE, 0)) {
vm->error = 1;
return;
}
/* Record current endof_sp so ENDCASE knows which branches to patch */
if (endof_mark_sp + 1 >= CF_STACK_MAX) {
if (vm->cf.endof_mark_sp + 1 >= CF_STACK_MAX) {
vm->error = 1;
log_message(LOG_ERROR, "CASE: nesting overflow");
return;
}
endof_mark_stack[++endof_mark_sp] = endof_sp;
log_message(LOG_DEBUG, "CASE: mark (endof_mark=%d)", endof_mark_stack[endof_mark_sp]);
vm->cf.endof_mark_stack[++vm->cf.endof_mark_sp] = vm->cf.endof_sp;
log_message(LOG_DEBUG, "CASE: mark (endof_mark=%d)", vm->cf.endof_mark_stack[vm->cf.endof_mark_sp]);
}
/* OF ( n1 n2 -- | n1 ) compile-time: compare and branch */
@@ -835,8 +794,8 @@ static void control_forth_of(VM *vm) {
/* Verify inside CASE */
int seen_case = 0;
for (int i = cf_sp; i >= 0; --i) {
if (cf_stack[i].tag == CF_CASE) {
for (int i = vm->cf.cf_sp; i >= 0; --i) {
if (vm->cf.cf_stack[i].tag == CF_CASE) {
seen_case = 1;
break;
}
@@ -865,7 +824,7 @@ static void control_forth_of(VM *vm) {
size_t of_branch = emit_cell(vm, 0); /* Placeholder for ENDOF */
vm_compile_call(vm, drop_entry->func);
if (!cf_push_item(CF_OF, of_branch)) {
if (!cf_push_item(vm, CF_OF, of_branch)) {
vm->error = 1;
return;
}
@@ -883,7 +842,7 @@ static void control_forth_endof(VM *vm) {
/* Pop CF_OF and patch its forward branch */
cf_item_t of_item;
if (!cf_pop_item(&of_item) || of_item.tag != CF_OF) {
if (!cf_pop_item(vm, &of_item) || of_item.tag != CF_OF) {
vm->error = 1;
log_message(LOG_ERROR, "ENDOF: missing OF");
return;
@@ -898,12 +857,12 @@ static void control_forth_endof(VM *vm) {
*(cell_t *) (vm->memory + of_item.addr) = off;
/* Save ENDOF's branch for ENDCASE patching */
if (endof_sp + 1 >= CF_STACK_MAX) {
if (vm->cf.endof_sp + 1 >= CF_STACK_MAX) {
vm->error = 1;
log_message(LOG_ERROR, "ENDOF: too many clauses");
return;
}
endof_addrs[++endof_sp] = endcase_branch;
vm->cf.endof_addrs[++vm->cf.endof_sp] = endcase_branch;
log_message(LOG_DEBUG, "ENDOF: patched OF @ %zu -> +%ld; endcase branch @ %zu",
of_item.addr, (long) off, endcase_branch);
@@ -920,7 +879,7 @@ static void control_forth_endcase(VM *vm) {
/* Pop CF_CASE marker */
cf_item_t case_item;
if (!cf_pop_item(&case_item) || case_item.tag != CF_CASE) {
if (!cf_pop_item(vm, &case_item) || case_item.tag != CF_CASE) {
vm->error = 1;
log_message(LOG_ERROR, "ENDCASE: missing CASE");
return;
@@ -936,19 +895,19 @@ static void control_forth_endcase(VM *vm) {
vm_compile_call(vm, drop_entry->func);
/* Patch all ENDOF branches to here */
if (endof_mark_sp < 0) {
if (vm->cf.endof_mark_sp < 0) {
vm->error = 1;
log_message(LOG_ERROR, "ENDCASE: mark underflow");
return;
}
int mark = endof_mark_stack[endof_mark_sp--];
for (int i = endof_sp; i > mark; --i) {
size_t addr = endof_addrs[i];
int mark = vm->cf.endof_mark_stack[vm->cf.endof_mark_sp--];
for (int i = vm->cf.endof_sp; i > mark; --i) {
size_t addr = vm->cf.endof_addrs[i];
cell_t fwd = (cell_t)((size_t) vm->here - addr);
*(cell_t *) (vm->memory + addr) = fwd;
log_message(LOG_DEBUG, "ENDCASE: patched ENDOF @ %zu -> +%ld", addr, (long) fwd);
}
endof_sp = mark;
vm->cf.endof_sp = mark;
log_message(LOG_DEBUG, "ENDCASE: complete");
}