Compare commits
3
Commits
| Author | SHA1 | Date | |
|---|---|---|---|
|
|
7191ce5a56 | ||
|
|
d6895bdd15 | ||
|
|
c36bd99e1e |
@@ -138,6 +138,13 @@ void vm_store_u8(struct VM* vm, vaddr_t addr, uint8_t v);
|
||||
cell_t vm_load_cell(struct VM* vm, vaddr_t addr); /* requires alignment */
|
||||
void vm_store_cell(struct VM* vm, vaddr_t addr, cell_t v);
|
||||
|
||||
/* Numeric BASE accessors: keep the FORTH-visible BASE cell (vm->base_addr)
|
||||
* and the host-mirror field (vm->base, read by number-output words via
|
||||
* current_base()) in sync. Always use these instead of writing base_addr
|
||||
* directly. */
|
||||
unsigned vm_get_base(const struct VM* vm);
|
||||
void vm_set_base(struct VM* vm, unsigned b);
|
||||
|
||||
/* Explicit stack<->offset conversions (keep intent obvious) */
|
||||
static inline vaddr_t VM_ADDR(cell_t c) { return (vaddr_t)(uint64_t)c; }
|
||||
static inline cell_t CELL(vaddr_t a) { return (cell_t)(int64_t)a; }
|
||||
@@ -357,6 +364,81 @@ typedef enum
|
||||
MODE_COMPILE = 1
|
||||
} vm_mode_t;
|
||||
|
||||
/* Per-VM vocabulary (VOCABULARY/DEFINITIONS/CONTEXT/CURRENT/FORTH) state.
|
||||
* Was a set of file-scope statics in vocabulary_words.c, shared by every VM
|
||||
* in the process -- one VM's VOCABULARY/DEFINITIONS/FORTH silently changed
|
||||
* where every other VM looked up and defined words (proof/FINDINGS.md #1,
|
||||
* item #5, "highest severity in the sweep"). Moved onto struct VM so each
|
||||
* VM in the fleet keeps its own vocabulary chains, search order, and VM-cell
|
||||
* addresses -- same shape as hold_addr/hold_pos below. */
|
||||
#define VOCAB_FC_BUCKETS 256
|
||||
typedef struct {
|
||||
int initialized;
|
||||
|
||||
/* Host-side vocabulary chain heads */
|
||||
DictEntry *forth_vocab; /* FORTH vocabulary head (root of system) */
|
||||
DictEntry *context_vocab; /* CONTEXT vocabulary head */
|
||||
DictEntry *current_vocab; /* CURRENT vocabulary head */
|
||||
|
||||
/* VM-visible variables: cell addresses in this VM's own memory */
|
||||
vaddr_t context_var_addr; /* cell containing (DictEntry*) CONTEXT */
|
||||
vaddr_t current_var_addr; /* cell containing (DictEntry*) CURRENT */
|
||||
|
||||
/* First-character search index per chain, lazily rebuilt when that
|
||||
* chain's head changes (see vocab_find_word in vocabulary_words.c) */
|
||||
DictEntry **ctx_fc[VOCAB_FC_BUCKETS];
|
||||
size_t ctx_n[VOCAB_FC_BUCKETS];
|
||||
DictEntry *ctx_cached_head;
|
||||
|
||||
DictEntry **forth_fc[VOCAB_FC_BUCKETS];
|
||||
size_t forth_n[VOCAB_FC_BUCKETS];
|
||||
DictEntry *forth_cached_head;
|
||||
} VocabularyState;
|
||||
|
||||
/* Compile-time control-flow bookkeeping for IF/ELSE/THEN, BEGIN/WHILE/REPEAT/
|
||||
* UNTIL/AGAIN, DO/?DO/LOOP/+LOOP/LEAVE, and CASE/OF/ENDOF/ENDCASE.
|
||||
* Was a set of file-scope statics in control_words.c, shared by every VM in
|
||||
* the process -- two VMs compiling control structures at overlapping times
|
||||
* would corrupt each other's nesting state (proof/FINDINGS.md #1, item #1,
|
||||
* "the two that would actually corrupt VM behavior in the live Tripod fleet
|
||||
* today"). Moved onto struct VM so each VM keeps its own compile-time stacks. */
|
||||
#define CF_STACK_MAX 64
|
||||
|
||||
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;
|
||||
|
||||
typedef struct {
|
||||
cf_item_t cf_stack[CF_STACK_MAX];
|
||||
int cf_sp;
|
||||
int cf_last_mode; /* reset cf_stack on mode transitions (INTERPRET/COMPILE) */
|
||||
|
||||
/* LEAVE patch sites: one entry per LEAVE, collected until LOOP/+LOOP */
|
||||
size_t leave_addrs[CF_STACK_MAX];
|
||||
int leave_sp;
|
||||
/* One mark per DO nesting: leave_sp at DO/?DO entry, restored at LOOP/+LOOP */
|
||||
int leave_mark_stack[CF_STACK_MAX];
|
||||
int leave_mark_sp;
|
||||
|
||||
/* ENDOF patch sites: one entry per ENDOF, collected until ENDCASE */
|
||||
size_t endof_addrs[CF_STACK_MAX];
|
||||
int endof_sp;
|
||||
/* One mark per CASE nesting: endof_sp at CASE entry, restored at ENDCASE */
|
||||
int endof_mark_stack[CF_STACK_MAX];
|
||||
int endof_mark_sp;
|
||||
} ControlFlowState;
|
||||
|
||||
#ifdef __STARKERNEL__
|
||||
#include "starkernel/vm_uuid.h" /* VMUuid -- item 4.2, VM.stadium_vm_id */
|
||||
#include "starkernel/vm_identity.h" /* VMIdentity -- FABRIC-2.md §F.2/§F.16 */
|
||||
@@ -465,6 +547,9 @@ typedef struct VM
|
||||
vaddr_t hold_addr; /* VM memory offset of the 64-byte pictured-number hold buffer */
|
||||
int hold_pos; /* Current fill count in hold buffer (<# ... #> state) */
|
||||
|
||||
VocabularyState vocab; /* Per-VM VOCABULARY/DEFINITIONS/CONTEXT/CURRENT state */
|
||||
ControlFlowState cf; /* Per-VM compile-time control-flow bookkeeping */
|
||||
|
||||
/* Block I/O window — BLK_VM_SLOTS slots at BLK_VM_WINDOW_BASE in vm->memory.
|
||||
* BLOCK/BUFFER copy C-layer buffers here; UPDATE copies back; lbn==0 means empty. */
|
||||
uint32_t blk_vm_lbn[BLK_VM_SLOTS]; /* LBN currently in each slot (0 = empty) */
|
||||
@@ -638,6 +723,12 @@ DictEntry* vm_dictionary_find_latest_by_func(VM* vm, word_func_t func);
|
||||
|
||||
DictEntry* vm_dictionary_lookup_by_word_id(VM* vm, uint32_t word_id);
|
||||
|
||||
/* Validate that `candidate` is a live, currently-registered dictionary entry
|
||||
* for this VM (walks vm->latest under dict_lock; never dereferences an
|
||||
* unverified pointer). Use before executing/inspecting through any xt/addr
|
||||
* popped off the data stack (EXECUTE, ENTROPY@/!, etc). */
|
||||
int vm_dict_entry_ok(VM* vm, DictEntry* candidate);
|
||||
|
||||
void vm_dictionary_track_entry(VM* vm, DictEntry* entry);
|
||||
|
||||
void vm_dictionary_untrack_entry(VM* vm, DictEntry* entry);
|
||||
|
||||
Binary file not shown.
@@ -47,6 +47,15 @@ the two that would actually corrupt VM behavior in the live Tripod fleet
|
||||
today, if two VMs exercise them concurrently. Worth scoping as a real fix
|
||||
independent of this proof work — moving these into `struct VM` fields.
|
||||
|
||||
**RESOLVED 2026-09-05:** both #1 and #5 moved onto `struct VM`, following
|
||||
the `hold_addr`/`hold_pos` precedent already in `include/vm.h`. `vocabulary_words.c`'s
|
||||
chain heads, VM-cell addresses, first-char index, and `initialized` guard
|
||||
now live at `vm->vocab` (a new `VocabularyState` struct); `control_words.c`'s
|
||||
`cf_stack`/`leave_*`/`endof_*` bookkeeping now lives at `vm->cf` (a new
|
||||
`ControlFlowState` struct). Every word function in both files already took
|
||||
`VM *vm`, so no call sites outside these two files needed to change. #2, #3,
|
||||
#4, #6, #7 remain open — out of scope for this pass.
|
||||
|
||||
---
|
||||
|
||||
## 2. Missing overflow/capacity guards before stack pushes
|
||||
@@ -147,22 +156,43 @@ kernel word-source) — see this document's closing status line for result.
|
||||
since `EXECUTE` is a core, ubiquitous primitive rather than a diagnostic
|
||||
word. **Flagged as the highest-severity single-word finding in the
|
||||
sweep.**
|
||||
**RESOLVED 2026-09-05:** now validates via the (newly shared)
|
||||
`vm_dict_entry_ok()` — the same dictionary-walk check `ENTROPY@`/`ENTROPY!`
|
||||
already used, promoted out of `starforth_words.c` into
|
||||
`dictionary_management.c` so `EXECUTE` can call it too.
|
||||
- **`?` and `DUMP`** (`format_words.c`) cast the popped cell straight to a
|
||||
host pointer and dereference it, bypassing `vm_addr_ok` — an
|
||||
out-of-VM-bounds read.
|
||||
**RESOLVED 2026-09-05:** both now go through `VM_ADDR`/`vm_addr_ok`/
|
||||
`vm_load_cell`/`vm_ptr`, matching `@`/`,`/editor_words.c`'s pattern.
|
||||
- **`TYPE`** (`io_words.c`) has a signed-overflow bypass in its bounds
|
||||
check (machine-checked witness in the proof).
|
||||
**RESOLVED 2026-09-05:** replaced the manual `addr + count > VM_MEMORY_SIZE`
|
||||
sum with `vm_addr_ok(vm, addr, count)`, which is written to avoid exactly
|
||||
this overflow.
|
||||
- **`DECIMAL`/`HEX`/`OCTAL`** (`format_words.c`) write only the memory cell
|
||||
at `base_addr`, never `vm->base` (the separate host-mirror field number-
|
||||
*output* words actually read via `current_base()`) — proved as
|
||||
`decimal_does_not_change_vm_base` et al. Net effect: these words silently
|
||||
affect number *parsing* but never number *printing*.
|
||||
**RESOLVED 2026-09-05:** all three now call the existing `vm_set_base()`
|
||||
(previously only used at boot init), which updates both `base_addr` and
|
||||
`vm->base`; `vm_get_base()`/`vm_set_base()` promoted to public
|
||||
declarations in `include/vm.h` so word-source files can reach them.
|
||||
- **`LATEST`** (`dictionary_words.c`) has a body identical to `HERE` (both
|
||||
push `vm->here`) — does not consult `vm->latest` despite its doc comment
|
||||
claiming otherwise.
|
||||
- **`ALIGN`** bounds-checks `here` against `DICTIONARY_MEMORY_SIZE` (2MB)
|
||||
while `ALLOT`/`,`/`C,`/`2,` check against `VM_MEMORY_SIZE` (5MB) instead —
|
||||
two different ceilings for the same pointer.
|
||||
**RESOLVED 2026-09-05:** the two ceilings disagreeing was real, but
|
||||
`ALIGN`'s 2MB was the correct one, not `ALLOT`'s 5MB — `vm_get_block_addr()`
|
||||
maps block N directly to `vm->memory + N*BLOCK_SIZE` for the *entire* 5MB
|
||||
arena, and `USER_BLOCKS_START` (block 2048) lines up exactly with
|
||||
`DICTIONARY_MEMORY_SIZE`, so letting dictionary growth run past 2MB (as
|
||||
`ALLOT`/`,`/`C,`/`2,` previously allowed) would silently corrupt live
|
||||
block/user data sharing that same memory. Tightened `ALLOT`/`,`/`C,`/`2,`
|
||||
to `DICTIONARY_MEMORY_SIZE` to match `ALIGN`, not the other way around.
|
||||
- **`INFER-*` (`array_ptr`, `inference_words.c`)** sets `vm->error` *and*
|
||||
still pushes a placeholder value anyway — violates the "error or push,
|
||||
never both" shape essentially every other word in the sweep follows.
|
||||
|
||||
@@ -157,6 +157,23 @@ DictEntry *vm_dictionary_lookup_by_word_id(VM *vm, uint32_t word_id) {
|
||||
return vm->word_id_map[word_id];
|
||||
}
|
||||
|
||||
int vm_dict_entry_ok(VM *vm, DictEntry *candidate) {
|
||||
if (!vm || !candidate) {
|
||||
return 0;
|
||||
}
|
||||
|
||||
int found = 0;
|
||||
sf_mutex_lock(&vm->dict_lock);
|
||||
for (DictEntry *e = vm->latest; e != NULL; e = e->link) {
|
||||
if (e == candidate) {
|
||||
found = 1;
|
||||
break;
|
||||
}
|
||||
}
|
||||
sf_mutex_unlock(&vm->dict_lock);
|
||||
return found;
|
||||
}
|
||||
|
||||
/* --- helpers ------------------------------------------------------------- */
|
||||
|
||||
static inline void *sf_xrealloc(void *p, size_t nbytes) {
|
||||
|
||||
@@ -56,7 +56,7 @@ void *vm_allot(VM *vm, size_t bytes) {
|
||||
return NULL;
|
||||
}
|
||||
|
||||
/* Ensure we don't allocate beyond dictionary space (first 1024 blocks = 1MB) */
|
||||
/* Ensure we don't allocate beyond dictionary space (first DICTIONARY_BLOCKS blocks = DICTIONARY_MEMORY_SIZE bytes) */
|
||||
log_message(LOG_DEBUG, "vm_allot: Requesting %zu bytes, current here=%zu, limit=%d",
|
||||
bytes, vm->here, DICTIONARY_MEMORY_SIZE);
|
||||
|
||||
|
||||
@@ -190,6 +190,15 @@ void vm_init_with_host(VM* vm, const VMHostServices *host)
|
||||
vm->rsp = -1;
|
||||
vm->here = 0;
|
||||
vm->exit_colon = 0;
|
||||
|
||||
/* Control-flow bookkeeping sentinels (-1/-999 mean "empty"; the
|
||||
* `*vm = (VM){0}` above already zeroed the arrays themselves) */
|
||||
vm->cf.cf_sp = -1;
|
||||
vm->cf.cf_last_mode = -999;
|
||||
vm->cf.leave_sp = -1;
|
||||
vm->cf.leave_mark_sp = -1;
|
||||
vm->cf.endof_sp = -1;
|
||||
vm->cf.endof_mark_sp = -1;
|
||||
vm->abort_requested = 0;
|
||||
|
||||
log_message(LOG_DEBUG, "vm_init: memory=%p here=%zu", (void*)vm->memory, vm->here);
|
||||
|
||||
@@ -178,6 +178,15 @@ void vm_init(VM* vm)
|
||||
vm->rsp = -1;
|
||||
vm->here = 0;
|
||||
vm->exit_colon = 0;
|
||||
|
||||
/* Control-flow bookkeeping sentinels (-1/-999 mean "empty"; memset above
|
||||
* already zeroed the arrays themselves) */
|
||||
vm->cf.cf_sp = -1;
|
||||
vm->cf.cf_last_mode = -999;
|
||||
vm->cf.leave_sp = -1;
|
||||
vm->cf.leave_mark_sp = -1;
|
||||
vm->cf.endof_sp = -1;
|
||||
vm->cf.endof_mark_sp = -1;
|
||||
vm->abort_requested = 0;
|
||||
|
||||
vm_align(vm);
|
||||
|
||||
+80
-121
@@ -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");
|
||||
}
|
||||
|
||||
@@ -71,7 +71,11 @@ void dictionary_word_allot(VM *vm) {
|
||||
}
|
||||
cell_t n = vm_pop(vm);
|
||||
cell_t new_here = vm->here + n;
|
||||
if (new_here < 0 || new_here > (cell_t) VM_MEMORY_SIZE) {
|
||||
/* Dictionary growth is bounded to DICTIONARY_MEMORY_SIZE, not the full
|
||||
* VM_MEMORY_SIZE: blocks >= USER_BLOCKS_START live in the same flat
|
||||
* vm->memory array (see vm_get_block_addr), so letting `here` grow past
|
||||
* the dictionary region would silently corrupt live block/user data. */
|
||||
if (new_here < 0 || new_here > (cell_t) DICTIONARY_MEMORY_SIZE) {
|
||||
vm->error = 1;
|
||||
return;
|
||||
}
|
||||
@@ -90,7 +94,7 @@ void dictionary_word_comma(VM *vm) {
|
||||
}
|
||||
cell_t n = vm_pop(vm);
|
||||
vm_align(vm);
|
||||
if (vm->here + (cell_t) sizeof(cell_t) > VM_MEMORY_SIZE) {
|
||||
if (vm->here + (cell_t) sizeof(cell_t) > DICTIONARY_MEMORY_SIZE) {
|
||||
vm->error = 1;
|
||||
return;
|
||||
}
|
||||
@@ -114,7 +118,7 @@ void dictionary_word_c_comma(VM *vm) {
|
||||
return;
|
||||
}
|
||||
cell_t c = vm_pop(vm);
|
||||
if (vm->here + 1 > VM_MEMORY_SIZE) {
|
||||
if (vm->here + 1 > DICTIONARY_MEMORY_SIZE) {
|
||||
vm->error = 1;
|
||||
return;
|
||||
}
|
||||
@@ -140,7 +144,7 @@ void dictionary_word_2comma(VM *vm) {
|
||||
cell_t high = vm_pop(vm);
|
||||
cell_t low = vm_pop(vm);
|
||||
vm_align(vm);
|
||||
if (vm->here + (cell_t)(2 * sizeof(cell_t)) > VM_MEMORY_SIZE) {
|
||||
if (vm->here + (cell_t)(2 * sizeof(cell_t)) > DICTIONARY_MEMORY_SIZE) {
|
||||
vm->error = 1;
|
||||
return;
|
||||
}
|
||||
|
||||
@@ -157,19 +157,19 @@ void format_word_base(VM *vm) {
|
||||
/* DECIMAL ( -- ) — set BASE=10 */
|
||||
void format_word_decimal(VM *vm) {
|
||||
if (!vm) { return; }
|
||||
vm_store_cell(vm, vm->base_addr, (cell_t) 10);
|
||||
vm_set_base(vm, 10);
|
||||
}
|
||||
|
||||
/* HEX ( -- ) — set BASE=16 */
|
||||
void format_word_hex(VM *vm) {
|
||||
if (!vm) { return; }
|
||||
vm_store_cell(vm, vm->base_addr, (cell_t) 16);
|
||||
vm_set_base(vm, 16);
|
||||
}
|
||||
|
||||
/* OCTAL ( -- ) — set BASE=8 */
|
||||
void format_word_octal(VM *vm) {
|
||||
if (!vm) { return; }
|
||||
vm_store_cell(vm, vm->base_addr, (cell_t) 8);
|
||||
vm_set_base(vm, 8);
|
||||
}
|
||||
|
||||
/* <# ( -- ) */
|
||||
@@ -399,13 +399,12 @@ void format_word_question(VM *vm) {
|
||||
vm->error = 1;
|
||||
return;
|
||||
}
|
||||
cell_t addr = vm_pop(vm);
|
||||
cell_t *ptr = (cell_t *) (uintptr_t) addr;
|
||||
if (!ptr) {
|
||||
vaddr_t addr = VM_ADDR(vm_pop(vm));
|
||||
if (!vm_addr_ok(vm, addr, sizeof(cell_t))) {
|
||||
vm->error = 1;
|
||||
return;
|
||||
}
|
||||
print_number_formatted(vm, *ptr, 0, 0);
|
||||
print_number_formatted(vm, vm_load_cell(vm, addr), 0, 0);
|
||||
putchar(' ');
|
||||
}
|
||||
|
||||
@@ -416,21 +415,21 @@ void format_word_dump(VM *vm) {
|
||||
return;
|
||||
}
|
||||
cell_t u = vm_pop(vm);
|
||||
cell_t addr = vm_pop(vm);
|
||||
vaddr_t addr = VM_ADDR(vm_pop(vm));
|
||||
if (u < 0) {
|
||||
vm->error = 1;
|
||||
return;
|
||||
}
|
||||
uint8_t *ptr = (uint8_t *) (uintptr_t) addr;
|
||||
if (!ptr) {
|
||||
size_t n = (size_t) u;
|
||||
if (!vm_addr_ok(vm, addr, n)) {
|
||||
vm->error = 1;
|
||||
return;
|
||||
}
|
||||
size_t n = (size_t) u;
|
||||
int addr_width = (int) (sizeof(uintptr_t) * 2);
|
||||
const uint8_t *ptr = vm_ptr(vm, addr);
|
||||
int addr_width = (int) (sizeof(vaddr_t) * 2);
|
||||
|
||||
for (size_t i = 0; i < n; i += 16) {
|
||||
unsigned long long a = (unsigned long long) ((uintptr_t) addr + (uintptr_t) i);
|
||||
unsigned long long a = (unsigned long long) (addr + i);
|
||||
printf("%0*llX: ", addr_width, a);
|
||||
size_t j = 0;
|
||||
for (; j < 16 && i + j < n; j++) printf("%02X ", ptr[i + j]);
|
||||
|
||||
@@ -122,22 +122,26 @@ static void io_word_type(VM *vm) {
|
||||
}
|
||||
|
||||
cell_t count = vm_pop(vm);
|
||||
cell_t addr = vm_pop(vm);
|
||||
vaddr_t addr = VM_ADDR(vm_pop(vm));
|
||||
|
||||
// Add bounds checking
|
||||
if (addr < 0 || count < 0 || (addr + count) > VM_MEMORY_SIZE) {
|
||||
log_message(LOG_ERROR, "TYPE: Invalid range [%ld, %ld)", (long) addr, (long) (addr + count));
|
||||
// Bounds check via vm_addr_ok (avoids the addr+count overflow a manual
|
||||
// sum would risk for large signed operands)
|
||||
if (count < 0 || !vm_addr_ok(vm, addr, (size_t) count)) {
|
||||
log_message(LOG_ERROR, "TYPE: Invalid range [addr=%llu, count=%ld)",
|
||||
(unsigned long long) addr, (long) count);
|
||||
vm->error = 1;
|
||||
return;
|
||||
}
|
||||
|
||||
// Output characters from VM memory
|
||||
const uint8_t *src = vm_ptr(vm, addr);
|
||||
for (cell_t i = 0; i < count; i++) {
|
||||
putchar(vm->memory[addr + i]);
|
||||
putchar(src[i]);
|
||||
}
|
||||
fflush(stdout);
|
||||
|
||||
log_message(LOG_DEBUG, "TYPE: Output %ld characters from address %ld", (long) count, (long) addr);
|
||||
log_message(LOG_DEBUG, "TYPE: Output %ld characters from address %llu",
|
||||
(long) count, (unsigned long long) addr);
|
||||
}
|
||||
|
||||
/**
|
||||
|
||||
@@ -78,27 +78,6 @@ static uint64_t g_prng_state = 1;
|
||||
* Note: Exposed as ENTROPY@ for FORTH compatibility, but measures execution heat.
|
||||
* @param vm Pointer to the VM instance
|
||||
*/
|
||||
/**
|
||||
* @brief Validate that an address is a valid DictEntry pointer
|
||||
* @param vm The VM instance
|
||||
* @param candidate The address to validate
|
||||
* @return 1 if valid, 0 if not
|
||||
*/
|
||||
static int is_valid_dict_entry(VM* vm, DictEntry* candidate)
|
||||
{
|
||||
if (!candidate) return 0;
|
||||
|
||||
/* Walk dictionary to verify this is a real entry - must hold dict_lock */
|
||||
int found = 0;
|
||||
sf_mutex_lock(&vm->dict_lock);
|
||||
for (DictEntry* e = vm->latest; e != NULL; e = e->link)
|
||||
{
|
||||
if (e == candidate) { found = 1; break; }
|
||||
}
|
||||
sf_mutex_unlock(&vm->dict_lock);
|
||||
return found;
|
||||
}
|
||||
|
||||
void starforth_word_execution_heat_fetch(VM* vm)
|
||||
{
|
||||
if (vm->dsp < 0)
|
||||
@@ -119,7 +98,7 @@ void starforth_word_execution_heat_fetch(VM* vm)
|
||||
}
|
||||
|
||||
/* Guardrail: Validate the pointer is actually a DictEntry */
|
||||
if (!is_valid_dict_entry(vm, entry))
|
||||
if (!vm_dict_entry_ok(vm, entry))
|
||||
{
|
||||
vm->error = 1;
|
||||
log_message(LOG_ERROR, "ENTROPY@: invalid dictionary entry address %p (not in dictionary)", (void*)entry);
|
||||
@@ -158,7 +137,7 @@ void starforth_word_execution_heat_store(VM* vm)
|
||||
}
|
||||
|
||||
/* Guardrail: Validate the pointer is actually a DictEntry */
|
||||
if (!is_valid_dict_entry(vm, entry))
|
||||
if (!vm_dict_entry_ok(vm, entry))
|
||||
{
|
||||
vm->error = 1;
|
||||
log_message(LOG_ERROR, "ENTROPY!: invalid dictionary entry address %p (not in dictionary)", (void*)entry);
|
||||
|
||||
@@ -569,7 +569,7 @@ static void system_word_execute(VM *vm) {
|
||||
if (vm->dsp < 0) { vm->error = 1; return; }
|
||||
cell_t xt = vm_pop(vm);
|
||||
DictEntry *entry = (DictEntry *)(uintptr_t)xt;
|
||||
if (!entry || !entry->func) { vm->error = 1; return; }
|
||||
if (!vm_dict_entry_ok(vm, entry) || !entry->func) { vm->error = 1; return; }
|
||||
vm->current_executing_entry = entry;
|
||||
entry->func(vm);
|
||||
}
|
||||
|
||||
@@ -91,19 +91,13 @@ static size_t vocab_safe_len(const char *text, size_t max_len)
|
||||
}
|
||||
|
||||
|
||||
/* ---- first-character index for vocab chains (lazy rebuild) ---- */
|
||||
#define SF_FC_BUCKETS 256
|
||||
|
||||
static DictEntry **ctx_fc[SF_FC_BUCKETS]; /* arrays of entry pointers */
|
||||
static size_t ctx_n[SF_FC_BUCKETS];
|
||||
static DictEntry *ctx_cached_head = NULL;
|
||||
|
||||
static DictEntry **forth_fc[SF_FC_BUCKETS];
|
||||
static size_t forth_n[SF_FC_BUCKETS];
|
||||
static DictEntry *forth_cached_head = NULL;
|
||||
/* ---- first-character index for vocab chains (lazy rebuild) ----
|
||||
* Bucket arrays themselves live per-VM (VM.vocab.ctx_fc / .forth_fc,
|
||||
* declared in include/vm.h as VocabularyState); these two helpers just
|
||||
* operate on whichever VM's arrays are passed in. */
|
||||
|
||||
static void fc_free(DictEntry ***lists, size_t *counts) {
|
||||
for (size_t i = 0; i < SF_FC_BUCKETS; ++i) {
|
||||
for (size_t i = 0; i < VOCAB_FC_BUCKETS; ++i) {
|
||||
free(lists[i]);
|
||||
lists[i] = NULL;
|
||||
counts[i] = 0;
|
||||
@@ -119,14 +113,14 @@ static void fc_rebuild(DictEntry *head, DictEntry ***lists, size_t *counts, Dict
|
||||
counts[c]++;
|
||||
}
|
||||
/* alloc */
|
||||
for (size_t i = 0; i < SF_FC_BUCKETS; ++i) {
|
||||
for (size_t i = 0; i < VOCAB_FC_BUCKETS; ++i) {
|
||||
if (counts[i]) {
|
||||
lists[i] = (DictEntry **) malloc(counts[i] * sizeof(DictEntry *));
|
||||
if (!lists[i]) counts[i] = 0; /* malloc failed: zero count so fill skips */
|
||||
}
|
||||
}
|
||||
/* second pass: fill oldest→newest (we’ll search newest-first by iterating backwards) */
|
||||
size_t filled[SF_FC_BUCKETS] = {0};
|
||||
size_t filled[VOCAB_FC_BUCKETS] = {0};
|
||||
for (DictEntry *e = head; e; e = e->link) {
|
||||
unsigned c = (unsigned char) e->name[0];
|
||||
if (lists[c]) lists[c][filled[c]++] = e; /* skip null buckets */
|
||||
@@ -141,21 +135,12 @@ static void fc_rebuild(DictEntry *head, DictEntry ***lists, size_t *counts, Dict
|
||||
- No ALSO/ONLY/PREVIOUS here. Period.
|
||||
*/
|
||||
|
||||
/* Host-side state */
|
||||
static DictEntry *forth_vocab = NULL; /* FORTH vocabulary head (root of system) */
|
||||
static DictEntry *context_vocab = NULL; /* CONTEXT vocabulary head */
|
||||
static DictEntry *current_vocab = NULL; /* CURRENT vocabulary head */
|
||||
|
||||
/* VM-visible variables (addresses in VM space) */
|
||||
static vaddr_t context_var_addr = 0; /* cell containing (DictEntry*) CONTEXT */
|
||||
static vaddr_t current_var_addr = 0; /* cell containing (DictEntry*) CURRENT */
|
||||
|
||||
/* Sync host state -> VM cells */
|
||||
static inline void vocab_sync_vm_vars(VM *vm) {
|
||||
if (!context_var_addr || !current_var_addr) return;
|
||||
if (!vm->vocab.context_var_addr || !vm->vocab.current_var_addr) return;
|
||||
#if defined(__STARKERNEL__) && SK_PARITY_DEBUG
|
||||
uint64_t cv = (uint64_t)(uintptr_t)context_vocab;
|
||||
uint64_t rv = (uint64_t)(uintptr_t)current_vocab;
|
||||
uint64_t cv = (uint64_t)(uintptr_t)vm->vocab.context_vocab;
|
||||
uint64_t rv = (uint64_t)(uintptr_t)vm->vocab.current_vocab;
|
||||
uint64_t base = (uintptr_t)vm->memory;
|
||||
|
||||
console_puts("[VOC_SYNC] context=");
|
||||
@@ -163,13 +148,13 @@ static inline void vocab_sync_vm_vars(VM *vm) {
|
||||
console_puts(" current=");
|
||||
vocabulary_debug_print_hex(rv);
|
||||
console_puts(" context_addr=");
|
||||
vocabulary_debug_print_hex((uint64_t)context_var_addr);
|
||||
vocabulary_debug_print_hex((uint64_t)vm->vocab.context_var_addr);
|
||||
console_puts(" current_addr=");
|
||||
vocabulary_debug_print_hex((uint64_t)current_var_addr);
|
||||
vocabulary_debug_print_hex((uint64_t)vm->vocab.current_var_addr);
|
||||
console_puts(" vm_base=");
|
||||
vocabulary_debug_print_hex(base);
|
||||
console_puts(" context_vocab=");
|
||||
vocabulary_debug_print_hex((uint64_t)(uintptr_t)context_vocab);
|
||||
vocabulary_debug_print_hex((uint64_t)(uintptr_t)vm->vocab.context_vocab);
|
||||
console_println("");
|
||||
|
||||
/* Truncation check */
|
||||
@@ -179,7 +164,7 @@ static inline void vocab_sync_vm_vars(VM *vm) {
|
||||
console_println("");
|
||||
sk_hal_panic("context pointer truncated");
|
||||
}
|
||||
|
||||
|
||||
/* Canonical check */
|
||||
if (!sf_is_canonical(cv)) {
|
||||
console_puts("PANIC: context pointer non-canonical: ");
|
||||
@@ -191,23 +176,25 @@ static inline void vocab_sync_vm_vars(VM *vm) {
|
||||
/* NOTE: DictEntry* (vocabulary pointers) live in the kernel heap, not the
|
||||
* VM arena. An arena-range check here is always wrong — omitted. */
|
||||
#endif
|
||||
vm_store_cell(vm, context_var_addr, (cell_t)(uintptr_t)context_vocab);
|
||||
vm_store_cell(vm, current_var_addr, (cell_t)(uintptr_t)current_vocab);
|
||||
vm_store_cell(vm, vm->vocab.context_var_addr, (cell_t)(uintptr_t)vm->vocab.context_vocab);
|
||||
vm_store_cell(vm, vm->vocab.current_var_addr, (cell_t)(uintptr_t)vm->vocab.current_vocab);
|
||||
}
|
||||
|
||||
/**
|
||||
* @brief Initialize the FORTH vocabulary system
|
||||
* @details Sets up FORTH as root vocabulary and allocates VM cells for CONTEXT/CURRENT
|
||||
* @details Sets up FORTH as root vocabulary and allocates VM cells for CONTEXT/CURRENT.
|
||||
* Per-VM (vm->vocab.initialized): each VM in the fleet seeds its own
|
||||
* vocabulary roots from its own dictionary, rather than every VM after
|
||||
* the first silently sharing whichever VM ran this first.
|
||||
* @param vm Pointer to VM instance
|
||||
*/
|
||||
static void init_vocabulary_system(VM *vm) {
|
||||
static int initialized = 0;
|
||||
if (initialized) return;
|
||||
if (vm->vocab.initialized) return;
|
||||
|
||||
/* Treat vm->latest as the FORTH vocabulary head */
|
||||
forth_vocab = vm->latest;
|
||||
context_vocab = forth_vocab;
|
||||
current_vocab = forth_vocab;
|
||||
vm->vocab.forth_vocab = vm->latest;
|
||||
vm->vocab.context_vocab = vm->vocab.forth_vocab;
|
||||
vm->vocab.current_vocab = vm->vocab.forth_vocab;
|
||||
|
||||
/* Allocate VM cells for CONTEXT and CURRENT */
|
||||
void *p1 = vm_allot(vm, sizeof(cell_t));
|
||||
@@ -216,7 +203,7 @@ static void init_vocabulary_system(VM *vm) {
|
||||
log_message(LOG_ERROR, "VOCAB: failed CONTEXT cell");
|
||||
return;
|
||||
}
|
||||
context_var_addr = (vaddr_t)((uint8_t *) p1 - vm->memory);
|
||||
vm->vocab.context_var_addr = (vaddr_t)((uint8_t *) p1 - vm->memory);
|
||||
|
||||
void *p2 = vm_allot(vm, sizeof(cell_t));
|
||||
if (!p2) {
|
||||
@@ -224,10 +211,10 @@ static void init_vocabulary_system(VM *vm) {
|
||||
log_message(LOG_ERROR, "VOCAB: failed CURRENT cell");
|
||||
return;
|
||||
}
|
||||
current_var_addr = (vaddr_t)((uint8_t *) p2 - vm->memory);
|
||||
vm->vocab.current_var_addr = (vaddr_t)((uint8_t *) p2 - vm->memory);
|
||||
|
||||
vocab_sync_vm_vars(vm);
|
||||
initialized = 1;
|
||||
vm->vocab.initialized = 1;
|
||||
}
|
||||
|
||||
/* Finder: search CONTEXT chain first, then FORTH chain; skip hidden/smudged */
|
||||
@@ -237,16 +224,18 @@ static DictEntry *vocab_find_word(VM *vm, const char *name, size_t len) {
|
||||
if (!name || len == 0) return NULL;
|
||||
|
||||
/* rebuild per-vocab indices if heads changed */
|
||||
if (ctx_cached_head != context_vocab) fc_rebuild(context_vocab, ctx_fc, ctx_n, &ctx_cached_head);
|
||||
if (forth_cached_head != forth_vocab) fc_rebuild(forth_vocab, forth_fc, forth_n, &forth_cached_head);
|
||||
if (vm->vocab.ctx_cached_head != vm->vocab.context_vocab)
|
||||
fc_rebuild(vm->vocab.context_vocab, vm->vocab.ctx_fc, vm->vocab.ctx_n, &vm->vocab.ctx_cached_head);
|
||||
if (vm->vocab.forth_cached_head != vm->vocab.forth_vocab)
|
||||
fc_rebuild(vm->vocab.forth_vocab, vm->vocab.forth_fc, vm->vocab.forth_n, &vm->vocab.forth_cached_head);
|
||||
|
||||
const unsigned char first = (unsigned char) name[0];
|
||||
const unsigned char last = (unsigned char) name[len - 1];
|
||||
|
||||
/* search CONTEXT bucket (newest-first) */
|
||||
{
|
||||
DictEntry **bucket = ctx_fc[first];
|
||||
size_t n = ctx_n[first];
|
||||
DictEntry **bucket = vm->vocab.ctx_fc[first];
|
||||
size_t n = vm->vocab.ctx_n[first];
|
||||
if (UNLIKELY(!bucket || n == 0)) goto skip_ctx;
|
||||
for (size_t i = n; i-- > 0;) {
|
||||
DictEntry *e = bucket[i];
|
||||
@@ -266,9 +255,9 @@ static DictEntry *vocab_find_word(VM *vm, const char *name, size_t len) {
|
||||
skip_ctx:;
|
||||
|
||||
/* then FORTH bucket (if different) */
|
||||
if (context_vocab != forth_vocab) {
|
||||
DictEntry **bucket = forth_fc[first];
|
||||
size_t n = forth_n[first];
|
||||
if (vm->vocab.context_vocab != vm->vocab.forth_vocab) {
|
||||
DictEntry **bucket = vm->vocab.forth_fc[first];
|
||||
size_t n = vm->vocab.forth_n[first];
|
||||
if (UNLIKELY(!bucket || n == 0)) goto skip_forth;
|
||||
for (size_t i = n; i-- > 0;) {
|
||||
DictEntry *e = bucket[i];
|
||||
@@ -299,7 +288,7 @@ static void vocabulary_select_runtime(VM *vm) {
|
||||
* Fall back to vm->latest only if somehow NULL. */
|
||||
DictEntry *selected = vm->current_executing_entry;
|
||||
if (!selected) selected = vm->latest;
|
||||
context_vocab = selected;
|
||||
vm->vocab.context_vocab = selected;
|
||||
vocab_sync_vm_vars(vm);
|
||||
|
||||
log_message(LOG_DEBUG, "Vocabulary selected (CONTEXT updated)");
|
||||
@@ -446,7 +435,7 @@ void vocabulary_create_vocabulary_direct(VM *vm, const char *name)
|
||||
*/
|
||||
void vocabulary_word_definitions(VM *vm) {
|
||||
init_vocabulary_system(vm);
|
||||
current_vocab = context_vocab;
|
||||
vm->vocab.current_vocab = vm->vocab.context_vocab;
|
||||
vocab_sync_vm_vars(vm);
|
||||
log_message(LOG_DEBUG, "DEFINITIONS: CURRENT := CONTEXT");
|
||||
}
|
||||
@@ -459,7 +448,7 @@ void vocabulary_word_definitions(VM *vm) {
|
||||
*/
|
||||
void vocabulary_word_context(VM *vm) {
|
||||
init_vocabulary_system(vm);
|
||||
vm_push(vm, CELL(context_var_addr));
|
||||
vm_push(vm, CELL(vm->vocab.context_var_addr));
|
||||
}
|
||||
|
||||
/* CURRENT ( -- addr ) Return VM address of CURRENT cell */
|
||||
@@ -470,7 +459,7 @@ void vocabulary_word_context(VM *vm) {
|
||||
*/
|
||||
void vocabulary_word_current(VM *vm) {
|
||||
init_vocabulary_system(vm);
|
||||
vm_push(vm, CELL(current_var_addr));
|
||||
vm_push(vm, CELL(vm->vocab.current_var_addr));
|
||||
}
|
||||
|
||||
/* FORTH ( -- ) Make FORTH the CONTEXT vocabulary (and nothing else) */
|
||||
@@ -481,7 +470,7 @@ void vocabulary_word_current(VM *vm) {
|
||||
*/
|
||||
void vocabulary_word_forth(VM *vm) {
|
||||
init_vocabulary_system(vm);
|
||||
context_vocab = forth_vocab;
|
||||
vm->vocab.context_vocab = vm->vocab.forth_vocab;
|
||||
vocab_sync_vm_vars(vm);
|
||||
log_message(LOG_DEBUG, "FORTH selected (CONTEXT := FORTH)");
|
||||
}
|
||||
@@ -537,6 +526,10 @@ void vocabulary_word_paren_find(VM *vm) {
|
||||
void vocabulary_word_order(VM *vm) {
|
||||
init_vocabulary_system(vm);
|
||||
|
||||
DictEntry *context_vocab = vm->vocab.context_vocab;
|
||||
DictEntry *forth_vocab = vm->vocab.forth_vocab;
|
||||
DictEntry *current_vocab = vm->vocab.current_vocab;
|
||||
|
||||
printf("Search order: ");
|
||||
if (context_vocab && context_vocab->name_len > 0) {
|
||||
fwrite(context_vocab->name, 1, (size_t) context_vocab->name_len, stdout);
|
||||
|
||||
Reference in New Issue
Block a user