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

Reorganize source tree: kernel/, v3/, v4/ split and board infrastructure

Browse Source 
Source tree reorganization:
- Move StarForth v3 engine to v3/ (src/, include/, Makefile)
- Move kernel to kernel/ (src/, include/, linker/, Makefile)
- Create v4/ skeleton for F18-ISA golden model (DECOMPOSITION.md, JUSTIFICATION.md)
- Move FABRIC-0..4.md to docs/fabric/
- Move ONTOLOGY.md and ROADMAP.md to docs/

Board infrastructure:
- Add boards/ser5/, boards/raspi/, boards/milkv/, boards/zynq7020/
- Each board has board.mk (ISA, CPU flags, boot recipe) and README.md
- Root Makefile becomes thin dispatcher: boot_image, all, clean, docs take TARGET
- make boot_image TARGET=SER5|RASPI|MILKV builds one GPT/MBR image per board
- ZYNQ7020 target exists but stops with clear error (ARMv7 port not built yet)
- scripts/mkdiskimage.sh builds disk images for all boards

Docs pipeline:
- docs/book/ with LaTeX master (main.tex) and Makefile
- pandoc converts Markdown to LaTeX at build time
- Two Lua filters: table-widths.lua (wide tables wrap), code-breaks.lua (inline code breaks)
- make docs builds single PDF (754 pages, 0 missing characters)
- make docs TARGET=<board> adds board appendix
- build/docs/<book|board>/meta.tex stamps git commit into PDF

Bug fixes:
- 42 include paths that only worked by accident now use correct relative paths
- clang-18 hardcode replaced with configurable CC variable (fixed aarch64 build)
- Pi 5: kernel_2712.img linked at 0x80000, .bss zeroed, memory reserved
- Doxyfile, .clang-tidy, README.md, Kconfig paths updated

Verified:
- Hosted v3 build passes 1012 tests, 0 failures
- SER5 image boots in QEMU (OVMF), POST passes, K exact (65536 = Q48_ONE)
- Milk-V image boots in QEMU (OpenSBI + U-Boot + bootefi), POST passes
- make clean TARGET=<board> removes only that board and its ISA objects
- make all builds all boards, hosted v3, and docs in one run

Co-authored-by: Junie <junie@jetbrains.com>
This commit is contained in:
rajames
2026-10-01 15:40:09 -04:00
co-authored by Junie
parent 3c709c115b
commit a8b70e88d3
630 changed files with 2646 additions and 2036 deletions
Download Patch File Download Diff File Expand all files Collapse all files
v3/Makefile
+1340
View File
File diff suppressed because it is too large Load Diff
v3/include/README.md
+54
View File
@@ -0,0 +1,54 @@
# include/
Public headers for the hosted StarForth VM (`src/`). Kernel-only headers
live under `include/starkernel/`.
**Core VM**
- `vm.h` — the `VM` struct and all core types (`DictEntry`, `DictPhysics`,
stacks, dictionary state); the central header most other files include.
- `vm_api.h` — external VM API surface.
- `vm_host.h`, `vm_debug.h`, `startup.h`, `version.h` — host integration,
debug utilities, startup sequencing, version string.
- `cli.h`, `repl.h`, `io.h`, `log.h` — CLI parsing, REPL loop, I/O, logging.
- `word_registry.h` — word registration system shared by every
`src/word_source/*.c` file.
- `compudynamics.h` — the generic compudynamics module: tuning-word/config
lookups (`cd_tuning_word()`, `cd_tuning_vm()`) consumed by `ssm_jacquard.c`.
**Memory / blocks**
- `memory_management.h`, `dictionary_management.h` — dictionary allocator
and search.
- `block_subsystem.h`, `blkcfg.h`, `blkio.h`, `blkio_factory.h` — logical→
physical block mapper and pluggable block I/O backends (file/RAM).
- `platform_alloc.h`, `platform_lock.h`, `platform_time.h` — platform
abstraction shims (hosted vs. kernel allocation/locking/timing).
**Physics-driven adaptive runtime (7 feedback loops)**
- `physics_runtime.h` — main physics coordinator.
- `physics_hotwords_cache.h` — Loop #1, execution-heat hot-words cache.
- `physics_metadata.h` — per-word `DictPhysics` metadata tracking.
- `physics_pipelining_metrics.h` — Loop #4, word-transition prediction.
- `physics_execution_hooks.h` — execution instrumentation hook points.
- `rolling_window_of_truth.h`, `rolling_window_knobs.h` — Loop #2 circular
execution-history buffer and its tuning knobs.
- `inference_engine.h` — Loops #5/#6, window-width and decay-slope
statistical inference.
- `dictionary_heat_optimization.h` — Loop #1 heat counters.
- `ssm_jacquard.h` — L8 Jacquard steady-state mode selector.
- `doe_metrics.h` — Design of Experiments (2^7 factorial) metrics.
- `profiler.h` — performance profiling hooks.
**Arithmetic / codegen**
- `q48_16.h` — Q48.16 deterministic fixed-point arithmetic (used instead of
IEEE-754 float specifically to keep cross-architecture behavior
bit-identical).
- `math_portable.h` — portable math helpers.
- `arch_detect.h`, `starforth_config.h` — architecture detection and the
build-flag fallback-default layer (used when a `.c` file is compiled by
hand without `make`).
- `vm_asm_opt.h`, `vm_asm_opt_arm64.h`, `vm_asm_opt_riscv64.h`,
`vm_inner_interp_asm.h`, `vm_inner_interp_arm64.h`,
`vm_inner_interp_riscv64.h` — per-architecture assembler-optimized inner
interpreter (`USE_ASM_OPT=1`).
See `include/starkernel/README.md` for the bare-metal kernel headers.
v3/include/arch_detect.h
+512
View File
@@ -0,0 +1,512 @@
/*
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.
*/
/**
* @file arch_detect.h
* @brief Architecture Detection and Unified API for StarForth
* @details Automatically selects x86_64 or ARM64 optimizations and provides
* a unified interface for architecture-specific optimizations.
*
* This work is released under license terms in LICENSE file.
* No warranty. Use at your own risk.
*/
#ifndef ARCH_DETECT_H
#define ARCH_DETECT_H
/**
* @defgroup arch_detect Architecture Detection
* @{
*
* @brief Automatic detection of target architecture and inclusion of optimization headers
*
* This module automatically detects the target architecture at compile time and includes
* the appropriate assembly optimization headers.
*
* Supported architectures:
* - x86_64 (AMD64, Intel 64)
* - ARM64 (AArch64, ARMv8-A)
*
* Unsupported architectures fall back to pure C implementations.
* @}
*/
/* Detect architecture at compile time */
#if defined(__x86_64__) || defined(_M_X64) || defined(__amd64__)
#define ARCH_X86_64 1
#define ARCH_ARM64 0
#define ARCH_RISCV64 0
#define ARCH_NAME "x86_64"
#elif defined(__aarch64__) || defined(_M_ARM64) || defined(__arm64__)
#define ARCH_X86_64 0
#define ARCH_ARM64 1
#define ARCH_RISCV64 0
#define ARCH_NAME "ARM64"
#elif defined(__riscv) && (__riscv_xlen == 64)
#define ARCH_X86_64 0
#define ARCH_ARM64 0
#define ARCH_RISCV64 1
#define ARCH_NAME "RISC-V 64"
#else
#define ARCH_X86_64 0
#define ARCH_ARM64 0
#define ARCH_RISCV64 0
#define ARCH_NAME "Unknown"
#warning "Unknown architecture, assembly optimizations disabled"
#endif
/* Include architecture-specific headers */
#if ARCH_X86_64 && USE_ASM_OPT
#include "vm_asm_opt.h"
#if USE_DIRECT_THREADING
#include "vm_inner_interp_asm.h"
#endif
#elif ARCH_ARM64 && USE_ASM_OPT
#include "vm_asm_opt_arm64.h"
#if USE_DIRECT_THREADING
#include "vm_inner_interp_arm64.h"
#endif
#elif ARCH_RISCV64 && USE_ASM_OPT
#include "vm_asm_opt_riscv64.h"
#if USE_DIRECT_THREADING
#include "vm_inner_interp_riscv64.h"
#endif
#endif
/**
* @defgroup unified_api Unified API Wrappers
* @{
*
* @brief Consistent API macros across all architectures
*
* These macros provide a consistent API across all architectures by automatically
* dispatching to the appropriate optimized or fallback implementation based on
* the target architecture and available optimizations.
* @}
*/
/* ========== Stack Operations ========== */
#if USE_ASM_OPT && (ARCH_X86_64 || ARCH_ARM64 || ARCH_RISCV64)
/* Use optimized assembly implementations */
#define vm_push_opt(vm, val) vm_push_asm(vm, val)
#define vm_pop_opt(vm) vm_pop_asm(vm)
#define vm_rpush_opt(vm, val) vm_rpush_asm(vm, val)
#define vm_rpop_opt(vm) vm_rpop_asm(vm)
#else
/* Fall back to standard C implementations */
#define vm_push_opt(vm, val) vm_push(vm, val)
#define vm_pop_opt(vm) vm_pop(vm)
#define vm_rpush_opt(vm, val) vm_rpush(vm, val)
#define vm_rpop_opt(vm) vm_rpop(vm)
#endif
/* ========== Arithmetic Operations ========== */
#if USE_ASM_OPT && (ARCH_X86_64 || ARCH_ARM64 || ARCH_RISCV64)
#define vm_add_overflow_opt(a, b, res) vm_add_check_overflow(a, b, res)
#define vm_sub_overflow_opt(a, b, res) vm_sub_check_overflow(a, b, res)
#define vm_mul_double_opt(a, b, hi, lo) vm_mul_double(a, b, hi, lo)
#define vm_divmod_opt(dividend, divisor, quot, rem) vm_divmod(dividend, divisor, quot, rem)
#else
/* Fallback implementations */
static inline int vm_add_overflow_opt(cell_t a, cell_t b, cell_t *res) {
*res = a + b;
/* Simple overflow check (not perfect) */
return ((a > 0 && b > 0 && *res < 0) || (a < 0 && b < 0 && *res > 0));
}
static inline int vm_sub_overflow_opt(cell_t a, cell_t b, cell_t *res) {
*res = a - b;
return ((a > 0 && b < 0 && *res < 0) || (a < 0 && b > 0 && *res > 0));
}
static inline void vm_mul_double_opt(cell_t a, cell_t b, cell_t *hi, cell_t *lo) {
/* Simplified - assumes 64-bit cell_t */
*lo = a * b;
*hi = 0; /* Would need 128-bit arithmetic for proper high word */
}
static inline void vm_divmod_opt(cell_t dividend, cell_t divisor, cell_t *quot, cell_t *rem) {
*quot = dividend / divisor;
*rem = dividend % divisor;
}
#endif
/* ========== String Operations ========== */
#if USE_ASM_OPT && (ARCH_X86_64 || ARCH_ARM64 || ARCH_RISCV64)
#define vm_strcmp_opt(s1, s2, len) vm_strcmp_asm(s1, s2, len)
#define vm_memcpy_opt(dst, src, len) vm_memcpy_asm(dst, src, len)
#define vm_memzero_opt(dst, len) vm_memzero_asm(dst, len)
#else
#include <string.h>
static inline int vm_strcmp_opt(const char *s1, const char *s2, size_t len) {
return memcmp(s1, s2, len) != 0;
}
static inline void vm_memcpy_opt(void *dst, const void *src, size_t len) {
memcpy(dst, src, len);
}
static inline void vm_memzero_opt(void *dst, size_t len) {
memset(dst, 0, len);
}
#endif
/* ========== Min/Max Operations ========== */
#if USE_ASM_OPT && (ARCH_X86_64 || ARCH_ARM64 || ARCH_RISCV64)
#define vm_min_opt(a, b) vm_min_asm(a, b)
#define vm_max_opt(a, b) vm_max_asm(a, b)
#else
static inline cell_t vm_min_opt(cell_t a, cell_t b) {
return (a < b) ? a : b;
}
static inline cell_t vm_max_opt(cell_t a, cell_t b) {
return (a > b) ? a : b;
}
#endif
/* ========== Absolute Value ========== */
#if USE_ASM_OPT && (ARCH_ARM64 || ARCH_RISCV64)
#define vm_abs_opt(a) vm_abs_asm(a)
#else
static inline cell_t vm_abs_opt(cell_t a) {
return (a < 0) ? -a : a;
}
#endif
/* ========== Bit Operations ========== */
#if USE_ASM_OPT && (ARCH_ARM64 || ARCH_RISCV64)
#define vm_clz_opt(x) vm_clz(x)
#define vm_ctz_opt(x) vm_ctz(x)
#define vm_popcnt_opt(x) vm_popcnt(x)
#elif USE_ASM_OPT && ARCH_X86_64
static inline int vm_clz_opt(cell_t x) {
return __builtin_clzll((unsigned long long) x);
}
static inline int vm_ctz_opt(cell_t x) {
return __builtin_ctzll((unsigned long long) x);
}
static inline int vm_popcnt_opt(cell_t x) {
return __builtin_popcountll((unsigned long long) x);
}
#else
/* Software fallback */
static inline int vm_clz_opt(cell_t x) {
if (x == 0) return 64;
int n = 0;
if ((x & 0xFFFFFFFF00000000ULL) == 0) {
n += 32;
x <<= 32;
}
if ((x & 0xFFFF000000000000ULL) == 0) {
n += 16;
x <<= 16;
}
if ((x & 0xFF00000000000000ULL) == 0) {
n += 8;
x <<= 8;
}
if ((x & 0xF000000000000000ULL) == 0) {
n += 4;
x <<= 4;
}
if ((x & 0xC000000000000000ULL) == 0) {
n += 2;
x <<= 2;
}
if ((x & 0x8000000000000000ULL) == 0) { n += 1; }
return n;
}
static inline int vm_ctz_opt(cell_t x) {
if (x == 0) return 64;
int n = 0;
if ((x & 0x00000000FFFFFFFFULL) == 0) {
n += 32;
x >>= 32;
}
if ((x & 0x000000000000FFFFULL) == 0) {
n += 16;
x >>= 16;
}
if ((x & 0x00000000000000FFULL) == 0) {
n += 8;
x >>= 8;
}
if ((x & 0x000000000000000FULL) == 0) {
n += 4;
x >>= 4;
}
if ((x & 0x0000000000000003ULL) == 0) {
n += 2;
x >>= 2;
}
if ((x & 0x0000000000000001ULL) == 0) { n += 1; }
return n;
}
static inline int vm_popcnt_opt(cell_t x) {
int count = 0;
while (x) {
count += x & 1;
x >>= 1;
}
return count;
}
#endif
/* ========== Cache Operations ========== */
#if USE_ASM_OPT && (ARCH_ARM64 || ARCH_RISCV64)
#define vm_prefetch_opt(addr) vm_prefetch(addr)
#define vm_prefetch_stream_opt(addr) vm_prefetch_stream(addr)
#elif USE_ASM_OPT && ARCH_X86_64
static inline void vm_prefetch_opt(const void *addr) {
__builtin_prefetch(addr, 0, 3); /* Read, high temporal locality */
}
static inline void vm_prefetch_stream_opt(const void *addr) {
__builtin_prefetch(addr, 0, 0); /* Read, no temporal locality */
}
#else
#define vm_prefetch_opt(addr) ((void)0)
#define vm_prefetch_stream_opt(addr) ((void)0)
#endif
/* ========== Inner Interpreter (Direct Threading) ========== */
#if USE_DIRECT_THREADING && ARCH_RISCV64
#define NEXT_OPT() NEXT_RV64()
#define vm_setup_registers_opt(vm) vm_setup_registers_rv64(vm)
#define vm_save_registers_opt(vm) vm_save_registers_rv64(vm)
#define PRIM_DUP_OPT() PRIM_DUP_RV64()
#define PRIM_DROP_OPT() PRIM_DROP_RV64()
#define PRIM_SWAP_OPT() PRIM_SWAP_RV64()
#define PRIM_OVER_OPT() PRIM_OVER_RV64()
#define PRIM_ROT_OPT() PRIM_ROT_RV64()
#define PRIM_PLUS_OPT() PRIM_PLUS_RV64()
#define PRIM_MINUS_OPT() PRIM_MINUS_RV64()
#define PRIM_STAR_OPT() PRIM_STAR_RV64()
#define PRIM_SLASH_OPT() PRIM_SLASH_RV64()
#define PRIM_MOD_OPT() PRIM_MOD_RV64()
#define PRIM_AND_OPT() PRIM_AND_RV64()
#define PRIM_OR_OPT() PRIM_OR_RV64()
#define PRIM_XOR_OPT() PRIM_XOR_RV64()
#define PRIM_INVERT_OPT() PRIM_INVERT_RV64()
#define PRIM_NEGATE_OPT() PRIM_NEGATE_RV64()
#define PRIM_FETCH_OPT() PRIM_FETCH_RV64()
#define PRIM_STORE_OPT() PRIM_STORE_RV64()
#define PRIM_C_FETCH_OPT() PRIM_C_FETCH_RV64()
#define PRIM_C_STORE_OPT() PRIM_C_STORE_RV64()
#define PRIM_TO_R_OPT() PRIM_TO_R_RV64()
#define PRIM_R_FROM_OPT() PRIM_R_FROM_RV64()
#define PRIM_R_FETCH_OPT() PRIM_R_FETCH_RV64()
#define PRIM_2DUP_OPT() PRIM_2DUP_RV64()
#define PRIM_2DROP_OPT() PRIM_2DROP_RV64()
#define PRIM_ZERO_EQUALS_OPT() PRIM_ZERO_EQUALS_RV64()
#define PRIM_ZERO_LESS_OPT() PRIM_ZERO_LESS_RV64()
#define PRIM_EQUALS_OPT() PRIM_EQUALS_RV64()
#define PRIM_LESS_OPT() PRIM_LESS_RV64()
#define PRIM_GREATER_OPT() PRIM_GREATER_RV64()
#define PRIM_BRANCH_OPT() PRIM_BRANCH_RV64()
#define PRIM_ZBRANCH_OPT() PRIM_ZBRANCH_RV64()
#define PRIM_EXECUTE_OPT() PRIM_EXECUTE_RV64()
#elif USE_DIRECT_THREADING && ARCH_X86_64
#define NEXT_OPT() NEXT_ASM()
#define vm_setup_registers_opt(vm) vm_setup_registers(vm)
#define vm_save_registers_opt(vm) vm_save_registers(vm)
/* Primitive word macros */
#define PRIM_DUP_OPT() PRIM_DUP()
#define PRIM_DROP_OPT() PRIM_DROP()
#define PRIM_SWAP_OPT() PRIM_SWAP()
#define PRIM_PLUS_OPT() PRIM_PLUS()
#define PRIM_MINUS_OPT() PRIM_MINUS()
#define PRIM_STAR_OPT() PRIM_STAR()
#define PRIM_FETCH_OPT() PRIM_FETCH()
#define PRIM_STORE_OPT() PRIM_STORE()
#define PRIM_TO_R_OPT() PRIM_TO_R()
#define PRIM_R_FROM_OPT() PRIM_R_FROM()
#define PRIM_R_FETCH_OPT() PRIM_R_FETCH()
#define PRIM_BRANCH_OPT() PRIM_BRANCH()
#define PRIM_ZBRANCH_OPT() PRIM_ZBRANCH()
#elif USE_DIRECT_THREADING && ARCH_ARM64
#define NEXT_OPT() NEXT_ARM64()
#define vm_setup_registers_opt(vm) vm_setup_registers_arm64(vm)
#define vm_save_registers_opt(vm) vm_save_registers_arm64(vm)
/* Primitive word macros */
#define PRIM_DUP_OPT() PRIM_DUP_ARM64()
#define PRIM_DROP_OPT() PRIM_DROP_ARM64()
#define PRIM_SWAP_OPT() PRIM_SWAP_ARM64()
#define PRIM_OVER_OPT() PRIM_OVER_ARM64()
#define PRIM_ROT_OPT() PRIM_ROT_ARM64()
#define PRIM_PLUS_OPT() PRIM_PLUS_ARM64()
#define PRIM_MINUS_OPT() PRIM_MINUS_ARM64()
#define PRIM_STAR_OPT() PRIM_STAR_ARM64()
#define PRIM_SLASH_OPT() PRIM_SLASH_ARM64()
#define PRIM_MOD_OPT() PRIM_MOD_ARM64()
#define PRIM_AND_OPT() PRIM_AND_ARM64()
#define PRIM_OR_OPT() PRIM_OR_ARM64()
#define PRIM_XOR_OPT() PRIM_XOR_ARM64()
#define PRIM_INVERT_OPT() PRIM_INVERT_ARM64()
#define PRIM_NEGATE_OPT() PRIM_NEGATE_ARM64()
#define PRIM_FETCH_OPT() PRIM_FETCH_ARM64()
#define PRIM_STORE_OPT() PRIM_STORE_ARM64()
#define PRIM_C_FETCH_OPT() PRIM_C_FETCH_ARM64()
#define PRIM_C_STORE_OPT() PRIM_C_STORE_ARM64()
#define PRIM_TO_R_OPT() PRIM_TO_R_ARM64()
#define PRIM_R_FROM_OPT() PRIM_R_FROM_ARM64()
#define PRIM_R_FETCH_OPT() PRIM_R_FETCH_ARM64()
#define PRIM_2DUP_OPT() PRIM_2DUP_ARM64()
#define PRIM_2DROP_OPT() PRIM_2DROP_ARM64()
#define PRIM_ZERO_EQUALS_OPT() PRIM_ZERO_EQUALS_ARM64()
#define PRIM_ZERO_LESS_OPT() PRIM_ZERO_LESS_ARM64()
#define PRIM_EQUALS_OPT() PRIM_EQUALS_ARM64()
#define PRIM_LESS_OPT() PRIM_LESS_ARM64()
#define PRIM_GREATER_OPT() PRIM_GREATER_ARM64()
#define PRIM_BRANCH_OPT() PRIM_BRANCH_ARM64()
#define PRIM_ZBRANCH_OPT() PRIM_ZBRANCH_ARM64()
#define PRIM_EXECUTE_OPT() PRIM_EXECUTE_ARM64()
#else
/* No direct threading - use standard C function calls */
#define NEXT_OPT() do {} while(0)
#define vm_setup_registers_opt(vm) do {} while(0)
#define vm_save_registers_opt(vm) do {} while(0)
/* Primitives fall back to function calls */
#define PRIM_DUP_OPT() do {} while(0)
#define PRIM_DROP_OPT() do {} while(0)
/* ... etc ... */
#endif
/**
* @defgroup runtime_detect Runtime Architecture Detection
* @{
*
* @brief Runtime detection of CPU features
*
* Functions for detecting available CPU features at runtime, such as SIMD
* support (SSE4.2, AVX, NEON) and other architecture-specific capabilities.
* @}
*/
#if ARCH_X86_64
/* Check for SSE4.2, AVX, etc. */
static inline int vm_has_sse42_opt(void) {
#if USE_ASM_OPT
return vm_has_sse42();
#else
return 0;
#endif
}
#elif ARCH_ARM64
/* Check for NEON, CRC32, etc. */
static inline int vm_has_neon_opt(void) {
#if USE_ASM_OPT
return vm_has_neon();
#else
return 0;
#endif
}
#else
static inline int vm_has_sse42_opt(void) { return 0; }
static inline int vm_has_neon_opt(void) { return 0; }
#endif
/**
* @defgroup build_info Build Information
* @{
*
* @brief Functions for querying build configuration
*
* Provides information about the build configuration, including target
* architecture, enabled optimizations, and threading model.
* @}
*/
static inline const char *vm_get_arch_name(void) {
return ARCH_NAME;
}
static inline int vm_has_asm_opt(void) {
#if USE_ASM_OPT
return 1;
#else
return 0;
#endif
}
static inline int vm_has_direct_threading(void) {
#if USE_DIRECT_THREADING
return 1;
#else
return 0;
#endif
}
static inline const char *vm_get_build_info(void) {
static char info[256];
snprintf(info, sizeof(info),
"Architecture: %s, ASM: %s, Direct Threading: %s",
vm_get_arch_name(),
vm_has_asm_opt() ? "enabled" : "disabled",
vm_has_direct_threading() ? "enabled" : "disabled"
);
return info;
}
#endif /* ARCH_DETECT_H */
v3/include/blkcfg.h
+144
View File
@@ -0,0 +1,144 @@
/*
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 Subsystem Configuration API
----------------------------------
Purpose:
- Provide a common, reusable configuration interface for selecting
a "block subsystem" (FILE image vs RAM) and its geometry WITHOUT
touching any real I/O or backend code.
Notes:
- No file system calls; no mmap; no blkio includes.
- Geometries are computed deterministically from inputs only.
- FILE backend: we record the path and intent; size/blocks remain 0
until a real backend attaches later.
- RAM backend: ram_mb -> size_bytes -> blocks (floor to FBS multiple).
Typical flow:
- Parse CLI flags (--disk-img=<path> | --ram-disk=<MB>).
- Call blkcfg_init_from_options().
- Use g_blkcfg elsewhere to make decisions (later you'll attach drivers).
License: See LICENSE file. No warranty.
*/
#ifndef STARFORTH_BLKCFG_H
#define STARFORTH_BLKCFG_H
#include <stdint.h>
#include <stddef.h>
#ifdef __cplusplus
extern "C" {
#endif
#ifndef BLKCFG_DEFAULT_FBS
#define BLKCFG_DEFAULT_FBS 1024u /* default Forth Block Size in bytes */
#endif
#ifndef BLKCFG_PATH_MAX
#define BLKCFG_PATH_MAX 4096
#endif
typedef enum {
BLKCFG_BACKEND_NONE = 0,
BLKCFG_BACKEND_FILE = 1,
BLKCFG_BACKEND_RAM = 2
} blkcfg_backend_t;
typedef struct {
blkcfg_backend_t backend; /* FILE or RAM (or NONE) */
uint32_t fbs; /* Forth Block Size (bytes) */
uint8_t read_only; /* 1 = intended RO, else 0 */
/* Geometry (no I/O performed to derive these) */
uint64_t size_bytes; /* For RAM: computed; FILE: 0 */
uint32_t blocks; /* For RAM: computed; FILE: 0 */
/* FILE plan (no I/O): path is recorded only */
char file_path[BLKCFG_PATH_MAX];
} blkcfg_t;
/* Global config (optional convenience) */
extern blkcfg_t g_blkcfg;
/**
* Initialize a block configuration from CLI-style options.
*
* Inputs:
* - disk_img_path: if non-NULL and non-empty => choose FILE backend
* - ram_mb: megabytes for RAM fallback (only used if no disk image)
* - fbs: forth block size (bytes). If 0 => BLKCFG_DEFAULT_FBS
* - read_only: intended read-only flag (advisory)
*
* Behavior:
* - FILE: record path, set blocks/size_bytes = 0 (unknown until attached)
* - RAM : compute size_bytes = ram_mb*MiB; blocks = size_bytes/fbs (floored)
*
* Returns:
* 0 on success; -1 on invalid args.
*/
int blkcfg_init_from_options(blkcfg_t *cfg,
const char *disk_img_path,
uint64_t ram_mb,
uint32_t fbs,
uint8_t read_only);
/**
* Format a single-line summary into 'dst' (capacity 'dst_cap' bytes).
* Example:
* "backend=FILE path=./disks/os.img fbs=1024 ro=0"
* "backend=RAM size=1024MB fbs=1024 blocks=1048576 ro=0"
*
* Returns number of bytes that would have been written (like snprintf).
*/
int blkcfg_format_summary(const blkcfg_t *cfg, char *dst, size_t dst_cap);
#ifdef __cplusplus
} /* extern "C" */
#endif
#endif /* STARFORTH_BLKCFG_H */
v3/include/blkio.h
+178
View File
@@ -0,0 +1,178 @@
/*
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.
*/
#ifndef STARFORTH_BLKIO_H
#define STARFORTH_BLKIO_H
/* -----------------------------------------------------------------------------
StarForth - Block I/O Core API
- C99, deterministic core (no hidden malloc)
- Public types / errors / thin inline wrapper
- Backends provide a vtable implementing: open, close, read, write, flush, info
License: See LICENSE file. No warranty.
----------------------------------------------------------------------------- */
#include <stdint.h>
#include <stddef.h>
#ifdef __cplusplus
extern "C" {
#endif
#ifndef BLKIO_FORTH_BLOCK_SIZE
#define BLKIO_FORTH_BLOCK_SIZE 1024u
#endif
/* Error codes (negative = error) */
enum {
BLKIO_OK = 0,
BLKIO_EINVAL = -1,
BLKIO_ENOSUP = -2,
BLKIO_EIO = -3,
BLKIO_ENOSPACE = -4,
BLKIO_ECLOSED = -5
};
/* Forward decl */
struct blkio_dev;
/* Open parameters (generic) */
typedef struct {
uint32_t forth_block_size; /* 0 => BLKIO_FORTH_BLOCK_SIZE */
uint32_t total_blocks; /* number of Forth blocks; FILE may derive when 0 */
void *opaque; /* backend-specific */
} blkio_params_t;
/* Device info */
typedef struct {
uint32_t forth_block_size;
uint32_t total_blocks;
uint32_t phys_sector_size; /* best-effort; 0 if N/A */
uint64_t phys_size_bytes; /* best-effort; 0 if N/A */
uint8_t read_only;
} blkio_info_t;
/* Backend vtable */
typedef struct {
int (*open)(struct blkio_dev *dev, const blkio_params_t *p);
int (*close)(struct blkio_dev *dev);
int (*read)(struct blkio_dev *dev, uint32_t fblock, void *dst);
int (*write)(struct blkio_dev *dev, uint32_t fblock, const void *src);
int (*flush)(struct blkio_dev *dev);
int (*info)(struct blkio_dev *dev, blkio_info_t *out);
} blkio_vtable_t;
/* Device (public) */
typedef struct blkio_dev {
const blkio_vtable_t *vt;
uint32_t forth_block_size;
uint32_t total_blocks;
void *state; /* backend private */
uint8_t is_open;
} blkio_dev_t;
/* Core wrappers */
static inline int blkio_open(blkio_dev_t *dev, const blkio_vtable_t *vt, const blkio_params_t *p) {
if (!dev || !vt || !vt->open || !vt->close || !vt->read || !vt->write || !vt->flush || !vt->info)
return BLKIO_EINVAL;
dev->vt = vt;
dev->is_open = 0u;
dev->state = 0;
dev->forth_block_size = (p && p->forth_block_size) ? p->forth_block_size : BLKIO_FORTH_BLOCK_SIZE;
if (dev->forth_block_size == 0) return BLKIO_EINVAL;
dev->total_blocks = p ? p->total_blocks : 0u;
const int rc = vt->open(dev, p);
if (rc == BLKIO_OK) dev->is_open = 1u;
return rc;
}
static inline int blkio_close(blkio_dev_t *dev) {
if (!dev || !dev->is_open) return BLKIO_ECLOSED;
const int rc = dev->vt->close(dev);
dev->is_open = 0u;
return rc;
}
static inline int blkio_read(blkio_dev_t *dev, uint32_t fblock, void *dst) {
if (!dev || !dev->is_open || !dst) return BLKIO_EINVAL;
if (fblock >= dev->total_blocks) return BLKIO_EINVAL;
return dev->vt->read(dev, fblock, dst);
}
static inline int blkio_write(blkio_dev_t *dev, uint32_t fblock, const void *src) {
if (!dev || !dev->is_open || !src) return BLKIO_EINVAL;
if (fblock >= dev->total_blocks) return BLKIO_EINVAL;
return dev->vt->write(dev, fblock, src);
}
static inline int blkio_flush(blkio_dev_t *dev) {
if (!dev || !dev->is_open) return BLKIO_ECLOSED;
return dev->vt->flush(dev);
}
static inline int blkio_info(blkio_dev_t *dev, blkio_info_t *out) {
if (!dev || !dev->is_open || !out) return BLKIO_EINVAL;
const int rc = dev->vt->info(dev, out);
if (rc == BLKIO_OK) {
if (!out->forth_block_size) out->forth_block_size = dev->forth_block_size;
if (!out->total_blocks) out->total_blocks = dev->total_blocks;
}
return rc;
}
/* Utilities */
static inline void blkio_bzero(void *p, uint32_t fbs) {
uint8_t *q = (uint8_t *) p;
for (uint32_t i = 0; i < fbs; i++) q[i] = 0;
}
#ifdef __cplusplus
} /* extern "C" */
#endif
#endif /* STARFORTH_BLKIO_H */
v3/include/blkio_factory.h
+101
View File
@@ -0,0 +1,101 @@
/*
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.
*/
#ifndef STARFORTH_BLKIO_FACTORY_H
#define STARFORTH_BLKIO_FACTORY_H
/* -----------------------------------------------------------------------------
StarForth - Block I/O Factory (Public API)
Chooses FILE backend when a disk image path is provided; otherwise RAM.
No dynamic allocation; caller supplies backend state memory.
NOTE: This header avoids referencing blkio typedefs to prevent "unknown type"
errors when include order or local headers differ. We forward-declare only the
device struct here. The implementation includes "blkio.h".
----------------------------------------------------------------------------- */
#include <stddef.h>
#include <stdint.h>
#ifdef __cplusplus
extern "C" {
#endif
/* Forward declaration; real definition is in blkio.h */
struct blkio_dev;
/**
* Open a block device using either a file-backed image (if disk_img_path is
* non-empty) or a RAM-backed buffer (fallback).
*
* Parameters:
* - dev : output device object (caller-allocated)
* - disk_img_path : path to raw image; if NULL/empty => RAM fallback
* - read_only : 1 = open read-only; 0 = read/write
* - total_blocks : FILE: 0 => derive from file size; >0 => size hint
* RAM : must match ram_blocks
* - fbs : forth block size in bytes (0 => default per blkio.h)
* - state_mem : caller-provided backend state buffer (opaque to caller)
* - state_len : size of state_mem in bytes
* - ram_base : RAM storage base pointer (RAM backend only)
* - ram_blocks : number of Forth blocks in ram_base (RAM backend only)
* - out_used_file : optional; set to 1 if FILE backend selected, else 0
*
* Returns:
* 0 on success; negative blkio error code on failure.
*/
int blkio_factory_open(struct blkio_dev *dev,
const char *disk_img_path,
uint8_t read_only,
uint32_t total_blocks,
uint32_t fbs,
void *state_mem,
size_t state_len,
uint8_t *ram_base,
uint32_t ram_blocks,
uint8_t *out_used_file);
#ifdef __cplusplus
} /* extern "C" */
#endif
#endif /* STARFORTH_BLKIO_FACTORY_H */
v3/include/block_subsystem.h
+597
View File
@@ -0,0 +1,597 @@
/*
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 Subsystem - Layer 2: Mapping & Business Logic (v2)
---------------------------------------------------------
Architecture (unified block address space):
- LBN 0..2047: FAST RAM (volatile, g.ram_base)
- LBN 2048..x: RAMDRIVE (raw RAM buffer, volatile; first attached device)
- LBN x..y: DISK IMG (virtio-blk, persistent; second attached device)
- LBN y+: USB / future devices (chained)
Each non-RAM device is attached via blk_subsys_attach_device() (formatted disk)
or blk_subsys_add_raw_device() (volatile RAM buffer). Devices are appended to
a chain; each gets a contiguous slot in the unified logical BAM (g.bam[]).
Physical BAMs (on-disk) are synced to/from their logical BAM slot at attach/flush.
blkio NOTE:
- blkio backends operate on 1 KiB units.
- One 4 KiB “devblock” == 4 consecutive 1 KiB blkio blocks.
License: See LICENSE file. No warranty.
*/
#ifndef STARFORTH_BLOCK_SUBSYSTEM_H
#define STARFORTH_BLOCK_SUBSYSTEM_H
#include <stdint.h>
#include <stddef.h>
#include "vm.h"
#include "blkio.h" /* ensure struct blkio_dev is fully visible */
#ifdef __cplusplus
extern "C" {
#endif
/* Core configuration constants */
#define BLK_FORTH_SIZE 1024u /* Forth block size */
#define BLK_RAM_BLOCKS 2080u /* Physical RAM blocks (user-visible LBN 0..2047) */
#define BLK_DISK_START 2080u /* Device-backed Forth blocks start at LBN 2080 */
#define BLK_DEVICE_SECTOR 4096u /* Physical “devblock” size (4×1 KiB blkio units) */
#define BLK_PACK_RATIO 3u /* 3× 1 KiB data per 4 KiB devblock (plus 1 KiB metadata) */
#define BLK_META_TOTAL 1024u /* Last 1 KiB in a 4 KiB devblock is metadata */
#define BLK_META_PER_BLOCK 341u /* 341×3 ~= 1023, padded to 1024 */
/* Forth-friendly reserved ranges */
#ifndef BLK_FORTH_SYS_RESERVED
#define BLK_FORTH_SYS_RESERVED 32u /* RAM physical blocks 0..31 hidden; user LBN 0 = PBN 32 */
#endif
#ifndef BLK_DISK_SYS_RESERVED
#define BLK_DISK_SYS_RESERVED 32u /* First 32 blocks of each disk reserved (byte-aligned BAM offset) */
#endif
#ifndef BLK_META_FENCE_INIT
#define BLK_META_FENCE_INIT 128u /* Starting size (4 KiB devblocks -- 512 KiB) of the
* top-of-device system-metadata fence, grows downward
* from here. */
#endif
/* =========================
* On-disk volume header v2
* =========================
* Serialized into device devblock 0 (4 KiB = 4×1 KiB blkio blocks 0..3).
* BAM lives in external devblocks [bam_start .. bam_start+bam_devblocks-1] (each 4 KiB).
* All *_devblocks indices are in 4 KiB units.
*/
typedef struct {
/* Identification & versioning */
uint32_t magic; /* 0x53544652 "STFR" */
uint32_t version; /* 2 */
/* Administrative info */
uint32_t total_volumes;
uint32_t flags;
char label[64];
/* Physical device geometry (4 KiB devblocks) */
uint64_t total_devblocks; /* count of 4 KiB devblocks (blkio_info.total_blocks / 4) */
/* BAM placement (external 1-bit bitmap region, stored in 4 KiB pages) */
uint32_t bam_start; /* usually 1 */
uint32_t bam_devblocks; /* number of 4 KiB pages used by BAM */
uint32_t devblock_base; /* first payload devblock = reloc_start + reloc_devblocks */
/* Capacity modeling (Forth 1 KiB blocks tracked/usable) */
uint64_t tracked_blocks; /* 32768 * bam_devblocks (bits per 4 KiB page) */
uint64_t total_blocks; /* min(tracked, 3 * (total_devblocks - 1 - bam_devblocks)) */
uint64_t free_blocks;
/* Allocation hints */
uint64_t first_free; /* next free Forth block (>= 1024) */
uint64_t last_allocated;
/* Reserved low ranges */
uint32_t reserved_disk_lo; /* e.g., 32 blocks reserved at 1024.. */
uint32_t reserved_ram_lo; /* e.g., 33 blocks reserved at 0..32 */
/* Timestamps (optional) */
uint64_t created_time;
uint64_t mounted_time;
/* Optional integrity (unused yet) */
uint64_t hdr_crc;
/* Relocation-exception table placement (Milestone 2h+ single-block relocation).
* Appended after hdr_crc, carved out of what was previously _pad[] -- appending
* (not inserting) preserves every earlier field's byte offset, so a pre-existing
* formatted volume's zeroed padding reads back here as reloc_devblocks=0 ("no
* reloc capacity"), gracefully, not a format-breaking change. See
* block_subsystem.c's reloc_flush_to_disk()/reloc_load_from_disk(). */
uint32_t reloc_start; /* usually bam_start + bam_devblocks */
uint32_t reloc_devblocks; /* number of 4 KiB pages used by the reloc table (0 = none) */
/* System-metadata fence (Phase 8, 2026-08-26): a reserved zone of
* whole, RAW (unpacked -- same shape as the header/BAM/reloc-table
* devblocks, not the 3-Forth-blocks-per-devblock user payload
* packing) devblocks at the TOP of the device's payload region,
* opposite end from reserved_disk_lo's bottom BAM reservation,
* growing DOWNWARD as system metadata (starting with Zuse's cert)
* needs more room. Never RAM-backed -- this field only exists on
* real disk-backed slots. Units are 4 KiB devblocks, same as
* bam_devblocks/reloc_devblocks (NOT Forth 1 KiB blocks -- corrected
* 2026-08-26, before anything depended on the original wrong unit,
* so this reads as a clean field, not a migration). Folded directly
* into compute_totals_from_B()'s payload4k calculation, so
* total_blocks/user_blocks/free_blocks all shrink correctly with no
* separate subtraction needed elsewhere. Appended after
* reloc_devblocks, carved out of what was previously _pad[] -- same
* graceful-default technique as reloc_devblocks itself: a
* pre-existing formatted volume's zeroed padding reads back here as
* meta_fence_blocks=0 ("no fence yet"), not a format-breaking
* change. See FABRIC-2.md's Phase 8 §C writeup for the full design. */
uint32_t meta_fence_blocks; /* current fence size, in 4 KiB devblocks (0 = none yet) */
/* Padding to keep header ≤ 4096 bytes */
uint8_t _pad[4096 - (
4 + 4 + /* magic, version */
4 + 4 + 64 + /* total_volumes, flags, label */
4 + /* compiler alignment gap before total_devblocks'
* uint64_t sibling tracked_blocks -- verified via
* offsetof(), not hand-derived (2026-08-26: this
* exact formula was off by 4 bytes from trusting
* arithmetic alone before this fix) */
8 + /* total_devblocks */
4 + 4 + 4 + /* bam_start, bam_devblocks, devblock_base */
8 + 8 + 8 + /* tracked_blocks, total_blocks, free_blocks */
8 + 8 + /* first_free, last_allocated */
4 + 4 + /* reserved ranges */
8 + 8 + /* timestamps */
8 + /* hdr_crc */
4 + 4 + /* reloc_start, reloc_devblocks */
4 /* meta_fence_blocks */
)];
} blk_volume_meta_t;
/* Same discipline homeblocks_sig.h's own header-size check uses: the pad
* math above is meant to keep this struct at exactly one 4 KiB devblock,
* verified at compile time rather than trusted by inspection -- adding
* meta_fence_blocks is exactly the kind of edit that could silently
* throw this off by a few bytes. */
_Static_assert(sizeof(blk_volume_meta_t) == 4096,
"blk_volume_meta_t must be exactly one 4 KiB devblock");
/* blk_meta_t.flags bit values -- FABRIC-2.md §F.4/§H.6/§H.12 step 13,
* decided 2026-09-02/03. Orthogonal bits, not a mutually-exclusive enum:
* a block can be both CLAIMED and MIGRATING at once. Grounded in the only
* states §F.4 actually motivated by a real need (MIGSM/UNCLEAN, two
* then-currently-blocked graph nodes) plus CLAIMED/STALE, the names
* already used loosely in that pass's own prose. 61 bits remain reserved. */
#define BLK_FLAG_CLAIMED (1ull << 0) /* owned, per BMAPFMT's owner_fp */
#define BLK_FLAG_MIGRATING (1ull << 1) /* mid-migration; serves MIGSM */
#define BLK_FLAG_STALE (1ull << 2) /* interrupted flush; serves UNCLEAN */
/* Per-1 KiB block metadata (packed into top 1 KiB region of each 4 KiB sector). */
typedef struct {
/* Core integrity (16 bytes) */
uint64_t checksum; /* CRC64 of block data */
uint64_t magic; /* 0x424C4B5F5354524BULL "BLK_STRK" */
/* Timestamps (16 bytes) */
uint64_t created_time; /* Unix timestamp (creation) */
uint64_t modified_time; /* Unix timestamp (last write) */
/* Block status (16 bytes) */
uint64_t flags; /* Status flags -- BLK_FLAG_* bits above */
uint64_t write_count; /* Number of writes (wear leveling) */
/* Content identification (32 bytes) */
uint64_t content_type; /* 0=empty, 1=source, 2=data, ... */
uint64_t encoding; /* 0=ASCII, 1=UTF-8, 2=binary, ... */
uint64_t content_length; /* Actual data length (≤ 1024) */
uint64_t reserved1; /* Alignment/future use */
/* Cryptographic (64 bytes) */
uint64_t entropy[4]; /* 256-bit entropy/random seed */
uint64_t hash[4]; /* SHA-256 (optional) */
/* Security & ownership -- FABRIC-2.md §F.4/§H.6/§H.12 step 12, decided
* 2026-08-27/2026-09-03: BMAPFMT repurposes this slot rather than
* building a separate on-drive block-map table (distributed
* ownership/ACL, travels with the block itself). Replaces the old
* owner_id/permissions/acl_block/signature[2] fields, which predated
* and directly conflicted with both the anti-POSIX principle and
* VMIdentity's pubkey-based model. Not the same 40-byte budget the
* old fields occupied -- natural alignment padding (uint32_t acl_ttl
* and uint64_t reserved_future each force a few bytes of compiler-
* inserted padding after the preceding uint8_t fields) makes this
* section's real footprint smaller; verified below via
* _Static_assert on the whole struct's actual sizeof(), not trusted
* by hand (see the blk_volume_meta_t padding-bug lesson this project
* already learned once). */
uint8_t owner_fp[8]; /* truncated fingerprint of owner's VMIdentity
* pubkey -- cheap per-block; full pubkey
* resolves via the drive's own identity
* record. */
uint8_t acl_allow; /* cached fast-deny bit, checked first --
* vm.c:611-624's exact pattern, applied to a
* block instead of a word. */
uint32_t acl_ttl; /* countdown, same shape as DictEntry's
* acl_ttl -- blocks support temporary
* elevation too, same ACL-TTL-reuse
* mechanism and Zuse-eligibility-list gating
* as the word card (§H.5). */
uint8_t acl_reserved[3]; /* still genuinely undecided -- deliberate
* slack per "flexibility until we understand
* the recipe," not a placeholder to fill
* reflexively. */
uint64_t reserved_future; /* untouched budget, same reasoning. */
/* Link/chain support (32 bytes) */
uint64_t prev_block; /* Previous in chain (0=none) */
uint64_t next_block; /* Next in chain (0=none) */
uint64_t parent_block; /* Parent/index (0=none) */
uint64_t chain_length; /* Total blocks in chain */
/* Application-specific (120 bytes) */
uint64_t app_data[15]; /* 15×64-bit app-defined fields */
uint8_t padding[5]; /* trailing slack, unrelated to any exact size target --
* the old "341-byte slice" comment here was already
* inaccurate before FABRIC-2.md §H.12 step 12's edit
* (sizeof(blk_meta_t) was 344, not 341, due to
* ordinary trailing struct-alignment padding after
* this array -- harmless since BLK_META_PER_BLOCK,
* the only thing that constant would matter to, has
* zero callers anywhere in this codebase). Verify
* this struct's real size with the _Static_assert
* below, not by re-deriving it from this comment. */
} blk_meta_t;
/* Verified via offsetof()/sizeof(), not trusted by hand -- see the
* blk_volume_meta_t padding-bug lesson this project already learned once
* (a hand-summed struct padding formula hid a real 4-byte alignment gap).
* 336, not the BLK_META_PER_BLOCK/"341-byte slice" figure this struct's
* own comments have long claimed -- that mismatch predates this assert and
* is harmless today (see padding[5]'s own comment above), but this assert
* now makes any future drift in either direction fail the build instead of
* silently mismatching a constant nothing currently checks against it. */
_Static_assert(sizeof(blk_meta_t) == 336,
"blk_meta_t size changed -- update this assert and check BLK_META_PER_BLOCK");
/* Error codes */
enum {
BLK_OK = 0,
BLK_EINVAL = -1,
BLK_ERANGE = -2,
BLK_EIO = -3,
BLK_ENODEV = -4,
BLK_ERESERVED = -5,
BLK_EDIRTY = -6,
BLK_ENOMEM = -7,
BLK_ENOSPC = -8 /* not enough free devblocks -- blk_firsttouch_claim() */
};
/* Per-block BAM entry — one per user block in each device slot */
typedef struct {
uint8_t allocated; /* 0=free, 1=in use */
uint8_t dirty; /* 1=UPDATE called; content needs flush */
} blk_bam_entry_t;
/* Low-level disk container format state. This is distinct from — and known
* nothing about — any higher-level content classification (e.g. Artemis's
* own BLANK/LithosAnanke/Unrecognized marker check). A slot stays
* PROVISIONAL, and all writes to it are refused, until its owner explicitly
* calls blk_subsys_confirm_format() after deciding the disk is safe to
* touch. This is what makes "halt, disk preserved" actually true instead
* of being overwritten by this layer's own opportunistic reformat before
* the owner ever gets a look. */
enum { BLK_FMT_FORMATTED = 0, BLK_FMT_PROVISIONAL = 1 };
/* ===== Public API ===== */
int blk_subsys_init(VM *vm, uint8_t *ram_base, size_t ram_size);
int blk_subsys_attach_device(struct blkio_dev *dev);
/* Milestone 2h hot-detach. Refuses (BLK_EINVAL) unless dev's slot is the
* current chain tail -- see this function's own doc comment in
* block_subsystem.c for why. Discards any dirty cache/BAM/vol_meta state
* rather than attempting to flush it (the device is already physically
* gone by the time this is called). Returns BLK_ENODEV if dev isn't
* attached, BLK_EINVAL if dev is NULL or not the chain tail.
*/
int blk_subsys_detach_device(struct blkio_dev *dev);
/* Monotonic counter, bumped on every attach/detach (Milestone 2h). A raw
* pointer comparison against a blk_get_buffer() result cannot reliably
* detect a same-address device swap (this kernel's own first-fit kmalloc,
* src/starkernel/memory/kmalloc.c, can hand back the exact address just
* free()'d by a detach to the very next attach's calloc() -- confirmed
* live) -- callers that cache a blk_get_buffer() result across calls
* (block_words.c's VM block window) must instead compare this epoch
* against the value they last observed, invalidating their whole cache on
* any change rather than trusting a stored pointer's identity.
*/
uint64_t blk_subsys_epoch(void);
/* Single-block relocation. Copies home_lbn's current content to target_lbn
* (both must already be valid LBNs -- target_lbn is expected to be a block
* the caller's own identity already owns, on whichever device it's being
* relocated to; this function does not itself validate ownership, that's
* policy, left to the caller -- see this session's ACL-owns-policy
* direction in FABRIC-1.md), frees home_lbn's original BAM entry, records
* an LBN->LBN redirect so every future access to home_lbn transparently
* resolves to target_lbn instead, and bumps blk_subsys_epoch() so any VM's
* cached block window correctly invalidates. Persisted immediately to the
* relocation-owner device's on-disk table (see block_subsystem.c's
* reloc_flush_to_disk()) if one exists.
*
* Returns BLK_OK on success.
* Returns BLK_EINVAL if home_lbn == target_lbn, or home_lbn is already
* relocated (call again with a different target to re-relocate --
* not supported by simply calling this twice on the same home_lbn).
* Returns BLK_ERANGE if either LBN doesn't resolve to a valid device.
* Returns BLK_EIO if the content copy fails (e.g. target device refuses
* the write -- a read-only backend like blkio_usb.c today).
* Returns BLK_ENOMEM if the in-memory relocation table is full.
*/
int blk_subsys_relocate_block(uint32_t home_lbn, uint32_t target_lbn);
/* blk_get_device_range - the LBN range (start_lbn, count of 1 KiB FORTH
* blocks) a specific already-attached device occupies (FABRIC-2.md §I.2,
* 2026-09-04). Mirrors blk_subsys_detach_device()'s own dev-pointer slot
* lookup, exposed publicly for the first time -- needed so a caller can
* scope a scan/query to exactly one attached device rather than the
* global, multi-device LBN space blk_get_total_blocks()/blk_get_meta()
* otherwise address. Returns BLK_ENODEV if dev isn't attached.
*/
int blk_get_device_range(struct blkio_dev *dev, uint32_t *out_start_lbn, uint32_t *out_count);
/* blk_lbn_device_handle - the missing direction from blk_get_device_range()
* above (that goes device -> LBN range; this goes LBN -> device). Returns
* an opaque, stable handle -- directly comparable with == to test "do
* these two LBNs belong to the same physical device" -- or NULL if lbn
* doesn't resolve to any attached device. Never dereference the returned
* pointer; it exists only for equality comparison (Phase 8 v3, 2026-09-23:
* added so MOVE/CMOVE/CMOVE> can refuse a same-VM, cross-device raw block
* copy through the block-window mechanism -- see those words' own callers
* in memory_words.c/string_words.c).
*/
const void *blk_lbn_device_handle(uint32_t lbn);
/* blk_get_device_free_blocks - free vs. total 1 KiB FORTH-block count for
* a specific already-attached device (same slot lookup as
* blk_get_device_range()). RAM-backed slots (no on-disk vol_meta) report
* out_total == out_free == 0, matching blk_mark_allocated()/_free()'s own
* "!slot->raw_base" gate on touching free_blocks bookkeeping at all.
* Returns BLK_ENODEV if dev isn't attached.
*/
int blk_get_device_free_blocks(struct blkio_dev *dev, uint64_t *out_free, uint64_t *out_total);
/* blk_get_first_disk_range - the LBN range of first_disk_slot(), i.e.
* whichever disk-backed device blk_get_volume_meta()/blk_meta_zone_read()
* already implicitly target -- Artemis's own disk.img in practice, since
* it attaches at boot before any USB hotplug (the same boot-order
* convention those two functions already rely on, not a new assumption).
* FIRSTTOUCH (below) scans exactly this range, not the global LBN space.
* Returns BLK_ENODEV if no disk-backed device is attached at all.
*/
int blk_get_first_disk_range(uint32_t *out_start_lbn, uint32_t *out_count);
/* blk_firsttouch_claim - FABRIC-2.md §F.11, decisions 1-3, built exactly
* as scoped 2026-08-27 (re-verified against current blk_meta_t 2026-09-04
* before building -- the chain fields below are real and untouched by
* BMAPFMT's unrelated owner_fp/acl_allow/acl_ttl/flags field addition).
*
* One linear scan over blk_get_first_disk_range()'s devblocks (4 KiB
* granularity -- one blk_meta_t per devblock, not per 1 KiB FORTH block),
* via blk_get_meta(). Answers both questions the scan needs in the same
* pass: does owner_fp already own a claim (not reused by this call --
* every call makes a *new* claim of exactly `count` additional devblocks,
* per §F.11's own text; an existing claim is a separate, not-yet-decided
* question), and which devblocks are free (owner_fp all-zero, BLK_FLAG_
* CLAIMED clear). A claim is a scattered chain, not a required contiguous
* run -- links devblocks via blk_meta_t's prev_block/next_block/
* chain_length fields; owner_fp is stamped onto *every* member devblock,
* not just the head, so ownership reads locally from any member without
* walking the chain. Fails outright (BLK_ENOSPC), no partial claim, if
* fewer than `count` free devblocks exist.
*
* @param owner_fp 8-byte fingerprint (this session's convention: the
* first 8 bytes of the claiming identity's 32-byte
* VMIdentity.owner_pubkey -- owner_fp had no real
* producer anywhere in this codebase before this,
* only accessors, so this call site sets the
* convention rather than following one).
* @param count Devblocks to claim (whole devblocks, §F.4 decision
* 4, already inherited, not revisited here).
* @param out_chain_head The claim's identity to the caller: its
* chain-head devblock number (a 1 KiB FORTH-block
* LBN, the representative/first sub-block of that
* devblock -- not a separate devblock-index
* namespace; blk_get_meta()/blk_set_meta() already
* resolve any LBN within a devblock to the same
* shared blk_meta_t, so this is a valid handle for
* blk_meta_relocate_devblock() below).
* @return BLK_OK, BLK_ENODEV (no disk-backed device), BLK_EINVAL (NULL
* arg or count == 0), or BLK_ENOSPC (not enough free devblocks).
*/
int blk_firsttouch_claim(const uint8_t owner_fp[8], uint32_t count, uint32_t *out_chain_head);
/* blk_owner_has_claim - FABRIC-2.md §I.2's own "an existing claim is a
* separate, not-yet-decided question" (see blk_firsttouch_claim()'s doc
* comment above), decided 2026-09-05 for the overflow-trigger call site
* (capsule_wirebind.c): answered by a disk scan, not a RAM flag, matching
* BMAPFMT's own "ownership travels with the block, no centralized table"
* model -- the answer survives a reboot/reattach for free, the same way
* blk_firsttouch_claim()'s own free/claimed scan already does.
*
* One linear scan over blk_get_first_disk_range()'s representative LBNs
* (same shape as blk_firsttouch_claim()'s own scan); returns as soon as
* any devblock's blk_meta_t has BLK_FLAG_CLAIMED set and owner_fp equal
* to the argument.
*
* @param owner_fp 8-byte fingerprint, same convention as
* blk_firsttouch_claim()'s own owner_fp argument.
* @return 1 if owner_fp already owns at least one claimed devblock, 0 if
* not (including "no disk-backed device attached" -- nothing to
* own in that case).
*/
int blk_owner_has_claim(const uint8_t owner_fp[8]);
/* blk_meta_relocate_devblock - the real migration primitive (FABRIC-2.md
* §I.2, migration state machine, 2026-09-04): moves one devblock's full
* content and blk_meta_t ownership from home_devblock to target_devblock.
* BLK_FLAG_MIGRATING is set on home_devblock for the duration -- the
* state machine genuinely is just this one flag's two states (clear =
* STABLE, set = MIGRATING), matching what BLK_FLAG_MIGRATING was already
* reserved for.
*
* Devblock granularity (4 KiB) holds BLK_PACK_RATIO (3, not 4 -- the 4th
* 1 KiB slice is the packed blk_meta_t metadata region) FORTH blocks
* (1 KiB each); the actual content copy runs blk_subsys_relocate_block()
* BLK_PACK_RATIO times, once per FORTH-block offset within the devblock
* -- that function is the only existing content-relocation primitive,
* and it operates at FORTH-block granularity, not devblock granularity,
* so this function is the bridge between the two. On success, transfers
* owner_fp/acl_allow/acl_ttl from home's blk_meta_t to target's, clears
* home's (freed, BLK_FLAG_CLAIMED unset), and sets BLK_FLAG_CLAIMED on
* target.
*
* NOT atomic across all BLK_PACK_RATIO FORTH-block copies -- a mid-loop
* failure (e.g. blk_subsys_relocate_block()'s own reloc-table
* exhaustion) leaves however many already succeeded in place, redirected, with
* BLK_FLAG_MIGRATING still set on home_devblock and blk_meta_t ownership
* NOT yet transferred. This is a known, documented limitation, not
* silently accepted: true all-or-nothing atomicity across BLK_PACK_RATIO
* separate relocation-table entries would need its own transaction log, out of
* scope for this pass. A caller that hits a non-BLK_OK return should
* treat home_devblock as still MIGRATING and not yet safe to reclaim.
*
* @return BLK_OK, BLK_EINVAL (home == target, or invalid devblock), or
* whichever blk_subsys_relocate_block() error stopped the loop.
*/
int blk_meta_relocate_devblock(uint32_t home_devblock, uint32_t target_devblock);
/* blk_migration_idle_check - heat/wear-leveling migration trigger, meant
* to be called once per idle tick (FABRIC-2.md §I.2, 2026-09-04). See
* block_subsystem.c's own doc comment for the full scan/threshold
* description and what's deliberately left open (overflow-triggered
* migration). */
void blk_migration_idle_check(void);
int blk_subsys_shutdown(void);
uint8_t *blk_get_buffer(uint32_t block_num, int writable);
uint8_t *blk_get_empty_buffer(uint32_t block_num);
int blk_flush(uint32_t block_num);
int blk_update(uint32_t block_num);
int blk_get_volume_meta(blk_volume_meta_t *meta);
int blk_set_volume_meta(const blk_volume_meta_t *meta);
/* Top-of-device system-metadata fence I/O (Phase 8, 2026-08-26) -- raw,
* unpacked 4 KiB devblocks, no FORTH word wraps either. See
* block_subsystem.c's own doc comment on these two functions for the
* full addressing/refusal rules. buf must point to exactly 4096 bytes.
* Returns BLK_OK, BLK_ENODEV (no disk-backed device attached),
* BLK_EINVAL (devblock_from_top >= the on-disk fence size, or NULL buf),
* or BLK_EIO (underlying blkio read/write failed). */
int blk_meta_zone_read(uint32_t devblock_from_top, uint8_t buf[4096]);
int blk_meta_zone_write(uint32_t devblock_from_top, const uint8_t buf[4096]);
/* CRC-64/ISO (poly 0x42F0E1EBA9EA3693), reflected, init/final all-ones --
* exposed for homeblocks_sig.c's drive-signature integrity check, which
* needs the exact same algorithm this file already uses for per-block
* checksums rather than a second, duplicate CRC implementation. */
uint64_t compute_crc64(const uint8_t *data, size_t len);
int blk_is_valid(uint32_t block_num);
uint32_t blk_get_total_blocks(void);
int blk_get_meta(uint32_t block_num, blk_meta_t *meta);
int blk_set_meta(uint32_t block_num, const blk_meta_t *meta);
/* BMAPFMT field accessors -- FABRIC-2.md §F.4/§H.6/§H.12 step 14. Thin
* read-modify-write wrappers over blk_get_meta()/blk_set_meta() (which
* already own the caching/dirty-tracking), one per new blk_meta_t field.
* FORTH wrappers (BLK-ACL-ALLOW@/! etc., §H.12 step 15) call these, not
* blk_get_meta()/blk_set_meta() directly -- same C-primitive/FORTH-policy
* split as the existing word-level ACL system. */
int blk_owner_fp_get(uint32_t block_num, uint8_t out_fp[8]);
int blk_owner_fp_set(uint32_t block_num, const uint8_t fp[8]);
int blk_acl_allow_get(uint32_t block_num, uint8_t *out_allow);
int blk_acl_allow_set(uint32_t block_num, uint8_t allow);
int blk_acl_ttl_get(uint32_t block_num, uint32_t *out_ttl);
int blk_acl_ttl_set(uint32_t block_num, uint32_t ttl);
int blk_flags_get(uint32_t block_num, uint64_t *out_flags);
int blk_flags_set(uint32_t block_num, uint64_t flags);
int blk_is_allocated(uint32_t block_num);
int blk_mark_allocated(uint32_t block_num);
int blk_mark_free(uint32_t block_num);
int blk_allocate(uint32_t * block_num);
int blk_subsys_add_raw_device(uint8_t *buf, uint32_t nblocks);
/* Commit the low-level format (write header + BAM) for the disk slot that
* owns lbn. No-op (returns BLK_OK) if already FORMATTED. Must be called
* by the disk's owner before any write to that slot will succeed. */
int blk_subsys_confirm_format(uint32_t lbn);
#ifdef __cplusplus
} /* extern "C" */
#endif
#endif /* STARFORTH_BLOCK_SUBSYSTEM_H */
v3/include/cli.h
+107
View File
@@ -0,0 +1,107 @@
/*
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.
*/
#ifndef STARFORTH_CLI_H
#define STARFORTH_CLI_H
#include <stdint.h>
#include "log.h"
/**
* @brief Heartbeat logging modes for DoE experiments
*/
typedef enum {
HEARTBEAT_LOG_OFF = 0, /* No heartbeat output, only final summary */
HEARTBEAT_LOG_SUMMARY = 1, /* Bucket aggregates every N ticks */
HEARTBEAT_LOG_FULL = 2 /* Per-tick CSV output to hb/run-<id>.csv */
} HeartbeatLogMode;
/**
* @brief Configuration structure from command-line arguments
* Consolidates all parsed CLI options into a single, cleanly organized struct
*/
typedef struct
{
/* Test modes */
int run_tests;
int break_me;
int fail_fast;
/* Benchmark mode */
int benchmark;
int benchmark_iterations;
/* Design of Experiments mode */
int doe_experiment; /* 1 if --doe-experiment flag set, run harness once and collect metrics */
HeartbeatLogMode heartbeat_log_mode; /* off|summary|full for DoE time-series data */
/* REPL mode */
int script_mode; /* -s: silent/script mode (no prompts, no "ok" output) */
/* Logging */
LogLevel log_level;
int log_level_explicitly_set;
/* Block I/O */
const char* disk_img_path;
uint32_t ram_disk_mb;
/* Legacy flags (internal use) */
int run_tests_flag_observed;
} CLIConfig;
/**
* @brief Parse command-line arguments into CLIConfig
*
* @param argc Argument count
* @param argv Argument vector
* @return CLIConfig struct with parsed options, or exits on --version/--help
*/
CLIConfig cli_parse(int argc, char* argv[]);
/**
* @brief Print usage/help information
* @param program_name Name of the executable
*/
void cli_print_usage(const char* program_name);
#endif /* STARFORTH_CLI_H */
v3/include/compudynamics.h
+240
View File
@@ -0,0 +1,240 @@
/*
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.
*/
#ifndef COMPUDYNAMICS_H
#define COMPUDYNAMICS_H
#include <stdint.h>
/* ============================================================================
* Compudynamics: Generic Entity-Agnostic Physics Engine
* ============================================================================
*
* Four operational levels observe and adapt to their own execution history:
* - words (dictionary entries, driven by ssm_jacquard.c) -- LIVE
* - VMs (Tripod fleet, driven by capsule_vm_physics.c) -- reserved
* - blocks (Artemis block storage) -- reserved
* - messages (Hermes event routing) -- reserved
*
* This module provides the entity-agnostic machinery shared by all four:
* a deterministic regime classifier over an entity-ID touch history, and a
* generic UCB1 bandit over a caller-sized config space. "Entity-ID" means
* whatever the level touches -- word_id for words, vm_id for VMs, block
* LBN for blocks, message type for messages.
*
* Determinism is the entire point of this module. Every input is an
* execution count or an entity-ID sequence -- never a wall-clock timestamp,
* never a duration. Two architectures executing the same instruction
* sequence at different real speeds (e.g. QEMU/TCG amd64 vs aarch64) must
* produce byte-identical classifier output. This was violated once
* (ssm_jacquard.c's temporal_decay input, derived from a wall-clock-tainted
* decay slope) and broke cross-architecture dict_hash parity; this module
* exists so that mistake has nowhere to hide the second time.
*
* Word-level and VM-level are the only two levels with real, instantiated
* CDTuning constants today (CD_TUNING_WORD, CD_TUNING_VM). Only word-level
* is actually wired through this module (ssm_jacquard.c); VM-level's own
* fleet mechanism (capsule_vm_physics.c, VMFleetWindow) is a separate,
* already-validated, already-accepted design that legitimately depends on
* real elapsed time for its rate-recovery math (fleet_transfer_slope_q48)
* and is out of scope here. CD_TUNING_VM documents what this module's
* classifier-side parameters would be if VM-level regime classification
* were ever migrated onto it; its bandit-side fields are zeroed and
* unused because VM level has no config-space bandit today. Block and
* message levels have no Artemis/Hermes compudynamics implementation yet
* -- CD_TUNING_BLOCK and CD_TUNING_MESSAGE are deliberately not defined
* here rather than filled with invented numbers.
* ============================================================================
*/
/* Hard cap on how many recent entity-ID touches cd_classify_ids() will look
* at. Callers pass a shorter slice via count; this cap bounds the classifier's
* O(depth^2) worst case and the stack scratch space it uses internally. */
#define CD_MAX_CLASSIFY_DEPTH 64u
/* ============================================================================
* Deterministic Regime Classification
* ============================================================================
*/
typedef struct {
uint32_t diversity_q16; /* distinct IDs in window / window size, Q16 [0,65536] */
uint32_t volatility_q16; /* dispersion (coefficient of variation) of per-ID
* touch counts within the window, Q16, unclamped
* above 65536 is possible and meaningful (high CV) */
uint32_t locality_q16; /* fraction of touches that repeat an ID seen within
* the preceding locality_lookback touches, Q16 [0,65536] */
} CDRegimeMetrics;
/**
* @brief Classify a recent entity-ID touch sequence into diversity/volatility/
* locality, purely from execution counts -- no wall-clock input anywhere.
*
* @param ids Recent entity IDs, oldest first, chronological order
* @param count Number of valid entries in ids (clamped internally
* to CD_MAX_CLASSIFY_DEPTH)
* @param locality_lookback How many preceding touches count as "recent" for
* the locality measure (clamped to count)
* @return Classified regime metrics; all-zero if count == 0
*/
CDRegimeMetrics cd_classify_ids(const uint32_t *ids, uint32_t count,
uint32_t locality_lookback);
/* ============================================================================
* Per-Level Tuning Knobs
* ============================================================================
*/
typedef struct {
/* --- Classifier knobs (used by cd_classify_ids callers) --- */
uint32_t id_window_depth; /* touches to classify over, <= CD_MAX_CLASSIFY_DEPTH */
uint32_t locality_lookback; /* recurrence lookback within id_window_depth */
uint32_t diversity_high_threshold_q16;
uint32_t volatility_high_threshold_q16;
uint32_t locality_high_threshold_q16;
/* --- Bandit knobs (used by cd_config_table_*); 0 where the level has
* no config-space bandit (e.g. VM level today -- see file header) --- */
uint32_t num_configs; /* size of the config space, e.g. 128 */
uint32_t num_regimes; /* size of the regime space, e.g. 8 */
uint32_t score_max;
uint32_t score_min;
uint32_t score_decay_factor_q16; /* per-tick exponential decay of benefit_score */
uint32_t ucb_k; /* UCB1 exploration coefficient */
uint32_t reward_gain; /* max per-tick score delta magnitude */
uint32_t joint_weight_q16; /* weight of window/locality joint-convergence
* signal in the combined reward, Q16 */
uint32_t anova_weight_q16; /* weight of the caller-supplied stability
* signal (e.g. ANOVA early-exit) in the
* combined reward, Q16 */
} CDTuning;
/* Tuning knobs are returned by value, not exposed as addressable globals.
* This freestanding kernel's boot-time loader does not reliably relocate
* the address of an extern const aggregate referenced from a different
* translation unit (confirmed by direct QEMU/gdb-style fault tracing:
* &CD_TUNING_WORD-style access faulted on an unrelocated pointer, while
* cross-TU function calls -- including struct-return-by-value, which
* uses a caller-local hidden pointer, never a global's address --
* worked correctly). Every existing scalar tunable elsewhere in this
* codebase already avoids this by being a #define immediate rather than
* a referenced global; these accessors are the aggregate-typed
* equivalent of that same constraint. */
/* Word level (ssm_jacquard.c): 128 configs (7-bit L1-L7), 8 regimes
* (3-bit diversity/volatility/locality). Values match the constants
* ssm_jacquard.c/.h used before this module existed -- this is a lift,
* not a retune. */
CDTuning cd_tuning_word(void);
/* VM level (capsule_vm_physics.c): classifier-side parameters only, for a
* future migration off Hera's word-level regime proxy. Not consumed by
* any call site today -- see file header. Bandit fields are zero: VM
* level modulates a continuous multiplier (fleet_transfer_slope_q48)
* rather than selecting from a discrete config space. */
CDTuning cd_tuning_vm(void);
/* ============================================================================
* Generic UCB1 Config-Space Bandit
* ============================================================================
*
* Stratified by regime: each (regime, config) pair has its own benefit
* score and tick count, so the bandit learns "best config per regime"
* rather than one global best. One clock only: cd_config_table_tick()
* scores the currently-active config and reselects on every call -- no
* derived multi-tick batching unit exists anywhere in this mechanism.
* ============================================================================
*/
typedef struct {
uint8_t config_bits;
uint8_t has_prev; /* 1 once prev_window/prev_locality_q16 hold real data */
uint8_t _pad[2];
uint32_t benefit_score;
uint32_t tick_count;
uint32_t prev_window;
uint32_t prev_locality_q16;
} CDConfigEntry;
typedef struct {
CDConfigEntry *entries; /* num_configs entries, malloc'd */
uint32_t *regime_scores; /* num_regimes * num_configs, row-major [regime][config] */
uint32_t *regime_ticks; /* same shape as regime_scores */
uint32_t *total_regime_ticks; /* num_regimes entries */
uint32_t num_configs;
uint32_t num_regimes;
uint8_t current_config;
uint8_t current_regime;
} CDConfigTable;
/**
* @brief Allocate a config table sized for tuning->num_configs / num_regimes.
* @return 0 on success, -1 on malloc failure (table left zeroed, unusable)
*/
int cd_config_table_init(CDConfigTable *table, const CDTuning *tuning);
/**
* @brief Free all memory owned by a config table. Safe on a zeroed table.
*/
void cd_config_table_free(CDConfigTable *table);
/**
* @brief Seed every (regime, config) score with initial_scores[config], and
* set the starting active config to initial_config.
* @param initial_scores Array of tuning->num_configs initial benefit scores
*/
void cd_config_table_seed(CDConfigTable *table, const CDTuning *tuning,
const uint32_t *initial_scores, uint8_t initial_config);
/**
* @brief Score the currently-active config from this tick's outcome and
* UCB1-reselect this tick's config, for the given regime.
*
* Combined reward = joint_weight * window/locality-convergence-stability
* + anova_weight * anova_stability_q16
* Joint-convergence is skipped (falls back to ANOVA-only) on a config's
* first tick, or when use_joint_convergence is false (the caller's config
* bits don't include loops whose convergence this signal is meant to
* track -- word level's L5/L6, see ssm_jacquard.c).
*
* @param table Config table (must be initialised)
* @param tuning Tuning knobs matching this table's sizing
* @param regime Current regime index, < tuning->num_regimes
* @param anova_stability_q16 Caller-supplied stability signal, Q16 [0,65536]
* @param use_joint_convergence Whether to include the window/locality signal
* @param current_window Caller's current window-width metric
* @param current_locality_q16 Caller's current locality_q16 from cd_classify_ids
* @return The newly-selected config's config_bits
*/
uint8_t cd_config_table_tick(CDConfigTable *table, const CDTuning *tuning,
uint8_t regime, uint32_t anova_stability_q16,
int use_joint_convergence,
uint32_t current_window, uint32_t current_locality_q16);
/**
* @brief Force the table onto an externally-chosen config (as if UCB1 had
* picked it). One-tick nudge, not a hold -- see ssm_l8_force_config().
*/
void cd_config_table_force(CDConfigTable *table, uint8_t config_idx);
#endif /* COMPUDYNAMICS_H */
v3/include/dictionary_heat_optimization.h
+106
View File
@@ -0,0 +1,106 @@
/*
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 ***
dictionary_heat_optimization.h - Phase 2: Heat-Aware Dictionary Lookup
Inference-driven optimizations for dictionary lookup based on execution heat
patterns from the Rolling Window of Truth:
1. Heat percentile thresholds (25th, 50th, 75th)
2. Bucket reorganization by co-execution patterns
3. Heat-aware lookup strategy (search hot words first)
*/
#ifndef DICTIONARY_HEAT_OPTIMIZATION_H
#define DICTIONARY_HEAT_OPTIMIZATION_H
#include "vm.h"
/**
* @brief Calculate heat percentile thresholds for all words in dictionary
*
* Computes 25th, 50th, 75th percentiles of execution_heat across all
* dictionary entries. Used to partition lookup search order.
*/
void dict_update_heat_percentiles(VM *vm);
/**
* @brief Reorganize dictionary buckets by inference-driven priorities
*
* Uses rolling window co-execution patterns to reorder words within buckets.
* Hot/frequently co-executing words are placed first for faster lookup.
*/
void dict_reorganize_buckets_by_heat(VM *vm);
/**
* @brief Find word with heat-aware search strategy
*
* Instead of newest-first, searches buckets in order:
* 1. Top 25% by heat (likely hits)
* 2. Middle 50% by heat
* 3. Bottom 25% (rarely executed)
*/
DictEntry *dict_find_word_heat_aware(VM *vm, const char *name, size_t len);
/**
* @brief Periodically reoptimize dictionary based on latest heat patterns
*
* Called every ~1 second or every N executions to adapt lookup strategy
* to current workload patterns from rolling window.
*/
void dict_adaptive_optimization_pass(VM *vm);
/* Frequency-class (fc) buckets — shared between dictionary_management.c and
dictionary_heat_optimization.c. Declared here once to give LTO a single
canonical type definition and avoid -Werror=lto-type-mismatch. */
#ifndef SF_FC_BUCKETS
#define SF_FC_BUCKETS 256
#endif
extern DictEntry **sf_fc_list[SF_FC_BUCKETS];
extern size_t sf_fc_count[SF_FC_BUCKETS];
extern size_t sf_fc_cap[SF_FC_BUCKETS];
#endif /* DICTIONARY_HEAT_OPTIMIZATION_H */
v3/include/dictionary_management.h
+88
View File
@@ -0,0 +1,88 @@
/*
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.
*/
#ifndef DICTIONARY_MANAGEMENT_H
#define DICTIONARY_MANAGEMENT_H
#include "vm.h" /* For VM type and word_func_t */
/**
* @brief Initialize the Forth dictionary
*
* @param vm Pointer to the virtual machine instance
*
* Initializes all dictionary structures and prepares them for use.
* Must be called before any other dictionary operations.
*/
void dictionary_init(VM * vm);
/**
* @brief Register a new word in the dictionary
*
* @param vm Pointer to the virtual machine instance
* @param name Name of the word to register
* @param func Function pointer to the word's implementation
*
* Adds a new word to the dictionary with the specified name and implementation.
*/
void dictionary_register(VM *vm, const char *name, word_func_t func);
/**
* @brief Look up a word in the dictionary by name
*
* @param vm Pointer to the virtual machine instance
* @param name Name of the word to look up
* @return word_func_t Function pointer to the word's implementation or NULL if not found
*/
word_func_t dictionary_lookup(VM *vm, const char *name);
/**
* @brief Clear the entire dictionary
*
* @param vm Pointer to the virtual machine instance
*
* Removes all words from the dictionary and frees associated memory.
* This is an optional operation that may be used during cleanup.
*/
void dictionary_clear(VM * vm);
#endif
v3/include/doe_metrics.h
+254
View File
@@ -0,0 +1,254 @@
/*
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.
*/
/**
* @file doe_metrics.h
* @brief Design of Experiments (DoE) metrics collection API
*
* Provides C-level programmatic access to VM metrics for physics-based experiments.
* Enables efficient in-process data collection without string parsing overhead.
*
* Usage:
* struct DoeMetrics metrics = metrics_from_vm(vm);
* metrics_write_csv_row(stdout, &metrics, run_number);
*/
#ifndef DOE_METRICS_H
#define DOE_METRICS_H
#include <stdio.h>
#include <stdint.h>
#include <time.h>
#include "vm.h"
#ifdef __cplusplus
extern "C" {
#endif
/**
* @brief Complete metrics snapshot for a single DoE run
*
* Represents all 35 metrics collected per test iteration, mirroring the CSV schema.
* All values extracted directly from VM structures (no string parsing).
*/
typedef struct {
/* === Metrics === */
uint32_t total_lookups; /* Total dictionary lookups during run */
/* === Cache Statistics === */
uint64_t cache_hits; /* Cache hits (if enabled) */
double cache_hit_percent; /* Hit percentage (0-100) */
uint64_t bucket_hits; /* Bucket hits after cache miss */
double bucket_hit_percent; /* Hit percentage (0-100) */
/* === Latency Metrics === */
int64_t cache_hit_latency_ns; /* Average cache hit latency (ns) */
int64_t cache_hit_stddev_ns; /* StdDev of cache hit latency */
int64_t bucket_search_latency_ns; /* Average bucket search latency (ns) */
int64_t bucket_search_stddev_ns; /* StdDev of bucket search latency */
/* === Pipelining Metrics (Loop #4) === */
uint64_t context_predictions_total; /* Total prefetch predictions */
uint64_t context_correct; /* Successful predictions */
double context_accuracy_percent; /* Accuracy percentage (0-100) */
uint64_t cache_promotions; /* Hotwords cache promotions */
uint64_t cache_demotions; /* Hotwords cache demotions */
/* === Rolling Window Metrics (Loop #2) === */
double window_diversity_percent; /* Window pattern diversity (0-100) */
uint32_t window_final_size_bytes; /* Final rolling window size */
uint32_t rolling_window_width; /* Width of rolling window (effective/adaptive) */
uint32_t actual_window_size; /* Ring buffer fill level: min(total_executions, ROLLING_WINDOW_SIZE) */
uint64_t total_executions; /* Words recorded in window */
uint64_t window_variance_q48; /* Pattern variance (Q48.16) */
/* === Heat Dynamics (Loop #1 & #3) === */
double decay_slope; /* Decay rate slope */
uint64_t total_heat; /* Aggregate execution heat */
uint64_t hot_word_count; /* Words above heat threshold */
uint64_t stale_word_count; /* Words with decaying heat */
double stale_word_ratio; /* Stale words / total words */
double avg_word_heat; /* Average execution heat */
/* === Heartbeat & Timing (Loop #7) === */
uint64_t tick_count; /* Total heartbeat ticks elapsed */
uint64_t tick_target_ns; /* Current tick interval (adaptive) */
uint64_t inference_run_count; /* Times inference engine invoked */
uint64_t early_exit_count; /* ANOVA early-exits (variance stable) */
/* === Window & Decay Inference (Loop #5 & #6) === */
double prefetch_accuracy_percent; /* Speculative prefetch success rate (0-100) */
uint64_t prefetch_attempts; /* Total speculative prefetch attempts */
uint64_t prefetch_hits; /* Successful prefetch hits */
uint64_t window_tuning_checks; /* Number of times window was tuned */
uint32_t final_effective_window_size; /* Final window size after tuning */
/* === Performance === */
int64_t vm_workload_duration_ns_q48; /* VM workload duration (Q48.16, nanoseconds) */
uint64_t total_runtime_ms; /* Total execution time (ms) */
uint64_t words_executed; /* Total word executions */
uint64_t dictionary_lookups; /* Dictionary search operations */
uint64_t memory_allocated_bytes; /* Total memory allocated */
double speedup_vs_baseline; /* Speedup ratio vs baseline */
/* === Statistical === */
double ci_lower_95; /* 95% confidence interval lower */
double ci_upper_95; /* 95% confidence interval upper */
/* === System State Deltas === */
int64_t cpu_temp_delta_c_q48; /* CPU temp change during run (Q48.16, °C) */
int64_t cpu_freq_delta_mhz_q48; /* CPU freq change during run (Q48.16, MHz) */
/* === Tuning Knobs === */
uint32_t decay_rate_q16; /* Decay rate (Q16 fixed-point) */
uint32_t decay_min_interval_ns; /* Min decay interval (ns) */
uint32_t rolling_window_size; /* Rolling window size */
uint32_t adaptive_shrink_rate; /* Shrink rate percentage */
uint32_t heat_cache_demotion_threshold; /* Demotion threshold */
/* === Loop Enable Flags (2^7 factorial) === */
int enable_loop_1_heat_tracking; /* Loop #1: Execution heat tracking */
int enable_loop_2_rolling_window; /* Loop #2: Rolling window history */
int enable_loop_3_linear_decay; /* Loop #3: Linear decay */
int enable_loop_4_pipelining; /* Loop #4: Pipelining metrics */
int enable_loop_5_window_inference; /* Loop #5: Window width inference */
int enable_loop_6_decay_inference; /* Loop #6: Decay slope inference */
int enable_loop_7_adaptive_heartrate; /* Loop #7: Adaptive heartrate */
/* === Legacy Configuration === */
int enable_hotwords_cache; /* 1 if cache enabled, 0 otherwise */
int enable_pipelining; /* 1 if pipelining enabled, 0 otherwise */
} DoeMetrics;
/**
* @brief Extract complete metrics snapshot from VM
*
* Collects all metrics from current VM state after a test harness run.
* Workload duration and CPU deltas must be supplied by caller.
*
* @param vm Pointer to Forth VM instance
* @param workload_duration_ns Actual VM workload execution time (nanoseconds)
* @param cpu_temp_delta_c CPU temperature change during run (°C)
* @param cpu_freq_delta_mhz CPU frequency change during run (MHz)
* @return Populated metrics structure (timestamp filled in)
*/
DoeMetrics metrics_from_vm(VM *vm, uint64_t workload_duration_ns,
int32_t cpu_temp_delta_c, int32_t cpu_freq_delta_mhz);
/**
* @brief Write CSV header row
*
* Writes the 35-column CSV header to output stream.
*
* @param out Output file stream
*/
void metrics_write_csv_header(FILE *out);
/**
* @brief Write metrics as CSV row
*
* Writes a single run's metrics as comma-separated values.
*
* @param out Output file stream
* @param metrics Metrics structure to write
*/
void metrics_write_csv_row(FILE *out, const DoeMetrics *metrics);
/**
* @brief Write reduced James Law CSV row (20 columns)
*
* Outputs only the subset of metrics needed for the James Law validation experiment.
* This matches the header format in run_window_sweep.sh (minus the 5 script-prepended columns).
*
* @param out Output file stream
* @param metrics Metrics structure to write
* @param vm VM instance (for heartbeat bucket aggregates and L8 mode)
*/
void metrics_write_james_law_csv_row(FILE *out, const DoeMetrics *metrics, VM *vm);
/**
* @brief Print metrics as human-readable text
*
* Outputs metrics in formatted text for debugging/verification.
*
* @param out Output file stream
* @param metrics Metrics structure to print
*/
void metrics_print_text(FILE *out, const DoeMetrics *metrics);
/**
* @brief Get current CPU temperature (Celsius)
*
* Reads /sys/class/thermal/thermal_zone0/temp on Linux,
* returns 0 if unavailable.
*
* @return Temperature in °C, or 0 if unable to read
*/
int32_t metrics_get_cpu_temp_c(void);
/**
* @brief Get current CPU frequency (MHz)
*
* Tries multiple sources:
* 1. /sys/devices/system/cpu/cpu0/cpufreq/scaling_cur_freq
* 2. /proc/cpuinfo
* Returns 0 if unavailable.
*
* @return Frequency in MHz, or 0 if unable to read
*/
int32_t metrics_get_cpu_freq_mhz(void);
/**
* @brief Get current timestamp as ISO 8601 string
*
* Format: "YYYY-MM-DDTHH:MM:SS"
*
* @param buf Buffer to write timestamp (minimum 32 bytes)
* @param bufsize Size of buffer
*/
void metrics_get_timestamp(char *buf, size_t bufsize);
#ifdef __cplusplus
}
#endif
#endif /* DOE_METRICS_H */
v3/include/inference_engine.h
+263
View File
@@ -0,0 +1,263 @@
/*
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.
*/
#ifndef INFERENCE_ENGINE_H
#define INFERENCE_ENGINE_H
#include <stdint.h>
#include <stddef.h>
#include "vm.h" /* For RollingWindowOfTruth, VM structure */
#include "q48_16.h" /* For Q48.16 fixed-point math */
/* ============================================================================
* OpAmp Model: Inference Engine Architecture
* ============================================================================
*
* The inference engine unifies all VM adaptive tuning into a single loop:
*
* Rolling Window of Truth (execution_heat trajectory, metrics)
* ↓
* [Inference Engine]
* ├─ ANOVA Early-Exit: Check if variance stable
* ├─ Window Width Inference: Variance inflection detection
* ├─ Decay Slope Inference: Closed-form linear regression
* └─ Diagnostics: Fit quality, variance metrics
* ↓
* Tuning Outputs (adaptive_window_width, adaptive_decay_slope)
* ↓
* [Apply to VM]
* ↓
* [System Adapts]
* ↓
* [Feedback Loop Repeats]
*
* Key Design Principles:
* - Q48.16 math only (no floating-point)
* - ANOVA early-exit for efficiency (5% variance threshold)
* - Closed-form algorithms (deterministic, fast)
* - Observable diagnostics (RStudio dashboard feed)
*/
/* ============================================================================
* Input Data Structure: Metrics snapshot + window context
* ============================================================================
*/
typedef struct {
VM *vm; /* Owning VM (for dictionary heat snapshots) */
/* === Window Context === */
RollingWindowOfTruth *window; /* Pointer to window of truth */
uint64_t trajectory_length; /* Number of heat entries to analyze */
/* === Current Metrics Snapshot === */
uint64_t prefetch_hits; /* Successful prefetch predictions */
uint64_t prefetch_attempts; /* Total prefetch attempts */
uint64_t hot_word_count; /* Words above execution_heat threshold */
uint64_t stale_word_count; /* Words with execution_heat in low range */
uint64_t total_heat; /* Sum of all execution_heat values */
uint32_t word_count; /* Total dictionary entries */
/* === Baseline (For Trending) === */
uint64_t last_total_heat; /* Total heat from previous check */
uint64_t last_stale_count; /* Stale count from previous check */
} InferenceInputs;
/* ============================================================================
* Output Data Structure: Tuning parameters + diagnostics
* ============================================================================
*/
struct InferenceOutputs {
/* === Tuning Outputs (Apply to VM) === */
uint32_t adaptive_window_width; /* Inferred optimal window size (from variance inflection) */
uint64_t adaptive_decay_slope; /* Inferred decay slope in Q48.16 (from regression) */
/* === Diagnostics (RStudio Dashboard Feed) === */
uint64_t window_variance_q48; /* Variance of heat across window in Q48.16 */
uint64_t slope_fit_quality_q48; /* R² or residual metric in Q48.16 (0.0 to 1.0) */
/* === Status Tracking === */
uint32_t early_exited; /* 1 if ANOVA check skipped full inference, 0 if full run */
uint64_t last_check_tick; /* Timestamp of last full inference (for monitoring) */
};
/* ============================================================================
* Main API: Run Inference Engine
* ============================================================================
*
* Single entry point that handles:
* 1. ANOVA early-exit (check variance stability)
* 2. Full inference (if variance changed significantly)
* 3. Update tuning outputs
*
* Thread-Safety: Safe for synchronous calls from vm_tick()
* (No shared state written; outputs struct is caller-allocated)
*/
/**
* @brief Run adaptive inference engine on window data
*
* High-level flow:
* 1. ANOVA Check: Is variance delta < 5%?
* - YES: Return cached outputs immediately (cost: ~100 cycles)
* - NO: Continue to full inference
*
* 2. Extract trajectory: Fresh execution_heat snapshot from dictionary
*
* 3. Window Width Inference:
* - Compute variance across entire window
* - Detect inflection point (where d(variance)/d(size) → 0)
* - Return optimal window size
*
* 4. Decay Slope Inference:
* - Transform trajectory to log space (ln(heat[t]))
* - Fit linear regression: ln(heat) = a - slope*t
* - Extract slope coefficient in Q48.16
*
* 5. Diagnostics:
* - Compute fit quality (R² or residual)
* - Store variance metric for next early-exit check
*
* @param inputs Snapshot of window + metrics (caller-provided)
* @param outputs Tuning parameters + diagnostics (caller-provided, will be updated)
*
* @return void (results_run_01_2025_12_08 in outputs struct)
*
* Preconditions:
* - inputs != NULL
* - outputs != NULL
* - inputs->window != NULL
* - inputs->window->is_warm == 1 (window has enough data)
* - inputs->trajectory_length > 1
*
* Side Effects:
* - Modifies outputs struct (caller must preserve if caching)
* - Allocates temporary trajectory buffer (freed on return)
*/
void inference_engine_run(InferenceInputs *inputs, InferenceOutputs *outputs);
/* ============================================================================
* Configuration Constants (In vm.h, but referenced here)
* ============================================================================
*
* User-tunable via Makefile:
*
* #define HEARTBEAT_INFERENCE_FREQUENCY 5000
* - Ticks between full inference runs
* - Decreasing = faster response, more CPU
* - Increasing = slower response, less CPU
*
* #define VARIANCE_SIGNIFICANCE_THRESHOLD 5
* - Percentage (0-100) at which variance change triggers re-inference
* - Default: 5% (skip inference if variance changed < 5%)
* - Decreasing = more frequent re-inference (conservative)
* - Increasing = less frequent re-inference (aggressive)
*
* #define ADAPTIVE_MIN_WINDOW_SIZE 256
* - Minimum effective_window_size (never shrink below this)
* - Ensures minimum statistical validity
* - Increasing = higher overhead, more accuracy
*/
/* ============================================================================
* Helper Functions (For Testing / Diagnostics)
* ============================================================================
*/
/*
* @brief Pretty-print inference outputs for logging
*
* Format: "window_width=XXX variance_q48=YYYY slope_q48=ZZZZ fit_quality=WWWW"
*
* @param outputs Inference outputs struct
* @return Pointer to static string (valid until next call)
*/
const char* inference_outputs_to_string(const InferenceOutputs *outputs);
/*
* @brief Validate inference outputs for sanity
*
* Checks:
* - window_width is within [ADAPTIVE_MIN_WINDOW_SIZE, ROLLING_WINDOW_SIZE]
* - slope_q48 is reasonable (between 0.001 and 100 in Q48.16)
* - variance and fit_quality are between 0.0 and 1.0 in Q48.16
*
* @param outputs Inference outputs to validate
* @return 1 if valid, 0 if suspicious
*/
int inference_outputs_validate(const InferenceOutputs *outputs);
/* ============================================================================
* Internal Functions (Exposed for Unit Testing)
* ============================================================================
*/
/*
* @brief Compute variance of heat data in Q48.16 format
*
* @param heat_data Array of heat values
* @param length Number of elements in array
* @return Variance in Q48.16 format
*/
q48_16_t compute_variance_q48(const uint64_t *heat_data, uint64_t length);
/*
* @brief Find variance inflection point for optimal window width
*
* @param heat_data Array of heat values
* @param trajectory_length Total trajectory length
* @param full_variance Variance of full trajectory
* @return Optimal window width
*/
uint32_t find_variance_inflection(const uint64_t *heat_data, uint64_t trajectory_length, q48_16_t full_variance);
/*
* @brief Infer decay slope from heat trajectory using linear regression
*
* @param heat_data Array of heat values
* @param length Number of elements
* @return Decay slope in Q48.16 format
*/
uint64_t infer_decay_slope_q48(const uint64_t *heat_data, uint64_t length);
#endif /* INFERENCE_ENGINE_H */
v3/include/io.h
+80
View File
@@ -0,0 +1,80 @@
/*
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.
*/
#ifndef IO_H
#define IO_H
#include <stdint.h>
#include "vm.h"
/* BLOCK_SIZE is defined in vm.h */
/** @brief Total number of blocks available */
#define BLOCK_COUNT 1024
/** @brief Total memory size in bytes */
#define MEMORY_SIZE (BLOCK_SIZE * BLOCK_COUNT)
/*
* @brief Initialize the I/O subsystem
* @param vm Pointer to the virtual machine instance
*/
void io_init(VM * vm);
/**
* @brief Read a block from storage
* @param vm Pointer to the virtual machine instance
* @param block_num Block number to read
* @param buffer Buffer to store the read data
* @return 0 on success, non-zero on failure
*/
int io_read_block(VM *vm, int block_num, unsigned char *buffer);
/*
* @brief Write a block to storage
* @param vm Pointer to the virtual machine instance
* @param block_num Block number to write
* @param buffer Buffer containing data to write
* @return 0 on success, non-zero on failure
*/
int io_write_block(VM *vm, int block_num, const unsigned char *buffer);
#endif /* IO_H */
v3/include/log.h
+120
View File
@@ -0,0 +1,120 @@
/*
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.
*/
#ifndef LOG_H
#define LOG_H
/* Maximum log line size for persistent logging */
/* Renamed from LOG_LINE_MAX: vm.h owns that name for the persistent
* block-log line width (64, unrelated concept). This is the in-memory log
* message-formatting line length; keeping a distinct name removes the
* include-order collision that forced a fragile "vm.h before log.h"
* convention across the kernel (kernel_main.c/shim.c/capsule_birth.c). */
#ifndef LOG_MSG_LINE_MAX
#define LOG_MSG_LINE_MAX 256
#endif
/* Forward declaration */
struct VM;
/**
* @brief Logging level enumeration
*
* Defines the available logging levels in order of increasing verbosity.
*/
typedef enum {
LOG_NONE = -1, /**< Completely disable all logging */
LOG_ERROR = 0, /**< Error messages only */
LOG_WARN, /**< Warning and error messages */
LOG_INFO, /**< Informational, warning and error messages */
LOG_TEST, /**< Test results_run_01_2025_12_08 and all previous levels */
LOG_DEBUG /**< Debug messages and all previous levels */
} LogLevel;
/**
* @brief Test result type enumeration
*
* Defines the possible outcomes of test execution.
*/
typedef enum {
TEST_PASS = 0, /**< Test completed successfully */
TEST_FAIL, /**< Test failed */
TEST_SKIP, /**< Test was skipped */
TEST_ERROR /**< Test encountered an error during execution */
} TestResult;
/**
* @brief Set the global logging level
* @param level The new logging level to set
* @note Default level is LOG_INFO
*/
void log_set_level(LogLevel level);
/**
* @brief Get the current logging level
* @return The current logging level
*/
LogLevel log_get_level(void);
/**
* @brief Log a formatted message at the specified level
* @param level The logging level for this message
* @param fmt Printf-style format string
* @param ... Variable arguments for format string
*/
void log_message(LogLevel level, const char *fmt, ...);
/**
* @brief Log a test result with colored output
* @param word_name Name of the word being tested
* @param result Result of the test execution
*/
void log_test_result(const char *word_name, TestResult result);
/**
* @brief Set the VM instance for persistent logging
* @param vm VM instance to use for persistent logging (NULL to disable)
*/
void log_set_vm(struct VM *vm);
#endif /* LOG_H */
v3/include/math_portable.h
+91
View File
@@ -0,0 +1,91 @@
/*
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.
*/
/*
* math_portable.h
*
* Portable C99 math functions in Q48.16 64-bit fixed-point format.
* Suitable for embedded environments with no libm
* (HISTORICAL: also L4Re, through mid-2026; removed as an active target).
* All arithmetic is integer-only for maximum performance.
*
* Q48.16 Format:
* - 48-bit signed integer + 16-bit fractional part
* - Precision: 2^-16 ≈ 0.0000153 (nanoseconds)
* - Range: ±140 trillion ns (≈ 4.4 years)
*
* Functions:
* sqrt_q48(x) - Square root of Q48.16 value via Newton-Raphson
* erf_q48(x) - Error function of Q48.16 value (dimensionless)
*/
#ifndef MATH_PORTABLE_H
#define MATH_PORTABLE_H
#include <stdint.h>
#define Q48_SCALE (1LL << 16) /* 65536 */
/**
* Square root in Q48.16 fixed-point
* Input: x in Q48.16 format
* Output: sqrt(x) in Q48.16 format
* Uses Newton-Raphson: x_{n+1} = (x_n + a/x_n) / 2
* Converges in ~10-15 iterations
* Returns 0 for negative inputs (guard against domain error)
*/
int64_t sqrt_q48(int64_t x);
/**
* Error function in Q48.16 fixed-point
* Input: x in Q48.16 format (dimensionless Z-score)
* Output: erf(x) in Q48.16 format (range: -Q48_SCALE to +Q48_SCALE)
* Uses Abramowitz & Stegun approximation (7.1.26)
* Maximum error: 1.5e-7 relative to floating-point erf
* Properties:
* - erf(0) = 0
* - erf(-x) = -erf(x) (odd function)
* - erf(x) approaches ±Q48_SCALE for large |x|
*/
int64_t erf_q48(int64_t x);
#endif /* MATH_PORTABLE_H */
v3/include/memory_management.h
+68
View File
@@ -0,0 +1,68 @@
/*
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.
*/
/**
* @file memory_management.h
* @brief Memory management functions for the StarForth virtual machine
*
* This file contains functions for managing memory allocation and alignment
* in the StarForth virtual machine implementation.
*/
#ifndef VM_MEMORY_H
#define VM_MEMORY_H
#include "vm.h"
/*
* @brief Allocates memory in the virtual machine's memory space
* @param vm Pointer to the virtual machine instance
* @param bytes Number of bytes to allocate
* @return Pointer to the allocated memory or NULL if allocation fails
*/
void *vm_allot(VM *vm, size_t bytes);
/*
* @brief Aligns the virtual machine's memory pointer to the next word boundary
* @param vm Pointer to the virtual machine instance
*/
void vm_align(VM * vm);
#endif
v3/include/physics_execution_hooks.h
+92
View File
@@ -0,0 +1,92 @@
/*
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.
*/
#ifndef STARFORTH_PHYSICS_EXECUTION_HOOKS_H
#define STARFORTH_PHYSICS_EXECUTION_HOOKS_H
/*
* physics_execution_hooks.h - Clean abstraction for physics-driven execution hooks
*
* Purpose: Hide ALL physics machinery behind two simple function calls.
* The VM execution loop calls these; it doesn't know or care about:
* - Heat tracking
* - Decay models
* - Rolling window
* - Pipelining metrics
* - Hotwords cache
* - Profiling
*
* This keeps vm.c clean and focused on execution semantics.
*/
#include "vm.h"
/*
* Call BEFORE executing a word.
* Handles: decay, heat increment, rolling window, pipelining speculation check.
*
* @param vm The VM instance
* @param word The word about to execute
* @param prev The previously executed word (NULL if first in sequence)
*/
void physics_pre_execute(VM* vm, DictEntry* word, DictEntry* prev);
/*
* Call AFTER executing a word.
* Handles: physics touch, profiler exit, DoE counter, heartbeat check.
*
* @param vm The VM instance
* @param word The word that just executed
*/
void physics_post_execute(VM* vm, DictEntry* word);
/*
* Call when looking up a word (outer interpreter).
* Handles: decay + heat for lookup path (not inner loop).
*
* @param vm The VM instance
* @param entry The word found
* @param canon Canonical dictionary entry (may differ from entry)
*/
void physics_on_lookup(VM* vm, DictEntry* entry, DictEntry* canon);
#endif /* STARFORTH_PHYSICS_EXECUTION_HOOKS_H */
v3/include/physics_hotwords_cache.h
+314
View File
@@ -0,0 +1,314 @@
/*
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.
*/
/*
* physics_hotwords_cache.h
*
* Hot-words cache optimization: frequency-driven dictionary acceleration
*
* Compile-time switch to enable/disable the hot-words cache variant.
* Allows measuring impact before/after on different build profiles.
*
* Usage:
* make clean && make ENABLE_HOTWORDS_CACHE=1 # With cache
* make clean && make ENABLE_HOTWORDS_CACHE=0 # Without cache
*
* Measure performance:
* BENCH-DICT-LOOKUP (show baseline + stats)
* PHYSICS-SHOW-CACHE-STATS (show hit rate, evictions, etc)
*/
#ifndef PHYSICS_HOTWORDS_CACHE_H
#define PHYSICS_HOTWORDS_CACHE_H
#include <stdint.h>
#include "vm.h"
/* ============================================================================
* Feature Switch
* ============================================================================
*
* Set via -DENABLE_HOTWORDS_CACHE=1 during compilation
* Default: enabled (can be disabled for baseline comparison)
*/
#ifndef ENABLE_HOTWORDS_CACHE
#define ENABLE_HOTWORDS_CACHE 1
#endif
/* ============================================================================
* Hot Words Cache Configuration
* ============================================================================
*/
/** Maximum number of hot words to cache (typically 16-32) */
#define HOTWORDS_CACHE_SIZE 32
/** Execution heat threshold to consider a word "hot" (execution count) */
#define HOTWORDS_EXECUTION_HEAT_THRESHOLD 50
/** Reorder bucket when execution heat delta exceeds this (avoid thrashing) */
#define HOTWORDS_EXECUTION_HEAT_DELTA_THRESHOLD 100
/* ============================================================================
* Statistics Structure
* ============================================================================
*
* Tracks cache performance for measurement and diagnostics
*/
typedef struct {
/** Total lookups performed */
uint64_t total_lookups;
/** Lookups that hit the hot-words cache */
uint64_t cache_hits;
/** Lookups that missed cache but found in bucket */
uint64_t bucket_hits;
/** Lookups that failed (word not found) */
uint64_t misses;
/** Words evicted from cache (LRU) */
uint64_t evictions;
/** Times a word was promoted to hot-words */
uint64_t promotions;
/** Times bucket was reordered */
uint64_t bucket_reorders;
/** === 64-bit Fixed-Point Statistics (Q48.16 format) ===
* Q48.16 = 48-bit integer + 16-bit fractional part
* Precision: 2^-16 ns ≈ 0.0000153 ns
* Range: ±140 trillion ns (≈ 4.4 years)
* Allows: Bayesian inference, precise averaging, statistical computation
*/
/** Sum of cache hit latencies (64-bit fixed-point, Q48.16) */
int64_t cache_hit_total_ns_q48;
/** Sum of bucket search latencies (64-bit fixed-point, Q48.16) */
int64_t bucket_search_total_ns_q48;
/** Number of cache hit samples (for averaging) */
uint64_t cache_hit_samples;
/** Number of bucket search samples (for averaging) */
uint64_t bucket_search_samples;
/** Minimum cache hit latency (nanoseconds) */
int64_t min_cache_hit_ns;
/** Maximum cache hit latency (nanoseconds) */
int64_t max_cache_hit_ns;
/** Minimum bucket search latency (nanoseconds) */
int64_t min_bucket_search_ns;
/** Maximum bucket search latency (nanoseconds) */
int64_t max_bucket_search_ns;
/** Sum of squared cache hit latencies (for variance/stddev) */
int64_t cache_hit_variance_sum_q48;
/** Sum of squared bucket search latencies (for variance/stddev) */
int64_t bucket_search_variance_sum_q48;
} HotwordsStats;
/* ============================================================================
* Hot Words Cache State
* ============================================================================
*
* Embedded in VM for global state
*/
typedef struct HotwordsCache_s {
/** Cache entries (pointers to DictEntry) */
DictEntry *cache[HOTWORDS_CACHE_SIZE];
/** Number of valid entries in cache */
uint32_t cache_count;
/** LRU: last-used index for eviction */
uint32_t lru_index;
/** Performance statistics */
HotwordsStats stats;
/** Enabled/disabled flag (runtime toggle) */
int enabled;
} HotwordsCache;
/* ============================================================================
* Public API
* ============================================================================
*/
/**
* Initialize hot-words cache
* Should be called during VM initialization
*/
void hotwords_cache_init(HotwordsCache *cache);
/**
* Cleanup hot-words cache
*/
void hotwords_cache_cleanup(HotwordsCache *cache);
/**
* Lookup word in cache first, then fall back to bucket search
* Returns the found word, or NULL if not found
*
* This is the main function that replaces vm_find_word() logic.
* Takes the VM so the bucket fallback can resolve same-named entries by
* definition age (vm_dict_resolve_in_bucket) — bucket order alone is not
* authoritative once dict_reorganize_buckets_by_heat() has run.
*/
DictEntry *hotwords_cache_lookup(VM *vm,
HotwordsCache *cache,
DictEntry **bucket,
size_t bucket_count,
const char *name,
size_t len);
/**
* Promote a word to the hot-words cache
* Called when a word's execution heat exceeds threshold
*/
void hotwords_cache_promote(HotwordsCache *cache, DictEntry *word);
/**
* Evict every cache slot holding this exact entry.
* Must be called before an entry is freed (FORGET) — a stale pointer in the
* ring is a use-after-free.
*/
void hotwords_cache_evict_entry(HotwordsCache *cache, const DictEntry *word);
/**
* Evict every cache slot whose entry matches this name.
* Called whenever name resolution may change: word creation (shadowing),
* smudge/unsmudge, hide. The next lookup re-resolves through the bucket.
*/
void hotwords_cache_evict_name(HotwordsCache *cache, const char *name, size_t len);
/**
* Reorder a bucket by execution heat (move hot words forward)
* Called when execution heat delta exceeds threshold
*/
void hotwords_bucket_reorder(DictEntry **bucket, size_t count);
/**
* Reset statistics (for before/after comparison)
*/
void hotwords_stats_reset(HotwordsStats *stats);
/**
* Print statistics to stdout
*/
void hotwords_stats_print(const HotwordsStats *stats);
/**
* Enable/disable cache at runtime (for A/B testing)
*/
void hotwords_cache_set_enabled(HotwordsCache *cache, int enabled);
/* ============================================================================
* Bayesian Inference Statistics
* ============================================================================
*/
/**
* Bayesian statistics structure for inference and credible intervals
* All values stored in Q48.16 fixed-point (64-bit signed integer)
* representing nanoseconds with 2^-16 ≈ 0.0000153 ns precision
*/
typedef struct {
int64_t mean_ns_q48; /* Mean latency (Q48.16) */
int64_t stddev_ns_q48; /* Standard deviation (Q48.16) */
int64_t median_ns_q48; /* Median (p50) (Q48.16) */
int64_t credible_lower_95; /* Lower bound of 95% credible interval (Q48.16) */
int64_t credible_upper_95; /* Upper bound of 95% credible interval (Q48.16) */
int64_t credible_lower_99; /* Lower bound of 99% credible interval (Q48.16) */
int64_t credible_upper_99; /* Upper bound of 99% credible interval (Q48.16) */
uint64_t sample_count; /* Number of samples in posterior */
} BayesianLatencyPosterior;
/**
* Calculate posterior distribution for cache hits
* Uses accumulated samples to compute credible intervals
*/
BayesianLatencyPosterior hotwords_posterior_cache_hits(const HotwordsStats *stats);
/**
* Calculate posterior distribution for bucket searches
* Uses accumulated samples to compute credible intervals
*/
BayesianLatencyPosterior hotwords_posterior_bucket_searches(const HotwordsStats *stats);
/**
* Calculate speedup estimate with credible interval
* All values in Q48.16 fixed-point format (64-bit signed integer)
* Probabilities are in range [0, Q48_SCALE] representing [0%, 100%]
*/
struct SpeedupEstimate {
int64_t speedup_factor_q48; /* Bucket latency / Cache latency (Q48.16) */
int64_t credible_lower_95_q48; /* Lower bound (95% credible) (Q48.16) */
int64_t credible_upper_95_q48; /* Upper bound (95% credible) (Q48.16) */
int64_t probability_gt_10pct_q48; /* P(speedup > 1.1) in Q48.16, [0, 65536] = [0%, 100%] */
int64_t probability_gt_double_q48;/* P(speedup > 2.0) in Q48.16, [0, 65536] = [0%, 100%] */
};
/**
* Calculate speedup estimate with uncertainty
*/
struct SpeedupEstimate hotwords_speedup_estimate(const HotwordsStats *stats);
/**
* Generate detailed Bayesian inference report
* Compares cache vs bucket performance with confidence measures
*/
void hotwords_bayesian_report(const HotwordsStats *stats_with_cache,
const HotwordsStats *stats_without_cache);
#endif /* PHYSICS_HOTWORDS_CACHE_H */
v3/include/physics_metadata.h
+111
View File
@@ -0,0 +1,111 @@
/*
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 ***
physics_metadata.h - Physics metadata helpers for dictionary entries
Phase 1 implements lightweight thermodynamic signals that inform scheduling
and storage placement while keeping the runtime overhead minimal.
*/
#ifndef STARFORTH_PHYSICS_METADATA_H
#define STARFORTH_PHYSICS_METADATA_H
#include <stdint.h>
#include "vm.h"
/* L8 FINAL INTEGRATION: L1 heat tracking always-on */
/* ============================================================================
* INTENT: Atomic heat increment for FL1 feedback loop
* FL1: Heat accumulation - called on every word execution by inner interpreter
* WHY: Atomic operations prevent race conditions when multiple execution paths
* (e.g., heartbeat thread + main interpreter) touch execution_heat
* RELAXED memory order is sufficient (no ordering dependencies)
* ============================================================================ */
static inline void physics_execution_heat_increment(DictEntry *entry)
{
if (!entry) return;
#if defined(__GNUC__)
__atomic_fetch_add(&entry->execution_heat, 1, __ATOMIC_RELAXED);
#else
entry->execution_heat++;
#endif
}
static inline cell_t physics_execution_heat_load(const DictEntry *entry)
{
if (!entry) return 0;
#if defined(__GNUC__)
return __atomic_load_n(&entry->execution_heat, __ATOMIC_RELAXED);
#else
return entry->execution_heat;
#endif
}
static inline uint64_t physics_decay_slope_load(const VM *vm)
{
#if defined(__GNUC__)
return __atomic_load_n(&vm->decay_slope_q48, __ATOMIC_RELAXED);
#else
return vm->decay_slope_q48;
#endif
}
void physics_metadata_init(DictEntry *entry, uint32_t header_bytes);
void physics_metadata_set_mass(DictEntry *entry, uint32_t total_bytes);
void physics_metadata_touch(DictEntry *entry, cell_t execution_heat, uint64_t now_ns);
void physics_metadata_refresh_state(DictEntry * entry);
void physics_metadata_record_latency(DictEntry *entry, uint64_t sample_ns);
void physics_metadata_apply_seed(DictEntry * entry);
/* L8 FINAL INTEGRATION: L3 linear decay always-on */
void physics_metadata_apply_linear_decay(DictEntry *entry, uint64_t elapsed_ticks, VM *vm);
#endif /* STARFORTH_PHYSICS_METADATA_H */
v3/include/physics_pipelining_metrics.h
+430
View File
@@ -0,0 +1,430 @@
/*
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 ***
physics_pipelining_metrics.h - Word transition tracking for speculative execution
Phase 1: Instrumentation for pipelining/speculative execution
This module tracks word-to-word transitions (frequency of which words follow
which other words) to support speculative prefetching and pipelining decisions.
Terminology:
- transition_heat[i]: How many times word[i] has been executed immediately
after this word (forms prediction basis)
- total_transitions: Sum of all transition_heat entries
- prefetch_*: Metrics for speculative execution success/failure
*/
#ifndef PHYSICS_PIPELINING_METRICS_H
#define PHYSICS_PIPELINING_METRICS_H
#include <stdint.h>
#include "starforth_config.h"
/* ============================================================================
* Pipelining Feature Switch (disabled by default during Phase 1)
* ============================================================================
* Default lives in starforth_config.h, the single source of truth for VM
* build-time defaults; overridable via -D exactly as before.
*/
/* ============================================================================
* Tuning Knobs (adjustable at compile-time, future: runtime)
* ============================================================================
*/
/**
* SPECULATION_THRESHOLD_Q48: Minimum probability (Q48.16) to speculate on
* a word transition.
* Range: 0.10 (very aggressive) to 0.95 (very conservative)
* Default: see starforth_config.h (STARFORTH_CONFIG_SPECULATION_THRESHOLD_Q48_DEFAULT)
* Q48.16 encoding: 0.50 = 0x8000LL (1LL << 15)
*/
/**
* SPECULATION_DEPTH: How many words ahead to prefetch speculatively.
* Range: 1 (next word only) to 4 (very aggressive)
* Default: see starforth_config.h (STARFORTH_CONFIG_SPECULATION_DEPTH_DEFAULT)
*/
/**
* MIN_SAMPLES_FOR_SPECULATION: Minimum number of transitions observed
* before making speculation decisions.
* Range: 1 (immediate) to 100 (very conservative)
* Default: see starforth_config.h (STARFORTH_CONFIG_MIN_SAMPLES_FOR_SPECULATION_DEFAULT)
*/
/**
* MISPREDICTION_COST_Q48: Estimated cost (in nanoseconds, Q48.16 format)
* of recovering from wrong speculation.
* This is calibrated to the actual recovery time on target hardware.
* Range: 0 to 100 ns
* Default: see starforth_config.h (STARFORTH_CONFIG_MISPREDICTION_COST_Q48_DEFAULT)
* Q48.16 encoding: 25 ns = 25 << 16 = 0x190000LL
*/
/**
* MINIMUM_PREFETCH_ROI: Minimum expected Return-On-Investment ratio
* for speculation to be worthwhile.
* Speculation succeeds only if:
* (prefetch_latency_saved / total_attempts) > MINIMUM_PREFETCH_ROI
* Range: 1.0 (always speculate) to 2.0 (very selective)
* Default: see starforth_config.h (STARFORTH_CONFIG_MINIMUM_PREFETCH_ROI_DEFAULT)
* Q48.16 encoding: 1.10 = 1.10 * (1 << 16) = 0x1199AL
*/
/**
* TRANSITION_WINDOW_SIZE: Knob #6 - Execution context depth for prediction
*
* How many previous words to remember when predicting next word.
* Larger window captures deeper patterns but uses more memory.
*
* Window=1: Only immediate predecessor (A→B predictions)
* Window=2: Previous 2 words (A,B→C predictions) - good balance
* Window=4: Previous 4 words (captures multi-level patterns)
* Window=8: Very deep, expensive -- see starforth_config.h for the actual
* shipped default
*
* Binary Chop Search Space (Phase 2):
* Iteration 1: Try window=2 (baseline)
* Iteration 2: Try window=1 and window=4
* Iteration 3: Narrow to optimal (1, 2, or 4)
* Converge: Pick size with highest prediction accuracy
*
* Range: 1 to 8
* Default: see starforth_config.h (STARFORTH_CONFIG_TRANSITION_WINDOW_SIZE_DEFAULT)
* Trade-off: Pattern depth vs. memory usage & complexity
*
* Tuning: make TRANSITION_WINDOW_SIZE=1 (or 2, 4, 8)
*/
/* ============================================================================
* Word Transition Metrics
* ============================================================================
*
* Allocated per dictionary entry to track which words follow this word.
* This is the basis for speculative prefetching decisions.
*/
typedef struct WordTransitionMetrics {
/**
* transition_heat[i]: Number of times word with index i has been
* executed immediately after this word.
*
* Dynamically allocated array of size DICTIONARY_SIZE.
* Initialized to NULL; allocated on first use to save memory
* for words that are never executed.
*/
uint64_t *transition_heat;
/** Total number of transitions observed from this word */
uint64_t total_transitions;
/** Number of speculative prefetch attempts made for this word */
uint64_t prefetch_attempts;
/** Number of successful prefetch predictions (hits) */
uint64_t prefetch_hits;
/** Number of failed prefetch predictions (misses) */
uint64_t prefetch_misses;
/**
* Total latency saved through successful prefetching (Q48.16 nanoseconds).
* Positive value indicates net benefit from speculation.
*/
int64_t prefetch_latency_saved_q48;
/**
* Total latency cost from failed prefetch predictions (Q48.16 nanoseconds).
* Negative value (cost) to be subtracted from savings.
*/
int64_t misprediction_cost_q48;
/**
* Cached probability of most likely next word (for quick access).
* Updated periodically to avoid recomputation.
* Q48.16 format (0.0 to 1.0 == 0LL to 1LL<<16)
*/
int64_t max_transition_probability_q48;
/**
* Index (word id) of most likely next word.
* Used for fast prefetch without scanning transition_heat array.
*/
uint32_t most_likely_next_word_id;
/* ========== Context-Aware Transitions (Phase 1 Extension) ========== */
/**
* Circular buffer of previous word IDs for context tracking.
* Size = TRANSITION_WINDOW_SIZE (default 2)
* Used to build multi-word context patterns (e.g., A,B→C)
*
* Example with WINDOW=2:
* context_window[0] = older word (2 steps back)
* context_window[1] = recent word (1 step back)
* Next word completes the pattern: (context_window[0], context_window[1]) → next
*/
uint32_t *context_window;
/**
* Current position in context_window circular buffer.
* Points to slot where next word ID will be stored.
*/
uint32_t context_window_pos;
/**
* Sparse hash table for context-based transitions.
* Maps: hash(context_window) → counts_array[DICTIONARY_SIZE]
*
* Phase 1: Collect only (simple reference implementation)
* Phase 2: Analyze prediction accuracy by context depth
* Phase 3: Use for adaptive prefetching decisions
*
* Opaque pointer - implementation is in transition_metrics.c
*/
void *context_transitions;
/**
* Total context-based transitions observed.
* Counter for Phase 2 analysis (accuracy measurement)
*/
uint64_t total_context_transitions;
/**
* Actual window size for this word's metrics.
* May differ from TRANSITION_WINDOW_SIZE if memory allocation failed.
* Phase 2 uses this to validate context data reliability.
*/
uint32_t actual_window_size;
} WordTransitionMetrics;
/* ============================================================================
* Transition Metrics API
* ============================================================================
*/
/*
* Initialize word transition metrics for a dictionary entry.
* Called once per word during dictionary entry creation.
*
* @param metrics Pointer to uninitialized WordTransitionMetrics
* @return 0 on success, -1 on memory allocation failure
*/
int transition_metrics_init(WordTransitionMetrics *metrics);
/*
* Record a word transition (word_from -> word_to).
* Called in the inner interpreter after each word execution.
*
* @param metrics Metrics for the current word
* @param next_word_id Index of word that executed next
* @param dict_size Total number of words in dictionary (for array bounds)
* @return 0 on success, -1 on invalid word_id
*/
int transition_metrics_record(WordTransitionMetrics *metrics, uint32_t next_word_id, uint32_t dict_size);
/*
* Get the probability (Q48.16 format) of a specific word following this word.
*
* Returns: (transition_heat[target] / total_transitions) in Q48.16 format
* or 0 if total_transitions == 0
*
* @param metrics Metrics for the current word
* @param target_word_id Index of potential next word
* @return Probability in Q48.16 format (0.0 to 1.0)
*/
int64_t transition_metrics_get_probability_q48(const WordTransitionMetrics *metrics, uint32_t target_word_id);
/*
* Update cached most-likely-next-word information.
* Should be called periodically (e.g., after every 100 transitions)
* to avoid stale cache.
*
* @param metrics Metrics for the current word
* @param dict_size Total number of words in dictionary
*/
void transition_metrics_update_cache(WordTransitionMetrics *metrics, uint32_t dict_size);
/*
* Record a successful prefetch prediction.
* Called when speculation correctly predicted the next word.
*
* @param metrics Metrics for the current word
* @param latency_saved_ns Nanoseconds saved (will be Q48.16 encoded)
*/
void transition_metrics_record_prefetch_hit(WordTransitionMetrics *metrics, int64_t latency_saved_ns);
/*
* Record a failed prefetch prediction.
* Called when speculation incorrectly predicted the next word.
*
* @param metrics Metrics for the current word
* @param recovery_cost_ns Nanoseconds lost to misprediction recovery
*/
void transition_metrics_record_prefetch_miss(WordTransitionMetrics *metrics, int64_t recovery_cost_ns);
/*
* Check if speculation should be attempted for a given target word.
* Applies threshold logic and ROI analysis.
*
* Returns: 1 if speculation should be attempted, 0 otherwise
*
* @param metrics Metrics for the current word
* @param target_word_id Index of potential next word
* @return 1 if probability > SPECULATION_THRESHOLD and enough samples, 0 otherwise
*/
int transition_metrics_should_speculate(const WordTransitionMetrics *metrics, uint32_t target_word_id);
/*
* Get detailed statistics string for diagnostics.
* Caller must free the returned string.
*
* @param metrics Metrics to report on
* @return Formatted statistics string (must be freed by caller)
*/
char *transition_metrics_stats_string(const WordTransitionMetrics *metrics);
/*
* Reset all transition metrics (clear counts, free transition_heat array).
* Called on VM reset or explicit metrics reset.
*
* @param metrics Metrics to reset
*/
void transition_metrics_reset(WordTransitionMetrics *metrics);
/*
* Free all allocated memory for transition metrics.
* Called during dictionary cleanup.
*
* @param metrics Metrics to clean up
*/
void transition_metrics_cleanup(WordTransitionMetrics *metrics);
/* ============================================================================
* Context-Aware Transition API (Phase 1 Extension)
* ============================================================================
*
* These functions handle multi-word pattern tracking for Phase 2 analysis.
* Phase 1: Collect context window data (this session)
* Phase 2: Analyze accuracy by context depth (next session)
* Phase 3: Use for adaptive prediction (future)
*/
/*
* Record a context-based transition (multi-word pattern).
* Called after each word execution with the execution window.
*
* Example with WINDOW=2:
* context[0] = word_A, context[1] = word_B, next_word = word_C
* Records: (A,B) → C transition in sparse hash table
*
* Phase 1: Just collects data, no analysis
* Phase 2: Will measure: "Do patterns with window=2 predict better than window=1?"
*
* @param metrics Metrics for the current word
* @param context Array of word IDs forming the context (size = window_size)
* @param window_size Length of context array
* @param next_word_id Word that follows the context
* @param dict_size Total number of words in dictionary
* @return 0 on success, -1 on error
*/
int transition_metrics_record_context(WordTransitionMetrics *metrics,
const uint32_t *context,
uint32_t window_size,
uint32_t next_word_id,
uint32_t dict_size);
/*
* Update the execution context window with a new word.
* Called after each word execution to slide the window forward.
*
* Example with WINDOW=2:
* Before: [A, B] (two previous words)
* After calling with C: [B, C] (shift left, add C on right)
*
* @param metrics Metrics to update
* @param word_id New word ID to add to window
* @return 0 on success, -1 if context tracking not initialized
*/
int transition_metrics_update_context_window(WordTransitionMetrics *metrics, uint32_t word_id);
/*
* Get context-based prediction accuracy statistics (Phase 2).
* Compares prediction success rates across different window sizes.
*
* Phase 2 will use this to run binary chop tuning:
* Measure accuracy(window=1), accuracy(window=2), accuracy(window=4)
* Binary search converges to optimal window size
*
* @param metrics Metrics to analyze
* @return Formatted string with accuracy statistics (caller must free)
*/
char *transition_metrics_context_accuracy_string(const WordTransitionMetrics *metrics);
/*
* Get recommended window size based on collected data.
* Phase 2 will call this as part of binary chop tuning algorithm.
*
* Algorithm:
* 1. Collect data with current window size
* 2. Measure prediction accuracy
* 3. If accuracy improves, try larger window
* 4. If accuracy declines, try smaller window
* 5. Converge to optimal size
*
* @param metrics Metrics to analyze
* @param current_window Current window size being tested
* @param accuracy_at_current Measured accuracy with current window
* @return Suggested next window size to try (1, 2, 4, or 8)
*/
uint32_t transition_metrics_binary_chop_suggest_window(const WordTransitionMetrics *metrics,
uint32_t current_window,
double accuracy_at_current);
#endif /* PHYSICS_PIPELINING_METRICS_H */
v3/include/physics_runtime.h
+215
View File
@@ -0,0 +1,215 @@
/*
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 ***
physics_runtime.h - Phase 1 physics runtime services
Provides host snapshot shims (POSIX + L4Re) and analytics heap scaffolding
for physics-aware scheduling. The interface is intentionally lightweight so
future governance-approved modules can extend it without ABI churn.
============================================================================
IMPORTANT SYNC NOTE (projects using git hooks / governance mirror):
• If you change HOLA protocol fields, magic, or version numbers below, also
update the governance export docs so the L4Re mirror stays aligned.
• Daemons touching this header can throw a warning when HOLA_PROTOCOL_* or
HOLA_SHARED_MAGIC change to catch accidental ABI drifts early.
• Reference: docs/src/internal/GOVERNANCE_EXPORT_NOTES.adoc
============================================================================
*/
#ifndef STARFORTH_PHYSICS_RUNTIME_H
#define STARFORTH_PHYSICS_RUNTIME_H
#include <stddef.h>
#include <stdint.h>
#ifdef __cplusplus
extern "C" {
#endif
/** Default analytics heap size (10 MiB) */
#define PHYSICS_ANALYTICS_DEFAULT_HEAP_BYTES (10u * 1024u * 1024u)
/** Magic tag for HOLA analytics heap headers ('HOLA') */
#define HOLA_SHARED_MAGIC 0x484f4c41u
/** HOLA protocol version (major.minor) */
#define HOLA_PROTOCOL_MAJOR 0x0001u
#define HOLA_PROTOCOL_MINOR 0x0000u
/** Host backend identifier */
typedef enum physics_host_backend {
PHYSICS_HOST_BACKEND_POSIX = 0,
PHYSICS_HOST_BACKEND_L4RE = 1, /* HISTORICAL: no backend sets this anymore; L4Re removed as an active target. Value kept stable for the HOLA analytics data format. */
PHYSICS_HOST_BACKEND_FAKE = 2
} physics_host_backend_t;
/** Analytics channel ids */
#define PHYSICS_ANALYTICS_CHANNEL_HOST_SNAPSHOT 0x00000002u
/** Host snapshot flag bits */
#define PHYSICS_HOST_FLAG_PSI 0x0001u
#define PHYSICS_HOST_FLAG_CGROUP 0x0002u
#define PHYSICS_HOST_FLAG_CPU_STAT 0x0004u
/**
* @brief Snapshot of scheduler-adjacent host signals.
*
* Fields are intentionally fixed width to maximise portability and allow the
* governance repository to consume binary dumps without per-platform quirks.
*/
typedef struct physics_host_snapshot {
physics_host_backend_t backend; /**< Selected backend (POSIX/L4Re/other) */
uint32_t scheduler_policy; /**< OS-specific scheduler policy identifier */
uint32_t scheduler_priority; /**< Nominal thread priority */
uint32_t scheduler_quantum_ns; /**< Reported quantum in nanoseconds (0 if unknown) */
uint32_t runnable_threads; /**< Runnable entities on this CPU set (best effort) */
uint32_t cpu_count; /**< Online logical CPU count */
uint32_t load_avg_milli; /**< Smoothed load average (×1000) */
uint32_t flags; /**< Backend-specific flags */
uint32_t psi_cpu_some_avg10_milli; /**< CPU PSI some avg10 ×1000 */
uint32_t psi_cpu_some_avg60_milli; /**< CPU PSI some avg60 ×1000 */
uint32_t psi_cpu_some_avg300_milli; /**< CPU PSI some avg300 ×1000 */
uint32_t psi_cpu_full_avg10_milli; /**< CPU PSI full avg10 ×1000 */
uint32_t psi_cpu_full_avg60_milli; /**< CPU PSI full avg60 ×1000 */
uint32_t psi_cpu_full_avg300_milli; /**< CPU PSI full avg300 ×1000 */
uint32_t psi_io_some_avg10_milli; /**< IO PSI some avg10 ×1000 */
uint32_t psi_io_some_avg60_milli; /**< IO PSI some avg60 ×1000 */
uint32_t psi_io_some_avg300_milli; /**< IO PSI some avg300 ×1000 */
uint32_t psi_io_full_avg10_milli; /**< IO PSI full avg10 ×1000 */
uint32_t psi_io_full_avg60_milli; /**< IO PSI full avg60 ×1000 */
uint32_t psi_io_full_avg300_milli; /**< IO PSI full avg300 ×1000 */
uint32_t psi_mem_some_avg10_milli; /**< Memory PSI some avg10 ×1000 */
uint32_t psi_mem_some_avg60_milli; /**< Memory PSI some avg60 ×1000 */
uint32_t psi_mem_some_avg300_milli; /**< Memory PSI some avg300 ×1000 */
uint64_t monotonic_time_ns; /**< Monotonic clock reading */
uint64_t realtime_ns; /**< Wall-clock timestamp (0 if unavailable) */
uint64_t backend_seq; /**< Backend-provided sequence counter */
uint64_t cpu_total_jiffies; /**< /proc/stat total jiffies snapshot */
uint64_t cpu_idle_jiffies; /**< /proc/stat idle jiffies snapshot */
uint64_t cgroup_cpu_usage_us; /**< cgroup v2 cpu.stat usage_usec (0 if unavailable) */
uint64_t cgroup_memory_current_bytes; /**< cgroup v2 memory.current (0 if unavailable) */
} physics_host_snapshot_t;
/** Event header written into the analytics ring buffer. */
typedef struct physics_analytics_event_header {
uint32_t channel; /**< Logical channel identifier */
uint16_t payload_bytes; /**< Size of event payload */
uint16_t reserved; /**< Reserved for alignment */
uint64_t timestamp_ns; /**< Producer timestamp */
} physics_analytics_event_header_t;
/** Analytics heap header seen by both producer (VM) and consumer (HOLA). */
typedef struct physics_analytics_header {
uint32_t magic; /**< HOLA_SHARED_MAGIC */
uint16_t version_major; /**< Protocol major version */
uint16_t version_minor; /**< Protocol minor version */
uint32_t heap_bytes; /**< Total heap size */
uint32_t ring_offset; /**< Offset to event ring */
uint32_t ring_bytes; /**< Event ring length */
uint32_t summary_offset; /**< Offset to summary/scratch region */
uint32_t summary_bytes; /**< Summary region length */
uint32_t scratch_offset; /**< Offset to reserved scratch area */
uint32_t scratch_bytes; /**< Scratch area length */
uint64_t produce_seq; /**< Monotonic sequence for producers */
uint64_t consume_seq; /**< Consumer-visible sequence */
uint32_t write_offset; /**< Producer write cursor */
uint32_t read_offset; /**< Consumer read cursor */
uint32_t dropped_events; /**< Count of dropped events */
uint32_t flags; /**< Heap flags (see docs) */
} physics_analytics_header_t;
/** Simple view onto the analytics heap layout. */
typedef struct physics_analytics_heap {
uint8_t *base; /**< Base pointer (owned by runtime) */
size_t bytes; /**< Total bytes reserved */
physics_analytics_header_t *header; /**< Shared header */
uint8_t *ring; /**< Event ring base */
size_t ring_bytes; /**< Event ring span */
uint8_t *summary; /**< Summary/statistics region */
size_t summary_bytes; /**< Summary region span */
uint8_t *scratch; /**< Scratch/reserved region */
size_t scratch_bytes; /**< Scratch region span */
} physics_analytics_heap_t;
/*
* @brief Initialise physics runtime services.
* @param analytics_heap_bytes Desired heap size (0 -> default 10 MiB)
* @return 0 on success, -1 on failure
*/
int physics_runtime_init(size_t analytics_heap_bytes);
/**
* @brief Tear down physics runtime services and release heap storage.
*/
void physics_runtime_shutdown(void);
/*
* @brief Capture a host snapshot.
* @param out Output buffer
* @return 0 on success, -1 on failure
*/
int physics_host_snapshot(physics_host_snapshot_t *out);
/*
* @brief Publish an event into the analytics ring buffer.
* @param channel Logical event channel
* @param payload Pointer to payload bytes
* @param payload_bytes Payload length (<= ring size)
* @return 0 on success, -1 if the payload could not be enqueued
*/
int physics_analytics_publish_event(uint32_t channel, const void *payload, uint16_t payload_bytes);
/**
* @brief Retrieve the analytics heap descriptor.
* @return Pointer to heap descriptor (NULL if runtime not initialised)
*/
const physics_analytics_heap_t *physics_analytics_heap_info(void);
#ifdef __cplusplus
}
#endif
#endif /* STARFORTH_PHYSICS_RUNTIME_H */
v3/include/platform_alloc.h
+86
View File
@@ -0,0 +1,86 @@
/*
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.
*/
#ifndef STARFORTH_PLATFORM_ALLOC_H
#define STARFORTH_PLATFORM_ALLOC_H
/*
* platform_alloc.h - Portable memory allocation abstraction
*
* Host builds: Uses standard malloc/free
* Kernel builds: Uses static arena with bump allocator
*
* Usage:
* void* p = sf_malloc(size);
* sf_free(p);
* void* p2 = sf_calloc(count, size); // zero-initialized
*/
#include <stddef.h>
/*
* Allocate memory block of given size.
* Returns NULL on failure.
*/
void* sf_malloc(size_t size);
/*
* Allocate zero-initialized memory for array.
* Returns NULL on failure.
*/
void* sf_calloc(size_t count, size_t size);
/*
* Reallocate memory block to new size.
* Returns NULL on failure (original block unchanged).
*/
void* sf_realloc(void* ptr, size_t new_size);
/*
* Free previously allocated memory.
* Passing NULL is safe (no-op).
*/
void sf_free(void* ptr);
/*
* Initialize the allocator (required for kernel builds).
* Host builds: no-op.
* Kernel builds: sets up the static arena.
*
* Returns 0 on success, -1 on failure.
*/
int sf_alloc_init(void);
/*
* Get allocator statistics (for diagnostics).
*/
typedef struct sf_alloc_stats {
size_t total_bytes; /* Total arena size */
size_t used_bytes; /* Currently allocated */
size_t peak_bytes; /* High water mark */
size_t alloc_count; /* Number of allocations */
size_t free_count; /* Number of frees */
} sf_alloc_stats_t;
void sf_alloc_get_stats(sf_alloc_stats_t* stats);
#endif /* STARFORTH_PLATFORM_ALLOC_H */
v3/include/platform_io.h
+47
View File
@@ -0,0 +1,47 @@
/*
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.
*/
/*
* platform_io.h - Portable terminal-input-readiness check for StarForth
*
* One function, same shape as platform_lock.h/platform_time.h: a single
* portable declaration, implemented once per platform (POSIX select() on
* fd 0 for the hosted build, src/platform/linux/io.c; the kernel's own
* console/keyboard-event bridge for the freestanding build, shim.c).
* Backs the standard dictionary's ?TERMINAL word (io_words.c).
*/
#ifndef STARFORTH_PLATFORM_IO_H
#define STARFORTH_PLATFORM_IO_H
/**
* @brief Non-blocking check for whether a key/character is available to read.
*
* Must not block and must not consume the byte if one is found (a
* following KEY/getchar() must still return that same byte).
*
* @return 1 if input is ready, 0 otherwise
*/
int sf_terminal_ready(void);
#endif /* STARFORTH_PLATFORM_IO_H */
v3/include/platform_lock.h
+71
View File
@@ -0,0 +1,71 @@
/*
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.
*/
/*
* platform_lock.h - Portable mutex abstraction for StarForth
*/
#ifndef STARFORTH_PLATFORM_LOCK_H
#define STARFORTH_PLATFORM_LOCK_H
/* HISTORICAL: this condition also included `|| defined(L4RE_TARGET)` --
* L4Re had no pthreads either, so it shared the spinlock path with
* STARFORTH_MINIMAL. L4Re support has been removed as an active target. */
#if defined(STARFORTH_MINIMAL)
typedef struct sf_mutex
{
volatile unsigned int state;
} sf_mutex_t;
#else
#include <pthread.h>
typedef struct sf_mutex
{
pthread_mutex_t handle;
} sf_mutex_t;
#endif
int sf_mutex_init(sf_mutex_t *mutex);
void sf_mutex_destroy(sf_mutex_t *mutex);
void sf_mutex_lock(sf_mutex_t *mutex);
void sf_mutex_unlock(sf_mutex_t *mutex);
#endif /* STARFORTH_PLATFORM_LOCK_H */
v3/include/platform_time.h
+177
View File
@@ -0,0 +1,177 @@
/*
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.
*/
#ifndef STARFORTH_PLATFORM_TIME_H
#define STARFORTH_PLATFORM_TIME_H
/*
* StarForth Platform Time Abstraction
*
* Provides portable timing interface for POSIX builds. (HISTORICAL: also
* supported L4Re/StarshipOS through mid-2026; removed as an active target.)
* Uses vtable pattern similar to blkio subsystem.
*
* License: See LICENSE file
*/
#include <stdint.h>
#include <stddef.h>
#ifdef __cplusplus
extern "C" {
#endif
/* Time representation (nanoseconds since epoch) */
typedef uint64_t sf_time_ns_t;
/* Timestamp string buffer size */
#define SF_TIME_STAMP_SIZE 32
/* Platform time backend vtable */
typedef struct {
/**
* @brief Get monotonic time (for performance measurement)
* @return Nanoseconds since system boot (never decreases)
*/
sf_time_ns_t (*get_monotonic_ns)(void);
/**
* @brief Get wall-clock time
* @return Nanoseconds since Unix epoch (1970-01-01 00:00:00 UTC)
* Returns 0 if RTC unavailable
*/
sf_time_ns_t (*get_realtime_ns)(void);
/**
* @brief Set wall-clock time (may require privileges)
* @param ns_since_epoch Nanoseconds since Unix epoch
* @return 0 on success, -1 on error
*/
int (*set_realtime_ns)(sf_time_ns_t ns_since_epoch);
/**
* @brief Format timestamp as human-readable string
* @param ns_since_epoch Nanoseconds since Unix epoch
* @param buf Output buffer (SF_TIME_STAMP_SIZE bytes)
* @param format_24h Use 24-hour format (1) or 12-hour (0)
* @return 0 on success, -1 on error
*/
int (*format_timestamp)(sf_time_ns_t ns_since_epoch, char *buf, int format_24h);
/**
* @brief Check if real-time clock is available
* @return 1 if RTC available, 0 if not
*/
int (*has_rtc)(void);
} sf_time_backend_t;
/* Global backend pointer (set at initialization) */
extern const sf_time_backend_t *sf_time_backend;
/* Platform-specific backend registration */
extern const sf_time_backend_t sf_time_backend_posix; /* POSIX implementation */
extern const sf_time_backend_t sf_time_backend_l4re; /* HISTORICAL: L4Re/StarshipOS implementation, no longer wired into any build (see src/platform/l4re/time.c) */
/* Convenience wrappers (inline for zero overhead).
* Define PLATFORM_TIME_NO_INLINE before including this header to suppress
* these inline definitions (e.g. when providing concrete implementations).
* When suppressed, non-inline prototypes are declared so callers can link
* to a concrete implementation (e.g. shim.c in the kernel). */
#ifndef PLATFORM_TIME_NO_INLINE
static inline sf_time_ns_t sf_monotonic_ns(void) {
return sf_time_backend->get_monotonic_ns();
}
static inline sf_time_ns_t sf_realtime_ns(void) {
return sf_time_backend->get_realtime_ns();
}
static inline int sf_set_realtime_ns(sf_time_ns_t ns) {
return sf_time_backend->set_realtime_ns(ns);
}
static inline int sf_format_timestamp(sf_time_ns_t ns, char *buf, int format_24h) {
return sf_time_backend->format_timestamp(ns, buf, format_24h);
}
static inline int sf_has_rtc(void) {
return sf_time_backend->has_rtc();
}
#else /* PLATFORM_TIME_NO_INLINE */
/* Non-inline prototypes — provided by the platform's concrete implementation. */
sf_time_ns_t sf_monotonic_ns(void);
sf_time_ns_t sf_realtime_ns(void);
int sf_set_realtime_ns(sf_time_ns_t ns);
int sf_format_timestamp(sf_time_ns_t ns, char *buf, int format_24h);
int sf_has_rtc(void);
#endif /* PLATFORM_TIME_NO_INLINE */
/* Time conversion helpers */
static inline sf_time_ns_t sf_seconds_to_ns(uint64_t seconds) {
return seconds * 1000000000ULL;
}
static inline uint64_t sf_ns_to_seconds(sf_time_ns_t ns) {
return ns / 1000000000ULL;
}
static inline uint64_t sf_ns_to_ms(sf_time_ns_t ns) {
return ns / 1000000ULL;
}
static inline uint64_t sf_ns_to_us(sf_time_ns_t ns) {
return ns / 1000ULL;
}
/* Initialize platform time backend (call once at startup) */
void sf_time_init(void);
#ifdef __cplusplus
}
#endif
#endif /* STARFORTH_PLATFORM_TIME_H */
v3/include/profiler.h
+265
View File
@@ -0,0 +1,265 @@
/*
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.
*/
#ifndef STARFORTH_PROFILER_H
#define STARFORTH_PROFILER_H
#include <stdint.h>
#include <stddef.h>
#include <stdio.h>
/* Forward declarations */
typedef struct VM VM;
typedef struct DictEntry DictEntry;
/**
* @brief Profiling detail levels
*
* Controls the amount of profiling information collected during execution.
* Higher levels include all features from lower levels.
*/
typedef enum {
PROFILE_DISABLED = 0, /**< Profiling disabled (zero overhead) */
PROFILE_BASIC = 1, /**< Word execution frequency tracking (minimal overhead) */
PROFILE_DETAILED = 2, /**< Basic + word execution timing (5-10% overhead) */
PROFILE_VERBOSE = 3, /**< Detailed + stack/memory access patterns (15-20% overhead) */
PROFILE_FULL = 4 /**< Reserved for future use (full instrumentation) */
} ProfileLevel;
/**
* @brief Profiling measurement categories
*
* Different aspects of VM operation that can be profiled
*/
typedef enum {
PROF_VM_INIT = 0, /**< VM initialization */
PROF_VM_EXECUTE, /**< VM execution loop */
PROF_VM_COMPILE, /**< Word compilation */
PROF_DICT_LOOKUP, /**< Dictionary searches */
PROF_DICT_ADD, /**< Dictionary additions */
PROF_STACK_OPS, /**< Stack operations */
PROF_MEMORY_ACCESS, /**< Memory access operations */
PROF_WORD_EXEC, /**< Word execution */
PROF_IO_OPS, /**< I/O operations */
PROF_CONTROL_FLOW, /**< Control flow operations */
PROF_CATEGORY_COUNT /**< Total number of categories */
} ProfileCategory;
/**
* @brief Timer for measuring execution duration
*/
typedef struct {
uint64_t start_time; /**< Start timestamp */
uint64_t total_time; /**< Accumulated execution time */
uint64_t call_count; /**< Number of measurements */
uint64_t min_time; /**< Minimum recorded time */
uint64_t max_time; /**< Maximum recorded time */
const char *name; /**< Timer identifier */
} ProfileTimer;
/**
* @brief Execution statistics for a single word
*/
typedef struct {
const char *word_name; /**< Name of the profiled word */
uint64_t total_time; /**< Total execution time */
uint64_t call_count; /**< Number of executions */
uint64_t avg_time; /**< Average execution time */
uint64_t min_time; /**< Minimum execution time */
uint64_t max_time; /**< Maximum execution time */
double percentage; /**< Percentage of total runtime */
} WordProfile;
/* Memory access pattern tracking */
typedef struct {
uint64_t reads;
uint64_t writes;
uint64_t cache_hits;
uint64_t cache_misses;
uint64_t total_bytes_read;
uint64_t total_bytes_written;
} MemoryProfile;
/* Main profiler state */
typedef struct {
ProfileLevel level;
uint64_t profiling_overhead;
uint64_t total_execution_time;
/* Category timers */
ProfileTimer category_timers[PROF_CATEGORY_COUNT];
/* Word execution tracking */
WordProfile *word_profiles;
size_t word_profile_count;
size_t word_profile_capacity;
/* Memory access tracking */
MemoryProfile memory_stats;
/* Hot path detection */
uint64_t instruction_count;
uint64_t branch_count;
uint64_t loop_iterations;
/* Performance counters */
struct {
uint64_t vm_cycles;
uint64_t dict_lookups;
uint64_t stack_operations;
uint64_t memory_allocations;
uint64_t compile_operations;
} counters;
} Profiler;
/* Global profiler instance */
extern void *g_profiler;
/* Profiler lifecycle */
/**
* @brief Initialize the profiling system
* @param level Initial profiling detail level
* @return 0 on success, non-zero on failure
*/
int profiler_init(ProfileLevel level);
/**
* @brief Shutdown and cleanup the profiling system
*/
void profiler_shutdown(void);
/**
* @brief Reset all profiling statistics
*/
void profiler_reset(void);
/**
* @brief Change the current profiling detail level
* @param level New profiling level to set
*/
void profiler_set_level(ProfileLevel level);
/* Timing functions */
uint64_t profiler_get_time_ns(void);
void profiler_start_timer(ProfileCategory category);
void profiler_end_timer(ProfileCategory category);
/* Word profiling */
/**
* @brief Start timing a word execution (PROFILE_DETAILED+)
* @param entry Dictionary entry of the word being executed
*/
void profiler_word_enter(const DictEntry *entry);
/**
* @brief End timing a word execution (PROFILE_DETAILED+)
* @param entry Dictionary entry of the word being executed
*/
void profiler_word_exit(const DictEntry *entry);
/**
* @brief Track word execution frequency without timing (PROFILE_BASIC+)
* @param entry Dictionary entry of the word being executed
*
* This is a lightweight alternative to profiler_word_enter/exit that only
* increments call counters without timing overhead. Ideal for identifying
* hot words (frequently executed) for optimization.
*/
void profiler_word_count(const DictEntry *entry);
/* Memory profiling */
void profiler_memory_read(size_t bytes);
void profiler_memory_write(size_t bytes);
void profiler_memory_alloc(size_t bytes);
/* Counter increments */
void profiler_inc_vm_cycles(uint64_t cycles);
void profiler_inc_dict_lookup(void);
void profiler_inc_stack_op(void);
void profiler_inc_branch(void);
void profiler_inc_loop_iter(void);
/* Analysis and reporting */
void profiler_generate_report(void);
void profiler_print_summary(void);
void profiler_print_word_analysis(void);
void profiler_print_memory_analysis(void);
void profiler_print_hotspots(void);
/* Performance optimization suggestions */
void profiler_analyze_performance(VM *vm);
void profiler_suggest_optimizations(void);
/* Profiler macros for easy integration */
#define PROFILE_ENABLED() (0)
#define PROFILE_START(category) ((void)0)
#define PROFILE_END(category) ((void)0)
#define PROFILE_WORD_ENTER(name) ((void)0)
#define PROFILE_WORD_EXIT(name) ((void)0)
#define PROFILE_MEMORY_READ(bytes) ((void)0)
#define PROFILE_MEMORY_WRITE(bytes) ((void)0)
#define PROFILE_INC_CYCLES(n) ((void)0)
#define PROFILE_INC_DICT_LOOKUP() ((void)0)
#define PROFILE_INC_STACK_OP() ((void)0)
/* Scoped profiling helper */
typedef struct {
ProfileCategory category;
const char *word_name;
} ProfileScope;
#endif /* STARFORTH_PROFILER_H */
v3/include/q48_16.h
+305
View File
@@ -0,0 +1,305 @@
/*
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.
*/
#ifndef Q48_16_H
#define Q48_16_H
#include <stdint.h>
/* ============================================================================
* Q48.16 Fixed-Point Arithmetic
* ============================================================================
*
* Format: uint64_t with fixed decimal point after bit 15
* - Bits 0-15: Fractional part (1/65536 resolution)
* - Bits 16-63: Integer part (up to 2^48-1)
*
* Example: 0x00010000 = 1.0, 0x00018000 = 1.5, 0x00010001 = 1 + 1/65536
*
* All operations are integer-only: no floating-point, no transcendental functions.
* Used for inference engine calculations (variance, regression, diagnostics).
*
* Why Q48.16?
* - 48-bit integer range: 0 to 281,474,976,710,655 (enough for VM metrics)
* - 16-bit fractional: ~0.0000152 resolution (precise enough for statistical calculations)
* - Perfect fit for 64-bit uint64_t: efficient on modern CPUs
*/
typedef uint64_t q48_16_t;
/* ============================================================================
* Core Arithmetic Operations (All Q48.16 ↔ Q48.16)
* ============================================================================
*/
/*
* @brief Multiply two Q48.16 values, keeping result in Q48.16
*
* Math: (a / 2^16) * (b / 2^16) * 2^16 = (a * b) / 2^16
* Returns: (a * b) >> 16
*
* @param a First Q48.16 operand
* @param b Second Q48.16 operand
* @return (a * b) >> 16 in Q48.16 format
*/
q48_16_t q48_mul(q48_16_t a, q48_16_t b);
/*
* @brief Divide two Q48.16 values, keeping result in Q48.16
*
* Math: (a / 2^16) / (b / 2^16) * 2^16 = (a << 16) / b
* Returns: (a << 16) / b
*
* @param a Dividend in Q48.16
* @param b Divisor in Q48.16 (non-zero)
* @return (a << 16) / b in Q48.16 format
*/
q48_16_t q48_div(q48_16_t a, q48_16_t b);
/* Guard: skip static inlines already provided by include/starkernel/q48_16.h
* (both headers share the same definitions; STARKERNEL_Q48_16_H is defined
* by the kernel version so we avoid -Werror redefinition in mixed builds). */
#ifndef STARKERNEL_Q48_16_H
/**
* @brief Add two Q48.16 values
*
* Math: (a / 2^16) + (b / 2^16) = (a + b) / 2^16
* Returns: a + b (no shift needed, both have same scaling)
*
* @param a First Q48.16 operand
* @param b Second Q48.16 operand
* @return a + b in Q48.16 format
*/
static inline q48_16_t q48_add(q48_16_t a, q48_16_t b) {
return a + b;
}
/**
* @brief Subtract two Q48.16 values
*
* Math: (a / 2^16) - (b / 2^16) = (a - b) / 2^16
* Returns: a - b (no shift needed)
*
* @param a Minuend in Q48.16
* @param b Subtrahend in Q48.16
* @return a - b in Q48.16 format
*/
static inline q48_16_t q48_sub(q48_16_t a, q48_16_t b) {
return a - b;
}
/**
* @brief Absolute value of Q48.16
*
* @param a Q48.16 value
* @return |a| in Q48.16 format
*/
static inline q48_16_t q48_abs(q48_16_t a) {
return (a < 0x8000000000000000ULL) ? a : (0ULL - a);
}
/* ============================================================================
* Conversion Operations (u64 ↔ Q48.16)
* ============================================================================
*/
/**
* @brief Convert unsigned 64-bit integer to Q48.16
*
* Math: u * 2^16 (shift left by 16 bits)
* Example: q48_from_u64(1) = 0x10000 (1.0 in Q48.16)
*
* @param u Unsigned 64-bit integer (max 2^48-1 to avoid overflow)
* @return u << 16 in Q48.16 format
*/
static inline q48_16_t q48_from_u64(uint64_t u) {
return u << 16;
}
/**
* @brief Convert Q48.16 to a 64-bit integer (truncate fractional)
*
* Math: q / 2^16 (arithmetic shift right by 16 bits)
* Example: q48_to_u64(0x10000) = 1, q48_to_u64(-0x10000) = -1
*
* q48_16_t values are two's-complement signed under the hood (q48_neg/
* q48_abs already treat them that way); a plain unsigned (logical) shift
* would corrupt negative inputs instead of sign-extending them, so this
* shifts via a signed intermediate. Bit-identical to the old behavior for
* non-negative q (the only case this function's other caller, the
* inference engine's sum-of-squares accumulation, ever produces).
*
* @param q Q48.16 value
* @return q >> 16, sign-extended, reinterpreted as uint64_t
*/
static inline uint64_t q48_to_u64(q48_16_t q) {
return (uint64_t)(((int64_t)q) >> 16);
}
#endif /* STARKERNEL_Q48_16_H */
/*
* @brief Convert double to Q48.16 (for testing/initialization only)
*
* NOT used in inference engine (inference is integer-only).
* Provided for testing and diagnostic tools only.
*
* @param d Double-precision float
* @return d * 2^16 as Q48.16
*/
q48_16_t q48_from_double(double d);
/*
* @brief Convert Q48.16 to double (for testing/diagnostics only)
*
* NOT used in inference engine (inference is integer-only).
* Provided for logging and RStudio dashboard output.
*
* @param q Q48.16 value
* @return q / 2^16 as double
*/
double q48_to_double(q48_16_t q);
/* ============================================================================
* Approximation Operations (Integer-Only)
* ============================================================================
*/
/*
* @brief Approximate natural logarithm in Q48.16 (integer-only)
*
* Purpose: Required for decay slope inference via exponential fitting
* Model: ln(heat[t]) = ln(h0) - slope*t
*
* Method: Piecewise linear approximation or Newton-Raphson iteration
* - Input x must be > 0 (assertion check)
* - Output is ln(x) in Q48.16 format
* - Precision: ~5% error acceptable (tuning parameter)
* - No floating-point operations
*
* Implementation Strategy:
* 1. Use bit position (floor(log2(x))) as coarse estimate
* 2. Refine with Newton iteration (3-4 cycles for Q48.16 precision)
* 3. Keep all arithmetic in integer space
*
* Example: q48_log_approx(65536) = log(1.0) in Q48.16 ≈ 0
* q48_log_approx(131072) = log(2.0) in Q48.16 ≈ 0x0000B172
*
* @param x Value to take logarithm of (x > 0)
* @return ln(x) in Q48.16 format
*/
q48_16_t q48_log_approx(uint64_t x);
/*
* @brief Approximate exponential e^x in Q48.16 (integer-only, future use)
*
* Purpose: Might be needed for inverse operations or model validation
* Status: Defined but not required for Phase 1 inference engine
* Method: Similar to q48_log_approx (piecewise + Newton)
*
* @param q Q48.16 exponent
* @return e^q in Q48.16 format
*/
q48_16_t q48_exp_approx(q48_16_t q);
/*
* @brief Approximate square root in Q48.16 (integer-only)
*
* Purpose: Compute R² (fit quality) for regression diagnostics
* Method: Newton-Raphson for integer-only sqrt
*
* @param q Q48.16 value
* @return sqrt(q) in Q48.16 format
*/
q48_16_t q48_sqrt_approx(q48_16_t q);
/*
* @brief Approximate sin(q) in Q48.16 (integer-only, Taylor series)
*
* Purpose: Console drawing fabric's CIRCLE/ARC/ELLIPSE (FABRIC-0.md item 4.3.3b)
* Method: Range-reduce into [-pi, pi], then Taylor series
*
* @param q Angle in Q48.16 format (radians, any magnitude)
* @return sin(q) in Q48.16 format
*/
q48_16_t q48_sin_approx(q48_16_t q);
/*
* @brief Approximate cos(q) in Q48.16 (integer-only, Taylor series)
*
* Purpose: Console drawing fabric's CIRCLE/ARC/ELLIPSE (FABRIC-0.md item 4.3.3b)
* Method: Range-reduce into [-pi, pi], then Taylor series
*
* @param q Angle in Q48.16 format (radians, any magnitude)
* @return cos(q) in Q48.16 format
*/
q48_16_t q48_cos_approx(q48_16_t q);
/* ============================================================================
* Diagnostic / Testing Utilities
* ============================================================================
*/
/*
* @brief Pretty-print Q48.16 value to string for debugging
*
* Format: "integer.fractional" (e.g., "1.50000")
* Uses internal static buffer - NOT thread-safe
*
* @param q Q48.16 value
* @return Pointer to static string (valid until next call)
*/
const char* q48_to_string(q48_16_t q);
/*
* @brief Validate Q48.16 value is within safe range
*
* Checks: Does not overflow on mul/div operations
* Returns: 1 if valid, 0 if risky
*
* @param q Q48.16 value
* @return 1 if safe, 0 if risky
*/
int q48_is_valid(q48_16_t q);
#endif /* Q48_16_H */
v3/include/repl.h
+55
View File
@@ -0,0 +1,55 @@
/*
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.
*/
#ifndef REPL_H
#define REPL_H
#include "vm.h"
/*
* @brief Starts the REPL (Read-Eval-Print Loop) for the Forth virtual machine
* @param vm Pointer to the VM instance to run the REPL on
* @param script_mode If 1, suppress prompts and "ok" output (for piped input)
*/
void vm_repl(VM *vm, int script_mode);
#endif /* REPL_H */
v3/include/rolling_window_knobs.h
+205
View File
@@ -0,0 +1,205 @@
/*
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 ***
rolling_window_knobs.h - Tunable Adaptive Shrinking Control
Knobs that control how the rolling window automatically learns and adapts
its size during execution. These are NOT the initial window size - they
control the self-tuning behavior.
All knobs are tunable via Makefile:
make ADAPTIVE_SHRINK_RATE=30 (shrink by 30% instead of default)
make ADAPTIVE_MIN_WINDOW_SIZE=512 (never shrink below 512)
etc.
*/
#ifndef ROLLING_WINDOW_KNOBS_H
#define ROLLING_WINDOW_KNOBS_H
#include "starforth_config.h"
/* ============================================================================
* Knob #8: ADAPTIVE_SHRINK_RATE - How aggressively to shrink the window
* ============================================================================
*
* When pattern diversity plateaus, the window shrinks by this percentage.
*
* Value: 0-99 (percentage to retain, not discard)
* ADAPTIVE_SHRINK_RATE=75 → shrink to 75% of current size (discard 25%)
* ADAPTIVE_SHRINK_RATE=50 → shrink to 50% of current size (discard 50%)
* ADAPTIVE_SHRINK_RATE=90 → shrink to 90% of current size (discard 10%)
*
* Rationale:
* Higher (90+): Conservative, slow learning, larger final window
* Default (75): Balanced - learns in 3-4 shrink cycles
* Lower (50): Aggressive, fast learning, minimal final window
*
* Trade-off:
* Higher = safer (more pattern capture margin, slower adaptation)
* Lower = leaner (less memory overhead, faster optimization)
*
* Default: see starforth_config.h (STARFORTH_CONFIG_ADAPTIVE_SHRINK_RATE_DEFAULT)
* Range: 50-95 (below 50 is too aggressive, above 95 barely shrinks)
*
* Tuning: make ADAPTIVE_SHRINK_RATE=80
*/
/* ============================================================================
* Knob #9: ADAPTIVE_MIN_WINDOW_SIZE - Minimum window size (safety floor)
* ============================================================================
*
* The window will never shrink below this size, even if diversity plateaus.
* Prevents over-optimization that might miss emerging patterns.
*
* Value: 64-2048 (in word IDs, not bytes)
* ADAPTIVE_MIN_WINDOW_SIZE=256 → don't shrink below 256
* ADAPTIVE_MIN_WINDOW_SIZE=128 → don't shrink below 128
* ADAPTIVE_MIN_WINDOW_SIZE=512 → don't shrink below 512
*
* Rationale:
* Smaller (128): Lean optimization, accept lower pattern capture
* Default (256): Balanced - typical workload needs 200-250 patterns
* Larger (512): Conservative, handles complex workloads
*
* Trade-off:
* Smaller = less memory, risk of missing edge-case patterns
* Larger = more memory, safer for unpredictable workloads
*
* Default: see starforth_config.h (STARFORTH_CONFIG_ADAPTIVE_MIN_WINDOW_SIZE_DEFAULT)
* Range: 64-1024
*
* Tuning: make ADAPTIVE_MIN_WINDOW_SIZE=512
*/
/* ============================================================================
* Knob #10: ADAPTIVE_CHECK_FREQUENCY - How often to check diversity
* ============================================================================
*
* The system checks pattern diversity every N executions.
* More frequent checks = faster response to saturation, more overhead.
*
* Value: 32-1024 (execution count between checks)
* ADAPTIVE_CHECK_FREQUENCY=128 → check after every 128 executions
* ADAPTIVE_CHECK_FREQUENCY=256 → check after every 256 executions
* ADAPTIVE_CHECK_FREQUENCY=512 → check after every 512 executions
*
* Rationale:
* More frequent (128): Responsive learning, detects saturation quickly
* Default (256): Balanced - good responsiveness, minimal overhead
* Less frequent (512): Lazy learning, smaller monitoring overhead
*
* Trade-off:
* More = faster adaptation, slightly more computation
* Less = slower adaptation, minimal overhead
*
* Default: see starforth_config.h (STARFORTH_CONFIG_ADAPTIVE_CHECK_FREQUENCY_DEFAULT)
* Range: 32-1024
*
* Tuning: make ADAPTIVE_CHECK_FREQUENCY=128
*/
/* ============================================================================
* Knob #11: ADAPTIVE_GROWTH_THRESHOLD - Pattern growth rate that signals saturation
* ============================================================================
*
* When pattern diversity growth drops below this rate, window can shrink.
* Expressed as percentage (0-100).
*
* Value: 0-10 (as percentage, 0=0%, 10=10%)
* ADAPTIVE_GROWTH_THRESHOLD=1 → shrink when growth < 1% (aggressive)
* ADAPTIVE_GROWTH_THRESHOLD=2 → shrink when growth < 2% (default, balanced)
* ADAPTIVE_GROWTH_THRESHOLD=5 → shrink when growth < 5% (conservative)
*
* Rationale:
* Lower (0.5%): Very aggressive, assumes patterns found early
* Default (1%): Balanced - empirically tested, works well
* Higher (5%): Conservative, waits for stronger saturation signal
*
* Trade-off:
* Lower = eager shrinking, risk of missing late-arriving patterns
* Higher = cautious shrinking, longer time to final window size
*
* Default: see starforth_config.h (STARFORTH_CONFIG_ADAPTIVE_GROWTH_THRESHOLD_DEFAULT)
* Range: 0-10
*
* Note: Internally, this is applied as: growth_rate < (threshold / 100.0)
* E.g., ADAPTIVE_GROWTH_THRESHOLD=1 means growth_rate < 0.01
*
* Tuning: make ADAPTIVE_GROWTH_THRESHOLD=2
*/
/* ============================================================================
* Summary Table: How Knobs Interact
* ============================================================================
*
* Scenario 1: "Fast Learning, Lean Final Size"
* ADAPTIVE_SHRINK_RATE=50
* ADAPTIVE_MIN_WINDOW_SIZE=128
* ADAPTIVE_CHECK_FREQUENCY=128
* ADAPTIVE_GROWTH_THRESHOLD=0
* → Shrinks aggressively, frequently, to minimal size
* → Best for: Memory-constrained systems, simple workloads
*
* Scenario 2: "Balanced (Default)" -- see starforth_config.h for the exact
* shipped default of each knob; illustrative values below.
* ADAPTIVE_SHRINK_RATE=50
* ADAPTIVE_MIN_WINDOW_SIZE=256
* ADAPTIVE_CHECK_FREQUENCY=512
* ADAPTIVE_GROWTH_THRESHOLD=5
* → Good balance, typical FORTH programs
* → Best for: General-purpose systems
*
* Scenario 3: "Conservative, Safe"
* ADAPTIVE_SHRINK_RATE=90
* ADAPTIVE_MIN_WINDOW_SIZE=512
* ADAPTIVE_CHECK_FREQUENCY=512
* ADAPTIVE_GROWTH_THRESHOLD=5
* → Slow, cautious shrinking, large safety margin
* → Best for: Complex workloads, unpredictable patterns
*
*/
#endif /* ROLLING_WINDOW_KNOBS_H */
v3/include/rolling_window_of_truth.h
+265
View File
@@ -0,0 +1,265 @@
/*
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 ***
rolling_window_of_truth.h - Execution history for deterministic metrics seeding
The "Rolling Window of Truth" captures actual execution sequences to:
1. Seed initial metrics after POST (hot-words cache, pipelining context)
2. Provide deterministic record of all word executions
3. Enable reproducible, provable optimization decisions
4. Form foundation for formal verification (Isabelle/HOL)
Vision: Every decision is observable, traceable, and mathematically provable.
*/
#ifndef ROLLING_WINDOW_OF_TRUTH_H
#define ROLLING_WINDOW_OF_TRUTH_H
#include <stdint.h>
#include "vm.h"
/* ============================================================================
* Rolling Window of Truth
* ============================================================================
*
* Circular buffer of word IDs representing recent execution sequence.
* Used to:
* 1. Seed metrics after POST completes
* 2. Provide execution context for pipelining decisions
* 3. Enable reproducibility and formal verification
*
* NOTE: Structure is defined in vm.h to avoid circular includes.
* See vm.h for structure definition and ROLLING_WINDOW_SIZE constant.
*/
/* ============================================================================
* Rolling Window API
* ============================================================================
*/
/*
* Initialize rolling window of truth.
* Called during VM initialization.
*
* @param window Pointer to uninitialized RollingWindowOfTruth
* @return 0 on success, -1 on malloc failure
*/
int rolling_window_init(RollingWindowOfTruth * window);
/*
* Record a word execution in the rolling window.
* Called after each word executes (in inner interpreter).
*
* THREAD SAFETY: This function is NOT thread-safe. Caller MUST hold
* vm->tuning_lock when calling from multiple threads (main VM + heartbeat).
*
* Called from:
* - Main VM thread (inner interpreter loop, src/vm.c:1162)
* - Heartbeat worker thread (through rolling_window_service, src/vm.c:743)
*
* MUST ALWAYS be protected by:
* sf_mutex_lock(&vm->tuning_lock);
* rolling_window_record_execution(&vm->rolling_window, word_id);
* sf_mutex_unlock(&vm->tuning_lock);
*
* Extremely lightweight (constant time):
* - Write to circular buffer
* - Increment counters
* - 2-3 CPU cycles (plus lock overhead ~100 cycles uncontended)
*
* @param window Rolling window to update
* @param word_id Word that just executed
* @return 0 on success, -1 on error
*/
int rolling_window_record_execution(RollingWindowOfTruth* window, uint32_t word_id);
/*
* Get recent execution sequence for context.
* Returns pointer to last N words (or fewer if not enough executions yet).
*
* @param window Rolling window
* @param depth How many previous words to return (1 to ROLLING_WINDOW_SIZE)
* @param out_sequence Output array (caller allocates, must be >= depth)
* @return Number of words written to out_sequence (may be < depth if cold start)
*/
uint32_t rolling_window_get_recent_sequence(const RollingWindowOfTruth* window,
uint32_t depth,
uint32_t* out_sequence);
/*
* Get most frequent word in rolling window.
* Useful for identifying hot words immediately after POST.
*
* @param window Rolling window
* @param dict_size Total number of words in dictionary (for bounds check)
* @return Word ID of most frequent execution, or 0 if window not warm
*/
uint32_t rolling_window_find_hottest_word(const RollingWindowOfTruth* window,
uint32_t dict_size);
/*
* Get transition frequency: how often word_b follows word_a in window.
*
* Useful for seeding pipelining context predictions.
*
* @param window Rolling window
* @param word_a First word in sequence
* @param word_b Second word in sequence
* @return Count of (word_a → word_b) transitions in window
*/
uint64_t rolling_window_count_transition(const RollingWindowOfTruth* window,
uint32_t word_a,
uint32_t word_b);
/*
* Check if window is warm (contains representative data).
* Seeding functions should check this before using window data.
*
* @param window Rolling window
* @return 1 if window is warm (>= ROLLING_WINDOW_SIZE executions), 0 otherwise
*/
int rolling_window_is_warm(const RollingWindowOfTruth* window);
/*
* Get detailed statistics string for diagnostics.
*
* @param window Rolling window
* @return Formatted string (caller must free)
*/
char* rolling_window_stats_string(const RollingWindowOfTruth* window);
/*
* Reset rolling window (clear all data).
*
* @param window Rolling window to reset
*/
void rolling_window_reset(RollingWindowOfTruth * window);
/*
* Free all memory allocated for rolling window.
* Called during VM cleanup.
*
* @param window Rolling window to clean up
*/
void rolling_window_cleanup(RollingWindowOfTruth * window);
/* ============================================================================
* Bootstrap Data Analysis API
* ============================================================================
*
* Used to analyze rolling window data and determine statistically significant
* window sizes for cold-start systems (un-physics VM).
*/
/*
* Export full execution history for external analysis.
* Used by bootstrap analyzer to determine optimal window size.
*
* Returns the complete circular buffer linearized in chronological order.
* Caller allocates output buffer; function fills it with execution sequence.
*
* @param window Rolling window to export
* @param out_sequence Output buffer (caller allocates, must be >= total_executions)
* @param max_count Maximum entries to write
* @return Number of word IDs written to out_sequence
*/
uint64_t rolling_window_export_execution_history(const RollingWindowOfTruth* window,
uint32_t* out_sequence,
uint64_t max_count);
/*
* Analyze pattern capture rate for a given window size.
* Measures what percentage of unique transitions are captured.
*
* Algorithm:
* 1. Scan execution history with sliding window of given size
* 2. Count unique (context, next_word) patterns observed
* 3. Return: (patterns_captured / total_unique_patterns) * 100
*
* Used for offline analysis to determine reasonable starting window size.
*
* @param window Rolling window with execution data
* @param test_window_size Window size to test (e.g., 256, 512, 1024)
* @return Pattern capture rate (0-100%)
*/
double rolling_window_pattern_capture_rate(const RollingWindowOfTruth* window,
uint32_t test_window_size);
/* ============================================================================
* Adaptive Window Sizing API
* ============================================================================
*
* Automatic continuous self-tuning of window size during execution.
* Called automatically during normal operation - no user intervention needed.
*/
/*
* Measure pattern diversity in rolling window.
* Counts unique adjacent transitions (word_a → word_b) to indicate workload variability.
*
* Used by dictionary heat optimization to decide lookup strategy:
* - High diversity (>70) = use heat-aware lookup (patterns are varied)
* - Low diversity (<30) = use naive lookup (patterns are stable)
*
* @param window Rolling window to analyze
* @return Count of unique transitions in window
*/
uint64_t rolling_window_measure_diversity(const RollingWindowOfTruth* window);
/*
* Check and apply adaptive window shrinking.
* Called periodically by rolling_window_record_execution.
* Measures pattern diversity and shrinks window if diminishing returns detected.
*
* This function is called automatically - users never invoke it directly.
* It runs every 256 executions after window becomes warm.
*
* @param window Rolling window (modified in-place if shrinking occurs)
*/
void rolling_window_check_adaptive_shrink(RollingWindowOfTruth* window);
void rolling_window_service(RollingWindowOfTruth* window);
#endif /* ROLLING_WINDOW_OF_TRUTH_H */
v3/include/ssm_jacquard.h
+267
View File
@@ -0,0 +1,267 @@
/*
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.
*/
#ifndef SSM_JACQUARD_H
#define SSM_JACQUARD_H
#include <stdint.h>
#include "compudynamics.h"
#include "starforth_config.h"
/* ============================================================================
* SSM L8: Jacquard Mode Selector (Data-Driven Architecture)
* ============================================================================
*
* Based on 2^7 DoE with 300 reps (128 configurations, 38,400 total runs).
* Top 5% analysis reveals optimal loop combinations for speed + stability.
*
* Architecture (Experimentally Validated):
* - L1 (heat_tracking): DISABLED (harmful in 86% of top configs)
* - L4 (pipelining_metrics): DISABLED (harmful in 100% of top configs)
* - L7 (adaptive_heartrate): ALWAYS ON (beneficial in 71% of top configs)
* - L2, L3, L5, L6: Runtime-controlled by L8 (workload-dependent)
* - L8 (Jacquard): 4-bit selector (16 modes) controlling L2/L3/L5/L6
*
* L8 operates as a multi-dimensional classifier:
* L2 (window): ON if entropy > 0.75 (diversity tracking)
* L3 (decay): ON if temporal_decay > 0.5 (temporal locality)
* L5 (window_inf): ON if cv > 0.15 (variance adaptation)
* L6 (decay_inf): ON if cv > 0.15 AND temporal_decay > 0.3
*
* Top 5% Validated Modes:
* C4 (0100): L2=0, L3=1, L5=0, L6=0 - Temporal locality
* C7 (0111): L2=0, L3=1, L5=1, L6=1 - Full inference
* C9 (1001): L2=1, L3=0, L5=0, L6=1 - Diverse + decay_inf
* C11 (1011): L2=1, L3=0, L5=1, L6=1 - Diverse + inference
* C12 (1100): L2=1, L3=1, L5=0, L6=0 - Diverse + temporal
*/
/* ============================================================================
* L8 Mode Definitions (4-bit: L2/L3/L5/L6)
* ============================================================================
*/
typedef enum {
/* Bits: L2 L3 L5 L6 */
SSM_MODE_C0 = 0x0, /* 0000: Minimal (stable/predictable workloads) */
SSM_MODE_C1 = 0x1, /* 0001: L6 only (decay inference) */
SSM_MODE_C2 = 0x2, /* 0010: L5 only (window inference) */
SSM_MODE_C3 = 0x3, /* 0011: L5+L6 (volatile workloads) */
SSM_MODE_C4 = 0x4, /* 0100: L3 only (temporal locality) ✅ TOP 5% */
SSM_MODE_C5 = 0x5, /* 0101: L3+L6 (temporal + decay_inf) */
SSM_MODE_C6 = 0x6, /* 0110: L3+L5 (temporal + window_inf) */
SSM_MODE_C7 = 0x7, /* 0111: L3+L5+L6 (full inference) ✅ TOP 5% */
SSM_MODE_C8 = 0x8, /* 1000: L2 only (high diversity) */
SSM_MODE_C9 = 0x9, /* 1001: L2+L6 (diverse + decay_inf) ✅ TOP 5% */
SSM_MODE_C10 = 0xA, /* 1010: L2+L5 (diverse + window_inf) */
SSM_MODE_C11 = 0xB, /* 1011: L2+L5+L6 (diverse + inference) ✅ TOP 5% */
SSM_MODE_C12 = 0xC, /* 1100: L2+L3 (diverse + temporal) ✅ TOP 5% */
SSM_MODE_C13 = 0xD, /* 1101: L2+L3+L6 (complex workload) */
SSM_MODE_C14 = 0xE, /* 1110: L2+L3+L5 (full adaptive, no decay_inf) */
SSM_MODE_C15 = 0xF /* 1111: L2+L3+L5+L6 (full adaptive, all on) */
} ssm_l8_mode_t;
/* ============================================================================
* L8 Metrics (Input to Mode Selection)
* ============================================================================
*/
typedef struct {
double entropy; /* Rolling-window entropy/diversity (0.0-1.0) */
double cv; /* Coefficient of variation (short-term volatility) */
double temporal_decay; /* Temporal locality strength (0.0-1.0) */
double stability_score; /* Combined stability metric for hysteresis */
int inference_ran_this_tick; /* 1 if inference engine ran this tick */
int inference_early_exited; /* 1 if inference early-exited (ANOVA stable) */
} ssm_l8_metrics_t;
/* ============================================================================
* SSM Configuration (L1-L7 Mode Bits)
* ============================================================================
*
* L1/L4/L7 were runtime-inert until this field expansion: the adaptive
* table (SsmConfigTable, below) always selected across the full 128-config
* (7-bit) space, but ssm_apply_mode_from_table() and its per-tick scoring
* counterpart only ever wrote 4 of those 7 bits out here, so L1/L4/L7 were computed by
* the bandit's UCB selection and then silently discarded before reaching
* any real gate -- those three loops were governed purely by compile-time
* macros (ENABLE_HOTWORDS_CACHE, ENABLE_PIPELINING, HEARTBEAT_THREAD_ENABLED)
* for the whole process lifetime. Adding these fields, and wiring them at
* their four call sites alongside (not instead of) the compile-time macros,
* makes the bandit's full selection actually take effect. */
typedef struct {
int L1_heat_tracking; /* 1 = hotwords cache active, 0 = off */
int L2_rolling_window; /* 1 = window tracking active, 0 = off */
int L3_linear_decay; /* 1 = decay active, 0 = off */
int L4_pipelining; /* 1 = pipelining metrics active, 0 = off */
int L5_window_inference; /* 1 = window inference active, 0 = off */
int L6_decay_inference; /* 1 = decay inference active, 0 = off */
int L7_adaptive_heartrate; /* 1 = heartbeat thread active, 0 = off */
} ssm_config_t;
/* ============================================================================
* L8 Configuration Thresholds (Data-Driven from DoE)
* ============================================================================
* Defaults live in starforth_config.h (included above), the single source
* of truth for VM build-time defaults; overridable via -D exactly as before.
*/
/* ============================================================================
* Adaptive Table Constants (L8 Heat-Ranked 128-Config Selector)
* One clock only: the heartbeat tick (rev r). Scoring and UCB reselection
* both run every tick -- no derived multi-tick batching unit exists
* anywhere in this mechanism. The score/UCB/reward/weight constants live
* in cd_tuning_word() (compudynamics.h/.c) now, not here -- this is the
* word-level instantiation of the generic compudynamics module (rev s).
* ============================================================================
*/
/* ============================================================================
* 7-bit Config Bit Positions (b6=L1, b5=L2, b4=L3, b3=L4, b2=L5, b1=L6, b0=L7)
* ============================================================================
*/
#define SSM_CFG_L1 0x40u
#define SSM_CFG_L2 0x20u
#define SSM_CFG_L3 0x10u
#define SSM_CFG_L4 0x08u
#define SSM_CFG_L5 0x04u
#define SSM_CFG_L6 0x02u
#define SSM_CFG_L7 0x01u
/* ============================================================================
* L8 State (extended with adaptive table pointer)
* ============================================================================
*
* The adaptive table itself (CDConfigEntry/CDConfigTable) is the generic
* compudynamics bandit (compudynamics.h), sized to 128 configs x 8 regimes
* via cd_tuning_word() -- see ssm_l8_init_table().
*/
typedef struct {
ssm_l8_mode_t current_mode; /* Mirrored from table for diagnostics */
uint32_t hysteresis_counter; /* Legacy threshold mode hysteresis */
ssm_l8_mode_t pending_mode; /* Legacy threshold mode pending */
CDConfigTable *table; /* NULL = legacy threshold; non-NULL = adaptive */
} ssm_l8_state_t;
/* ============================================================================
* L8 API
* ============================================================================
*/
/**
* @brief Initialize L8 state (legacy fields only; call ssm_l8_init_table separately)
*/
void ssm_l8_init(ssm_l8_state_t *state, ssm_l8_mode_t initial_mode);
/**
* @brief Allocate and seed the adaptive config table
* Sets state->table; must be called after ssm_l8_init().
* On allocation failure, state->table remains NULL (legacy mode is used).
*/
void ssm_l8_init_table(ssm_l8_state_t *state);
/**
* @brief Free the adaptive config table
*/
void ssm_l8_free_table(ssm_l8_state_t *state);
/*
* @brief Per-tick update for the adaptive table path
*
* Classifies the current regime, scores the current config from this
* tick's outcome, and UCB-reselects -- every call, no batching -- and
* applies the selected config to ssm_config_t.
*
* The locality component of the regime classification (and of the
* joint-convergence reward signal) is computed here from recent_word_ids
* via cd_classify_ids() -- purely execution-count-derived, no wall-clock
* input. This replaced a decay-slope-derived temporal_decay signal (rev
* r) that made L8's regime classification wall-clock-tainted once it ran
* every tick instead of once per ~2000 ticks, breaking cross-architecture
* dict_hash determinism under QEMU/TCG's differing real emulation speed
* per ISA (rev s).
*
* @param state L8 state (must have state->table != NULL)
* @param metrics Current runtime metrics (entropy, cv, inference status)
* @param config SSM config updated this tick
* @param current_window VM's effective_window_size this tick
* @param recent_word_ids Recent word-execution-ID history, oldest first
* (e.g. from rolling_window_get_recent_sequence())
* @param recent_word_ids_count Number of valid entries in recent_word_ids
*/
void ssm_l8_update_table(ssm_l8_state_t *state, const ssm_l8_metrics_t *metrics,
ssm_config_t *config,
uint32_t current_window,
const uint32_t *recent_word_ids, uint32_t recent_word_ids_count);
/**
* @brief Apply the current table config to ssm_config_t
* Used on first tick to set the initial DoE-seeded config immediately.
*/
void ssm_apply_mode_from_table(const ssm_l8_state_t *state, ssm_config_t *config);
/**
* @brief Force the adaptive table onto an externally-chosen config
* (e.g. a DoE campaign driving a specific tick's config rather than
* letting the bandit's own UCB selection choose it). See definition for
* details on why this stays coherent with the bandit's own reward loop.
*/
void ssm_l8_force_config(ssm_l8_state_t *state, ssm_config_t *config, uint8_t config_idx);
/**
* @brief Update L8 state based on current metrics (legacy threshold path)
*/
void ssm_l8_update(const ssm_l8_metrics_t *metrics, ssm_l8_state_t *state);
/**
* @brief Apply L8 mode to SSM configuration (legacy threshold path)
*/
void ssm_apply_mode(const ssm_l8_state_t *state, ssm_config_t *config);
/**
* @brief Get human-readable mode name
*/
const char* ssm_l8_mode_name(ssm_l8_mode_t mode);
#endif /* SSM_JACQUARD_H */
v3/include/starforth_config.h
+255
View File
@@ -0,0 +1,255 @@
/*
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 VM Feature Configuration
*
* This header is the single source of truth for VM build-time defaults.
* Build systems may override any option via -D<FLAG>=<value>, but every
* translation unit sees these defaults even if no -D is provided.
*
* Hosted + kernel builds both force-include this header (see Makefiles),
* so new toggles belong here with a documented owner.
*/
#ifndef STARFORTH_CONFIG_H
#define STARFORTH_CONFIG_H
/* Base defaults (match 2025-12-26 hosted baseline) */
#define STARFORTH_CONFIG_STRICT_PTR_DEFAULT 1
#define STARFORTH_CONFIG_ENABLE_HOTWORDS_CACHE_DEFAULT 0
#define STARFORTH_CONFIG_ENABLE_PIPELINING_DEFAULT 0
#define STARFORTH_CONFIG_ROLLING_WINDOW_SIZE_DEFAULT 4096
#define STARFORTH_CONFIG_TRANSITION_WINDOW_SIZE_DEFAULT 8
#define STARFORTH_CONFIG_ADAPTIVE_SHRINK_RATE_DEFAULT 50
#define STARFORTH_CONFIG_ADAPTIVE_MIN_WINDOW_SIZE_DEFAULT 256
#define STARFORTH_CONFIG_ADAPTIVE_CHECK_FREQUENCY_DEFAULT 512
#define STARFORTH_CONFIG_ADAPTIVE_GROWTH_THRESHOLD_DEFAULT 5
#define STARFORTH_CONFIG_INITIAL_DECAY_SLOPE_Q48_DEFAULT 21845
#define STARFORTH_CONFIG_DECAY_MIN_INTERVAL_DEFAULT 1000ULL
#define STARFORTH_CONFIG_DECAY_RATE_PER_US_Q16_DEFAULT 1
#define STARFORTH_CONFIG_HEARTBEAT_THREAD_ENABLED_DEFAULT 1
#define STARFORTH_CONFIG_HEARTBEAT_TICK_NS_DEFAULT 10000ULL
#define STARFORTH_CONFIG_HEARTBEAT_INFERENCE_FREQUENCY_DEFAULT 1000
#define STARFORTH_CONFIG_STADIUM_VM_MEMORY_PERCENT_DEFAULT 50
#define STARFORTH_CONFIG_STADIUM_CONTAINS_DEPTH_MAX_DEFAULT 5
#define STARFORTH_CONFIG_STADIUM_CAPACITY_TICK_DEFAULT 4000
#define STARFORTH_CONFIG_STADIUM_MEMORY_PERCENT_DEFAULT 1
#define STARFORTH_CONFIG_STADIUM_WORD_HEAT_QUANTUM_DEFAULT 2048
#define STARFORTH_CONFIG_STADIUM_WORD_COOL_RATE_Q48_DEFAULT 21845
#define STARFORTH_CONFIG_STADIUM_BLOCK_HEAT_QUANTUM_DEFAULT 2048
#define STARFORTH_CONFIG_STADIUM_BLOCK_COOL_RATE_Q48_DEFAULT 21845
#define STARFORTH_CONFIG_STADIUM_BLOCK_TRACK_CAP_MULT_DEFAULT 2
#define STARFORTH_CONFIG_HEARTBEAT_CHECK_FREQUENCY_DEFAULT 256
#define STARFORTH_CONFIG_HEARTBEAT_WINDOW_TUNING_FREQUENCY_DEFAULT 1000
#define STARFORTH_CONFIG_HEARTBEAT_SLOPE_VALIDATION_FREQUENCY_DEFAULT 5000
#define STARFORTH_CONFIG_SSM_ENTROPY_HIGH_THRESHOLD_DEFAULT 0.75
#define STARFORTH_CONFIG_SSM_CV_HIGH_THRESHOLD_DEFAULT 0.15
#define STARFORTH_CONFIG_SSM_TEMPORAL_DECAY_THRESHOLD_DEFAULT 0.5
#define STARFORTH_CONFIG_SSM_TEMPORAL_DECAY_LOW_THRESHOLD_DEFAULT 0.3
#define STARFORTH_CONFIG_SSM_HYSTERESIS_TICKS_DEFAULT 5
#define STARFORTH_CONFIG_SPECULATION_THRESHOLD_Q48_DEFAULT (0x8000LL)
#define STARFORTH_CONFIG_SPECULATION_DEPTH_DEFAULT 1
#define STARFORTH_CONFIG_MIN_SAMPLES_FOR_SPECULATION_DEFAULT 10
#define STARFORTH_CONFIG_MISPREDICTION_COST_Q48_DEFAULT (25LL << 16)
/* 1.10 in Q48.16 (1.10 * 65536 = 72089.6, rounds to 0x1199A). Was shipped
* for years as 0x11999AL (an extra hex digit, ~17.6 in Q48.16, an order of
* magnitude off from the documented 1.10 intent) -- found while migrating
* this constant to Kconfig (see rev x in
* docs/working/architecture/VM-FLEET-ATTRACTOR-DESIGN-20260705.md) and
* fixed on Bob's explicit instruction (rev y). */
#define STARFORTH_CONFIG_MINIMUM_PREFETCH_ROI_DEFAULT (0x1199AL)
/* Public macros (overridable via -D) */
#ifndef STRICT_PTR
#define STRICT_PTR STARFORTH_CONFIG_STRICT_PTR_DEFAULT
#endif
#ifndef VM_STRICT_PTR
#define VM_STRICT_PTR STRICT_PTR
#endif
#ifndef ENABLE_HOTWORDS_CACHE
#define ENABLE_HOTWORDS_CACHE STARFORTH_CONFIG_ENABLE_HOTWORDS_CACHE_DEFAULT
#endif
#ifndef ENABLE_PIPELINING
#define ENABLE_PIPELINING STARFORTH_CONFIG_ENABLE_PIPELINING_DEFAULT
#endif
#ifndef ROLLING_WINDOW_SIZE
#define ROLLING_WINDOW_SIZE STARFORTH_CONFIG_ROLLING_WINDOW_SIZE_DEFAULT
#endif
#ifndef TRANSITION_WINDOW_SIZE
#define TRANSITION_WINDOW_SIZE STARFORTH_CONFIG_TRANSITION_WINDOW_SIZE_DEFAULT
#endif
#ifndef ADAPTIVE_SHRINK_RATE
#define ADAPTIVE_SHRINK_RATE STARFORTH_CONFIG_ADAPTIVE_SHRINK_RATE_DEFAULT
#endif
#ifndef ADAPTIVE_MIN_WINDOW_SIZE
#define ADAPTIVE_MIN_WINDOW_SIZE STARFORTH_CONFIG_ADAPTIVE_MIN_WINDOW_SIZE_DEFAULT
#endif
#ifndef ADAPTIVE_CHECK_FREQUENCY
#define ADAPTIVE_CHECK_FREQUENCY STARFORTH_CONFIG_ADAPTIVE_CHECK_FREQUENCY_DEFAULT
#endif
#ifndef ADAPTIVE_GROWTH_THRESHOLD
#define ADAPTIVE_GROWTH_THRESHOLD STARFORTH_CONFIG_ADAPTIVE_GROWTH_THRESHOLD_DEFAULT
#endif
#ifndef INITIAL_DECAY_SLOPE_Q48
#define INITIAL_DECAY_SLOPE_Q48 STARFORTH_CONFIG_INITIAL_DECAY_SLOPE_Q48_DEFAULT
#endif
#ifndef DECAY_MIN_INTERVAL
#define DECAY_MIN_INTERVAL STARFORTH_CONFIG_DECAY_MIN_INTERVAL_DEFAULT
#endif
#ifndef DECAY_RATE_PER_US_Q16
#define DECAY_RATE_PER_US_Q16 STARFORTH_CONFIG_DECAY_RATE_PER_US_Q16_DEFAULT
#endif
#ifndef HEARTBEAT_THREAD_ENABLED
#define HEARTBEAT_THREAD_ENABLED STARFORTH_CONFIG_HEARTBEAT_THREAD_ENABLED_DEFAULT
#endif
#ifndef HEARTBEAT_TICK_NS
#define HEARTBEAT_TICK_NS STARFORTH_CONFIG_HEARTBEAT_TICK_NS_DEFAULT
#endif
#ifndef HEARTBEAT_INFERENCE_FREQUENCY
#define HEARTBEAT_INFERENCE_FREQUENCY STARFORTH_CONFIG_HEARTBEAT_INFERENCE_FREQUENCY_DEFAULT
#endif
#ifndef STADIUM_VM_MEMORY_PERCENT
#define STADIUM_VM_MEMORY_PERCENT STARFORTH_CONFIG_STADIUM_VM_MEMORY_PERCENT_DEFAULT
#endif
#ifndef STADIUM_CONTAINS_DEPTH_MAX
#define STADIUM_CONTAINS_DEPTH_MAX STARFORTH_CONFIG_STADIUM_CONTAINS_DEPTH_MAX_DEFAULT
#endif
#ifndef STADIUM_CAPACITY_TICK
#define STADIUM_CAPACITY_TICK STARFORTH_CONFIG_STADIUM_CAPACITY_TICK_DEFAULT
#endif
#ifndef STADIUM_MEMORY_PERCENT
#define STADIUM_MEMORY_PERCENT STARFORTH_CONFIG_STADIUM_MEMORY_PERCENT_DEFAULT
#endif
#ifndef STADIUM_WORD_HEAT_QUANTUM
#define STADIUM_WORD_HEAT_QUANTUM STARFORTH_CONFIG_STADIUM_WORD_HEAT_QUANTUM_DEFAULT
#endif
#ifndef STADIUM_WORD_COOL_RATE_Q48
#define STADIUM_WORD_COOL_RATE_Q48 STARFORTH_CONFIG_STADIUM_WORD_COOL_RATE_Q48_DEFAULT
#endif
#ifndef STADIUM_BLOCK_HEAT_QUANTUM
#define STADIUM_BLOCK_HEAT_QUANTUM STARFORTH_CONFIG_STADIUM_BLOCK_HEAT_QUANTUM_DEFAULT
#endif
#ifndef STADIUM_BLOCK_COOL_RATE_Q48
#define STADIUM_BLOCK_COOL_RATE_Q48 STARFORTH_CONFIG_STADIUM_BLOCK_COOL_RATE_Q48_DEFAULT
#endif
#ifndef STADIUM_BLOCK_TRACK_CAP_MULT
#define STADIUM_BLOCK_TRACK_CAP_MULT STARFORTH_CONFIG_STADIUM_BLOCK_TRACK_CAP_MULT_DEFAULT
#endif
#ifndef HEARTBEAT_CHECK_FREQUENCY
#define HEARTBEAT_CHECK_FREQUENCY STARFORTH_CONFIG_HEARTBEAT_CHECK_FREQUENCY_DEFAULT
#endif
#ifndef HEARTBEAT_WINDOW_TUNING_FREQUENCY
#define HEARTBEAT_WINDOW_TUNING_FREQUENCY STARFORTH_CONFIG_HEARTBEAT_WINDOW_TUNING_FREQUENCY_DEFAULT
#endif
#ifndef HEARTBEAT_SLOPE_VALIDATION_FREQUENCY
#define HEARTBEAT_SLOPE_VALIDATION_FREQUENCY STARFORTH_CONFIG_HEARTBEAT_SLOPE_VALIDATION_FREQUENCY_DEFAULT
#endif
#ifndef SSM_ENTROPY_HIGH_THRESHOLD
#define SSM_ENTROPY_HIGH_THRESHOLD STARFORTH_CONFIG_SSM_ENTROPY_HIGH_THRESHOLD_DEFAULT
#endif
#ifndef SSM_CV_HIGH_THRESHOLD
#define SSM_CV_HIGH_THRESHOLD STARFORTH_CONFIG_SSM_CV_HIGH_THRESHOLD_DEFAULT
#endif
#ifndef SSM_TEMPORAL_DECAY_THRESHOLD
#define SSM_TEMPORAL_DECAY_THRESHOLD STARFORTH_CONFIG_SSM_TEMPORAL_DECAY_THRESHOLD_DEFAULT
#endif
#ifndef SSM_TEMPORAL_DECAY_LOW_THRESHOLD
#define SSM_TEMPORAL_DECAY_LOW_THRESHOLD STARFORTH_CONFIG_SSM_TEMPORAL_DECAY_LOW_THRESHOLD_DEFAULT
#endif
#ifndef SSM_HYSTERESIS_TICKS
#define SSM_HYSTERESIS_TICKS STARFORTH_CONFIG_SSM_HYSTERESIS_TICKS_DEFAULT
#endif
#ifndef SPECULATION_THRESHOLD_Q48
#define SPECULATION_THRESHOLD_Q48 STARFORTH_CONFIG_SPECULATION_THRESHOLD_Q48_DEFAULT
#endif
#ifndef SPECULATION_DEPTH
#define SPECULATION_DEPTH STARFORTH_CONFIG_SPECULATION_DEPTH_DEFAULT
#endif
#ifndef MIN_SAMPLES_FOR_SPECULATION
#define MIN_SAMPLES_FOR_SPECULATION STARFORTH_CONFIG_MIN_SAMPLES_FOR_SPECULATION_DEFAULT
#endif
#ifndef MISPREDICTION_COST_Q48
#define MISPREDICTION_COST_Q48 STARFORTH_CONFIG_MISPREDICTION_COST_Q48_DEFAULT
#endif
#ifndef MINIMUM_PREFETCH_ROI
#define MINIMUM_PREFETCH_ROI STARFORTH_CONFIG_MINIMUM_PREFETCH_ROI_DEFAULT
#endif
#endif /* STARFORTH_CONFIG_H */
v3/include/startup.h
+86
View File
@@ -0,0 +1,86 @@
/*
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.
*/
#ifndef STARFORTH_STARTUP_H
#define STARFORTH_STARTUP_H
#include "vm.h"
#include "cli.h"
/**
* @brief Initialize block I/O device from CLI configuration
*
* Opens disk image or allocates RAM disk based on CLIConfig.
* Must be called before vm_init().
*
* @param config CLI configuration
* @return 0 on success, 1 on error (logs messages internally)
*/
int startup_blkio_init(const CLIConfig* config);
/**
* @brief Clean up block I/O device
*
* Flushes and closes block device, frees RAM disk if allocated.
* Called automatically via atexit().
*/
void startup_blkio_cleanup(void);
/**
* @brief Initialize VM with defaults
*
* Initializes the VM state after block device is ready.
* @param vm Pointer to VM to initialize
* @return 0 on success, 1 on error
*/
int startup_vm_init(VM * vm);
/**
* @brief Initialize block subsystem
*
* Sets up block buffering and attaches blkio device.
* @param vm Pointer to initialized VM
* @return 0 on success, 1 on error
*/
int startup_block_subsys_init(VM * vm);
#endif /* STARFORTH_STARTUP_H */
v3/include/version.h
+10
View File
@@ -0,0 +1,10 @@
#ifndef STARFORTH_VERSION_H
#define STARFORTH_VERSION_H
#define STARFORTH_VERSION "3.2.0"
#define STARFORTH_ARCH "x86_64"
#define STARFORTH_TARGET "standard"
#define STARFORTH_TIMESTAMP "2026-10-01T15:21:25-04:00"
#define STARFORTH_VERSION_FULL "StarForth v3.2.0 x86_64 standard 2026-10-01T15:21:25-04:00"
#endif /* STARFORTH_VERSION_H */
v3/include/vm.h
+887
View File
@@ -0,0 +1,887 @@
/*
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.
*/
#ifndef VM_H
#define VM_H
/* Bare metal - no system headers, but we need FILE for heartbeat CSV export */
#include <stdint.h>
#include <stddef.h>
#if defined(__STDC_HOSTED__) && __STDC_HOSTED__
#include <stdio.h>
#endif
#include "platform_lock.h"
#include "starforth_config.h"
/* Forward declarations */
struct VM;
struct HotwordsCache_s; /* Physics hot-words cache (avoids circular include) */
typedef struct HotwordsCache_s HotwordsCache;
struct WordTransitionMetrics; /* Pipelining metrics (avoids circular include) */
typedef struct WordTransitionMetrics WordTransitionMetrics;
struct VMHostServices; /* Host allocator/time hooks (defined in vm_host.h) */
typedef struct VMHostServices VMHostServices;
struct InferenceOutputs; /* Adaptive tuning inference engine outputs (avoids circular include) */
typedef struct InferenceOutputs InferenceOutputs;
struct HeartbeatWorker; /* Background heartbeat dispatcher */
typedef struct HeartbeatWorker HeartbeatWorker;
/* Bare metal type definitions */
#if defined(__amd64__) || defined(__x86_64__) || defined(__aarch64__) || defined(_M_ARM64) || defined(_M_X64)
typedef int64_t cell_t;
typedef uint64_t ucell_t;
#else
typedef signed long cell_t;
typedef unsigned long ucell_t;
#endif
/* ============================================================================
* Rolling Window of Truth (Embedded to avoid circular includes)
* ============================================================================
*
* Circular buffer capturing execution history for deterministic metric seeding.
* Defined here to avoid include dependency issues.
*
* Knob #7: ROLLING_WINDOW_SIZE (tunable initial/conservative size)
* - Default: 4096 (conservative capture of full pattern diversity at cold start)
* - Usage: make ROLLING_WINDOW_SIZE=8192 (or 2048, 16384, etc. for different workloads)
* - Starting large ensures statistical significance on cold systems
* - System automatically shrinks during execution if diminishing returns detected
* - Window is "warm" after ROLLING_WINDOW_SIZE executions
* (once warm, adaptive shrinking logic can reduce size if beneficial)
* - Knobs control adaptive shrinking behavior (rate, bounds, thresholds)
*/
typedef struct
{
uint32_t* execution_history; /* Circular buffer of word IDs */
uint32_t* snapshot_buffers[2]; /* Double-buffer snapshots for readers */
uint32_t window_pos; /* Current write position */
uint64_t total_executions; /* Lifetime execution counter */
int is_warm; /* 1 if window contains representative data */
/* Adaptive window sizing: continuous self-tuning during execution */
uint32_t effective_window_size; /* Current effective size (may shrink from initial) */
uint64_t last_pattern_diversity; /* Pattern diversity at last check */
uint64_t pattern_diversity_check_count; /* How many times we've checked diversity */
volatile uint32_t snapshot_index; /* Published snapshot buffer */
volatile uint32_t snapshot_pending; /* Writer signaled new data */
uint32_t snapshot_window_pos[2];
uint64_t snapshot_total_executions[2];
uint32_t snapshot_effective_window_size[2];
int snapshot_is_warm[2];
uint32_t adaptive_check_accumulator; /* Execution counter toward next check */
volatile uint32_t adaptive_pending; /* Heartbeat should run adaptive shrink */
} RollingWindowOfTruth;
typedef void (*word_func_t)(struct VM* vm);
/* ===== VM address model (Phase 1 scaffolding) ============================
* StarForth rule: addresses on the data stack are VM OFFSETS, not C pointers.
* vaddr_t is a byte offset into the VM's virtual address space.
* Implementations come in a later change; these are declarations only.
*/
typedef uint64_t vaddr_t;
/* Bounds check: nonzero if [addr, addr+len) is a valid VM range */
int vm_addr_ok(struct VM* vm, vaddr_t addr, size_t len);
/* Internal pointer materialization for subsystems (NOT for word sources) */
uint8_t* vm_ptr(struct VM* vm, vaddr_t addr);
/* Canonical memory accessors; all word code will funnel through these */
uint8_t vm_load_u8(struct VM* vm, vaddr_t addr);
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; }
/* ======================================================================== */
#define STACK_SIZE 1024
#define DICTIONARY_SIZE 1024
#define WORD_ID_INVALID UINT32_MAX
#define VM_MEMORY_SIZE (5 * 1024 * 1024) /* 5 MB total VM memory */
#define INPUT_BUFFER_SIZE 1025
#define WORD_NAME_MAX 31
#define COMPILE_BUFFER_SIZE 1024
/* Block system configuration */
#define BLOCK_SIZE 1024 /* 1KB per block */
#define MAX_BLOCKS (VM_MEMORY_SIZE / BLOCK_SIZE) /* 5120 blocks from 5MB */
/* Block I/O window: FORTH-visible copies of block content inside vm->memory.
* Sits at the top of vm->memory, above the dictionary limit (2MB). BLOCK and
* BUFFER copy C-layer buffers into these slots and return VM offsets so that
* C@/C!/@ work correctly. UPDATE copies the slot back to the C layer. */
#define BLK_VM_SLOTS 4
#define BLK_VM_WINDOW_SIZE (BLK_VM_SLOTS * BLOCK_SIZE)
#define BLK_VM_WINDOW_BASE (VM_MEMORY_SIZE - BLK_VM_WINDOW_SIZE)
/* Memory layout constants */
#define DICTIONARY_BLOCKS 2048 /* First 2048 blocks (2MB) for dictionary */
#define DICTIONARY_MEMORY_SIZE (DICTIONARY_BLOCKS * BLOCK_SIZE)
#define USER_BLOCKS_START DICTIONARY_BLOCKS /* User blocks start at block 2048 */
/* Persistent log configuration */
#define LOG_LINE_MAX 64 /* Each log line is 64 bytes */
#define LOG_LINES_PER_BLOCK (BLOCK_SIZE / LOG_LINE_MAX) /* 16 lines per 1KB block */
#define LOG_BLOCKS_START 3072 /* Log starts at block 3072 */
#define LOG_BLOCKS_END 5120 /* Log ends at block 5120 (exclusive) */
#define LOG_BLOCKS (LOG_BLOCKS_END - LOG_BLOCKS_START) /* 2048 blocks (2MB) for logs */
#define LOG_LAYER1_MAX_LINES (LOG_BLOCKS * LOG_LINES_PER_BLOCK) /* 32768 max lines */
/* Word flags */
#define WORD_IMMEDIATE 0x80 /* Word executes immediately even in compile mode */
#define WORD_HIDDEN 0x40 /* Word is hidden from dictionary searches */
#define WORD_SMUDGED 0x20 /* Word is smudged (being defined) - FORTH-79 */
#define WORD_COMPILED 0x10 /* Word is user-compiled (not built-in) */
#define WORD_PINNED 0x08 /* Word's execution heat is pinned (cannot decay to zero) */
#define WORD_FROZEN 0x04 /* Word is frozen: execution heat does not decay (Phase 2) */
/* ACL (Access Control List) defaults - stub implementation */
#define ACL_USER_DEFAULT 0x01 /* Default access: users can execute and compile */
/* ACL mode constants */
#define ACL_MODE_TTL 0 /* Adaptive TTL countdown; 0 → calls ACL-RECHECK */
#define ACL_MODE_STRICT 1 /* Re-check every execution (STRICT mode) */
#define ACL_TTL_OPEN UINT32_MAX /* Permissive TTL before ACL.4th loads */
/* Physics model constants - execution heat drives optimization decisions */
#define SPIN_IDLE 0 /* Particle spin state: idle */
#define CHARGE_NEUTRAL 0 /* Particle charge state: neutral (execution heat acts as charge) */
/* Physics state flags */
#define PHYSICS_STATE_IMMEDIATE 0x01
#define PHYSICS_STATE_PINNED 0x02
#define PHYSICS_STATE_HIDDEN 0x04
#define PHYSICS_STATE_COMPILED 0x08
/* Phase 2: Decay mechanism configuration (tunable via starforth_config.h) */
#ifndef HEAT_CACHE_DEMOTION_THRESHOLD
#define HEAT_CACHE_DEMOTION_THRESHOLD 10 /* Demotion from hotwords cache threshold */
#endif
/* Heartbeat tuning frequencies (in ticks) */
/* Defaults live in starforth_config.h */
typedef struct
{
uint64_t published_tick; /* Tick counter when snapshot committed */
uint64_t published_ns; /* Host monotonic timestamp of publish */
uint32_t window_width; /* Effective rolling window size */
uint32_t actual_window_size; /* Actual ring buffer fill level: min(total_executions, ROLLING_WINDOW_SIZE) */
uint64_t decay_slope_q48; /* Active decay slope */
uint64_t hot_word_count; /* Words above heat threshold */
uint64_t stale_word_count; /* Words in cooling band */
uint64_t total_heat; /* Aggregate execution heat */
} HeartbeatSnapshot;
/* ===== Per-Tick Instrumentation (Phase 2: Multivariate Dynamics) ==========
*
* Lightweight circular buffer capture for multivariate systems analysis.
* Captures 7 key metrics every heartbeat tick (~1ms) with negligible overhead.
* Used to measure coupled dynamics, convergence, coupling strength, stability.
*/
typedef struct
{
uint32_t tick_number; /* Sequential tick counter */
uint64_t elapsed_ns; /* Total elapsed since run start */
uint64_t tick_interval_ns; /* Actual tick interval from prior tick */
uint32_t cache_hits_delta; /* Cache hits during this tick */
uint32_t bucket_hits_delta; /* Bucket hits during this tick */
uint32_t word_executions_delta; /* Words executed during this tick */
uint64_t hot_word_count; /* Words above heat threshold */
double avg_word_heat; /* Mean execution heat (Q48.16 / 65536) */
uint32_t window_width; /* Current rolling window size */
uint32_t actual_window_size; /* Actual ring buffer fill level: min(total_executions, ROLLING_WINDOW_SIZE) */
uint32_t predicted_label_hits; /* Successful context predictions */
double estimated_jitter_ns; /* Deviation from nominal tick */
uint8_t l8_mode; /* L8 Jacquard mode selector state (0-15) */
} HeartbeatTickSnapshot;
#define HEARTBEAT_TICK_BUFFER_SIZE 100000 /* ~100K ticks = ~100 seconds at 1kHz */
/* Phase 1 physics metadata */
typedef struct
{
uint16_t temperature_q8; /* Execution-heat-backed hotness scaled to Q8 */
uint64_t last_active_ns; /* Monotonic timestamp of last execution -- diagnostics only, never read for decay */
uint64_t last_decay_ns; /* Timestamp of last decay application -- diagnostics only, never read for decay */
uint64_t last_decay_tick; /* vm->heartbeat.tick_count as of last decay application -- the only clock Loop #3 decay reads */
uint32_t mass_bytes; /* Header + body footprint */
uint32_t avg_latency_ns; /* Rolling average latency (PROFILE_DETAILED+) */
uint8_t state_flags; /* Encoded execution traits (immediate, pinned, etc.) */
uint8_t acl_hint; /* Reserved for governance-driven ACLs */
uint16_t pubsub_mask; /* Reserved topic bitmap */
} DictPhysics;
/* ===== VM Heartbeat Architecture (Loop #3 & #5 Coordination) ============
*
* Centralized time-driven tuning dispatcher coordinating:
* - Loop #3: Heat decay validation (slope_validator, replaced by inference engine)
* - Loop #5: Context-aware window tuning (window_tuner, replaced by inference engine)
* - Unified Inference Engine: ANOVA early-exit + window width + decay slope inference
*
* Can run synchronously (now) or in background thread (future).
* Designed as plugin architecture for extensibility.
*/
typedef struct
{
uint64_t tick_count; /* Total heartbeat ticks since VM init */
uint64_t last_inference_tick; /* Last tick we ran full inference engine */
uint32_t check_counter; /* Counter to trigger vm_tick() every N executions */
int heartbeat_enabled; /* 1 = heartbeat active, 0 = disabled */
uint64_t tick_target_ns; /* Wake-up cadence (ns) */
volatile uint32_t snapshot_index; /* Published snapshot slot */
HeartbeatSnapshot snapshots[2]; /* Double-buffered read-only snapshots */
HeartbeatWorker* worker; /* Background thread context (opaque) */
/* === DoE Observation Counters (2^7 Factorial) === */
uint64_t inference_run_count; /* Times inference engine was invoked */
uint64_t early_exit_count; /* ANOVA early-exits (variance stable) */
uint64_t words_executed; /* Total word executions */
uint64_t dictionary_lookups; /* Dictionary search operations */
/* === Per-tick instrumentation (Phase 2: Multivariate Dynamics) === */
HeartbeatTickSnapshot* tick_buffer; /* Circular buffer of per-tick snapshots */
uint32_t tick_buffer_size; /* Allocated size (HEARTBEAT_TICK_BUFFER_SIZE) */
uint64_t tick_buffer_write_index; /* Current write position (wraps) */
uint64_t tick_count_total; /* Total ticks since run start (monotonic) */
uint64_t run_start_ns; /* Monotonic time at run start */
uint32_t tick_number_offset; /* Tick counter for this run */
/* === L8 Attractor Bucket Statistics === */
double bucket_sum_K; /* Sum of K values across bucket */
double bucket_sum_K_squared; /* Sum of K^2 for variance calculation */
double bucket_sum_window_variance; /* Sum of window variance across bucket */
double bucket_sum_heat_variance; /* Sum of heat variance across bucket */
uint64_t bucket_mode_transitions; /* Count of L8 mode transitions in bucket */
uint32_t bucket_collapse_flag; /* Flag indicating bucket collapse event */
uint32_t bucket_tick_count; /* Number of ticks in current bucket */
/* === M5 Time Trust Fields === */
uint64_t m5_time_trust; /* TIME-TRUST in Q48.16 format */
uint64_t m5_variance; /* Timing variance in Q48.16 format */
} HeartbeatState;
/* ===== Pipelining Global Metrics (Loop #4 & #5 Feedback) ================
*
* Aggregated metrics for speculative prefetch accuracy tracking.
* Used to guide window size tuning via binary chop (Loop #5).
*/
typedef struct
{
uint64_t prefetch_attempts; /* Total speculative prefetch calls */
uint64_t prefetch_hits; /* Successful hits (word was looked up next) */
uint64_t window_tuning_checks; /* How many times we've checked window size */
uint32_t last_checked_window_size; /* Window size at last tuning check */
double last_checked_accuracy; /* Prefetch accuracy at last check */
uint32_t suggested_next_size; /* What binary chop recommends trying */
} PipelineGlobalMetrics;
/* Dictionary entry - enhanced for FORTH-79 compatibility */
typedef struct DictEntry
{
struct DictEntry* link; /* Previous word (linked list) */
word_func_t func; /* Function pointer for execution */
cell_t flags; /* Word flags - increased to cell_t for alignment and absolute flags if needed */
uint8_t name_len; /* Length of name */
cell_t execution_heat; /* Execution frequency counter */
uint8_t acl_default; /* Access control list default permissions */
uint32_t acl_ttl; /* countdown; 0 → ACL-RECHECK; default 0 */
uint8_t acl_allow; /* cached decision: 1=allow 0=deny; default 1 */
uint8_t acl_mode; /* ACL_MODE_TTL=0, ACL_MODE_STRICT=1; default TTL */
uint8_t acl_pinned; /* 1=immutable forever; default 0 */
uint32_t word_id; /* Stable dictionary identifier */
DictPhysics physics; /* Physics properties */
WordTransitionMetrics* transition_metrics; /* Absolute pointer to metrics */
char name[]; /* Variable-length name */
} __attribute__((aligned(8))) DictEntry;
/* VM modes */
typedef enum
{
MODE_INTERPRET = 0,
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 */
/* Saved interpreter state for VM lifecycle calls (BIRTH, VM-EXEC, START).
* Dynamically allocated; grows on demand via sf_realloc. */
typedef struct {
int rsp;
int exit_colon;
int ecw_nesting;
} VMCallState;
#endif
/**
* @struct VM
* @brief Main virtual machine state container
*
* Contains all state information for a StarForth VM instance including stacks,
* dictionary, memory, and execution state.
*/
typedef struct VM
{
/** @name Stack Management
* @{
*/
cell_t data_stack[STACK_SIZE]; /**< Parameter stack storage */
cell_t return_stack[STACK_SIZE]; /**< Return stack storage */
int dsp; /**< Data stack pointer */
int rsp; /**< Return stack pointer */
int exit_colon; /**< Exit flag for colon definitions */
int abort_requested; /**< ABORT flag for immediate termination */
int ecw_nesting; /**< Depth of execute_colon_word call stack; >0 means inside a colon word */
volatile int doe_row_printing; /**< Non-zero while EMIT-ROW assembles a row; heartbeat output must defer */
uint8_t emergency_console; /**< 1 = fault handler active; bypasses all ACL checks (C-only write) */
uint8_t zuse_session; /**< 1 = zuse authenticated at console; shows zuse)ok> prompt */
uint8_t acl_skip; /**< 1 = skip all ACL hooks (Ananke enforcement VM; prevents recursion) */
uint8_t zuse_cert_installed; /**< 1 = zuse_cert_seed/pubkey hold a real minted cert (one-time fuse) */
uint8_t zuse_cert_seed[32]; /**< Ed25519 seed, this instance's Zuse identity. C-only write via
* vm_zuse_cert_install(); no FORTH word can read or write it --
* the seed is the private key, never exposed past this struct. */
uint8_t zuse_cert_pubkey[32]; /**< Ed25519 public key derived from the seed at mint time, cached
* here so callers don't need to re-derive it. No FORTH word can
* write it -- deliberately kept out of the dictionary so ACL-PIN's
* redefinition-only guarantee can't be bypassed via >BODY on a
* CONSTANT (see FABRIC-2.md). Read-only FORTH access via
* ZUSE-PUBKEY@. */
uint8_t zuse_root_pubkey_known; /**< 1 = zuse_root_pubkey holds a real value, loaded from the
* persistent genesis-marker fence (zuse_genesis_marker_t,
* capsule_zuse_boot_load_root_pubkey()) independently of whether
* Zuse's own thumbdrive is attached this boot. Deliberately
* separate from zuse_cert_installed/zuse_cert_seed above -- that
* pair is a one-way fuse gating MINT (needs her live private
* seed); this pair gates WIREBIND cert *verification* only (needs
* nothing but her already-public key), so a WIREBIND identity can
* be verified and attach without requiring Zuse's own live session
* this boot. Bob, 2026-09-09: "zuse is zuse, [each identity] is
* [itself]" -- one identity's attach must not depend on another's
* live presence. */
uint8_t zuse_root_pubkey[32]; /**< Ed25519 public key, loaded from the genesis-marker fence.
* Same value zuse_cert_pubkey ends up holding once Zuse herself
* attaches -- this is just available earlier and unconditionally. */
/** @} */
/** @name Dictionary Management
* @{
*/
const VMHostServices* host; /**< Host allocator/time services */
uint8_t* memory; /**< Unified VM memory buffer */
uintptr_t here; /**< Next free memory location (byte offset or absolute pointer if M7) */
DictEntry* latest; /**< Most recent word */
DictEntry* word_id_map[DICTIONARY_SIZE]; /**< Stable ID → entry map for speculation */
uint32_t recycled_word_ids[DICTIONARY_SIZE]; /**< Reusable ID stack for FORGET */
uint32_t recycled_word_id_count; /**< Depth of recycled stack */
uint32_t next_word_id; /**< Next fresh ID when recycle stack empty */
/* Dictionary protection fence: words at/older than this are protected from FORGET */
DictEntry* dict_fence_latest;
size_t dict_fence_here;
sf_mutex_t dict_lock; /**< Protects dictionary structural mutations */
/* Input system */
char input_buffer[INPUT_BUFFER_SIZE];
size_t input_length;
size_t input_pos;
/* Compiler state */
vm_mode_t mode;
DictEntry* compiling_word; /* Word being compiled */
int interpreter_enabled;
/* Compilation support */
char current_word_name[WORD_NAME_MAX + 1];
cell_t* compile_buffer;
size_t compile_pos;
size_t compile_size;
/* FORTH-79 Dictionary manipulation support */
cell_t state_var; /* STATE variable (0 interpret, -1 compile) */
/* Execution bookkeeping */
DictEntry* current_executing_entry;
cell_t* ip; /* direct-threaded instruction pointer (points into memory in CELLS) */
/* VM state */
int error;
int halted;
/* Numeric base (Forth BASE). Default 10. */
cell_t base;
/* TIB stuff */
unsigned char* tib_buf; /* pointer to TIB buffer (host alloc for now) */
size_t tib_cap; /* capacity in bytes */
cell_t* in_var; /* >IN (legacy; will migrate to VM addr) */
cell_t* span_var; /* SPAN (legacy; will migrate to VM addr) */
/* Block system (VM-backed variables / addresses) */
vaddr_t scr_addr;
vaddr_t state_addr; /* VM cell holding STATE (0=interp, -1=compile) */
vaddr_t base_addr; /* VM cell: numeric base (2..36), default 10 */
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) */
uint8_t *blk_vm_cbuf[BLK_VM_SLOTS]; /* C buffer pointer from blk_get_buffer */
uint8_t blk_vm_dirty[BLK_VM_SLOTS]; /* 1 = vm->memory modified since last sync */
int blk_vm_next; /* Round-robin eviction cursor */
uint64_t blk_vm_epoch; /* blk_subsys_epoch() as of last cache validation --
* see block_words.c's blk_vm_find() */
/** @name Physics Hot-Words Cache
* @{
*/
HotwordsCache* hotwords_cache; /**< Frequency-driven dictionary acceleration cache */
/** @} */
/** @name Rolling Window of Truth (Deterministic Metrics)
* @{
*/
RollingWindowOfTruth rolling_window; /**< Execution history for reproducible seeding */
/** @} */
/** @name Phase 2: Heat-Aware Dictionary Optimization
* @{
*/
cell_t heat_threshold_25th; /**< 25th percentile heat (bucket search priority) */
cell_t heat_threshold_50th; /**< 50th percentile heat */
cell_t heat_threshold_75th; /**< 75th percentile heat */
uint64_t last_bucket_reorg_ns; /**< When we last reorganized buckets */
int lookup_strategy; /**< 0=naive, 1=heat-aware, 2=inference-reorg */
/** @} */
/** @name VM Heartbeat (Loop #3 & #5 Coordination)
* @{
*/
HeartbeatState heartbeat; /**< Centralized time-driven tuning dispatcher */
uint32_t heartbeat_decay_cursor_id; /**< Continuation cursor for background decay sweeps */
/** @} */
/** @name Pipelining Global Metrics (Loop #4 & #5 Feedback)
* @{
*/
PipelineGlobalMetrics pipeline_metrics; /**< Aggregated prefetch accuracy tracking */
/** @} */
/** @name Physics Loop #3: Adaptive Heat Decay Tuning
* @{
*/
uint64_t decay_slope_q48; /**< Current decay rate (Q48.16 fixed-point, starts at 2:1 = 131072) */
uint64_t last_decay_check_ns; /**< Timestamp of last decay effectiveness measurement */
uint64_t total_heat_at_last_check; /**< Total dictionary heat at last check (for slope inference) */
uint64_t hot_word_count_at_check; /**< Hot words observed at last inference */
uint64_t stale_word_count_at_check; /**< Stale words at last check (for trend analysis) */
uint32_t word_count_at_check; /**< Total word count at last check (for ratio calculation) */
int decay_slope_direction; /**< -1 = decrease slope, 0 = stable, +1 = increase slope (inference) */
sf_mutex_t tuning_lock; /**< Guards shared tuning knobs (slope, snapshots) */
/** @} */
/** @name Unified Inference Engine (Phase 2: Replacing Loops #3 & #5)
* @{
*/
InferenceOutputs* last_inference_outputs; /**< Cached inference outputs (for ANOVA early-exit and tuning application) */
/** @} */
/** @name SSM L8: Jacquard Mode Selector (Steady State Machine)
* @{
*/
void* ssm_l8_state; /**< Opaque pointer to ssm_l8_state_t (avoid circular include) */
void* ssm_config; /**< Opaque pointer to ssm_config_t (L3/L4 mode bits) */
/** @} */
#ifdef __STARKERNEL__
/** @name VM Lifecycle Call State Stack
* @{
*/
VMCallState *call_stack; /**< Dynamically-allocated lifecycle state stack */
int call_sp; /**< Current depth (0 = empty) */
int call_stack_cap; /**< Allocated capacity in entries */
int call_stack_max; /**< High-water mark depth (DoE metric) */
/** @} */
/** @name Native execution stack (FABRIC-3.md §XXVIII, Stage 1, 2026-09-13)
* @{
*/
uint64_t native_stack_paddr; /**< Physical base (for teardown); 0 = not allocated */
uint64_t native_stack_guard_vaddr; /**< Virtual base of the whole guarded region */
uint64_t native_stack_top; /**< Top of the allocated region (fixed, for the
* initial frame construction); 0 = not allocated. */
uint64_t native_stack_saved_sp; /**< Stage 2 (FABRIC-3.md §XXVIII, 2026-09-13): the
* parked SP of a live, switched-out register
* context on this VM's own native stack. 0 = never
* entered (no context parked yet); non-zero only
* while VMRegistryEntry.state ==
* VM_STATE_SWITCHED_OUT for this VM. */
struct VM *native_switch_back_to; /**< Stage 3 correction (FABRIC-3.md §XXVIII,
* 2026-09-13): who most recently switched INTO
* this VM. Updated by sk_vm_context_switch() on
* every switch-in (first-ever or resumed), so the
* placeholder trampoline (sk_vm_switch_entry())
* always yields back to whoever actually switched
* in, not a stale value captured once at this
* VM's very first entry -- a single global there
* let a later switch-in from a different VM get
* silently bounced to the original caller instead
* of itself. */
/** @} */
/** @name Stadium Identity (item 4.2, FABRIC-0.md §25.5)
* @{
*/
VMUuid stadium_vm_id; /**< This VM's own identity, set once at birth from
* VMRegistryEntry.vm_id. Lets vm_core.c's
* stadium_word_dispatch() call sites attribute
* word-execution heat to the VM that actually
* ran the word, instead of item 4.1's hardcoded
* vm_uuid_hera(). */
/** @} */
/** @name Owner identity + ACL capabilities (FABRIC-2.md §F.2/§F.16)
* @{
*/
VMIdentity identity; /**< This VM's owning identity. installed=0 (the
* zero-init default) means no lock -- every
* VM today, until D.5's per-VM-identity work
* and CERTVERIFY/MINT actually populate it. */
/** @} */
#endif
} VM;
/** @name Core VM Functions
* @{
*/
/*
* @brief Initialize a new VM instance
* @param vm Pointer to VM structure to initialize
*/
void vm_init(VM* vm);
/**
* @brief Initialize VM with explicit host services
* @param vm Pointer to VM structure to initialize
* @param host Host services (allocator/time). If NULL, uses build default.
*/
void vm_init_with_host(VM* vm, const VMHostServices *host);
/*
* @brief Interpret a string of Forth code
* @param vm VM instance to use
* @param input String containing Forth code to interpret
*/
void vm_interpret(VM* vm, const char* input);
void vm_enable_interpreter(VM* vm);
/*
* @brief Start the VM's read-eval-print loop
* @param vm VM instance to run
* @param script_mode If 1, suppress prompts and "ok" output (for piped input)
*/
void vm_repl(VM* vm, int script_mode);
/** @} */
/* Stack operations */
void vm_push(VM* vm, cell_t value);
cell_t vm_pop(VM* vm);
void vm_rpush(VM* vm, cell_t value);
cell_t vm_rpop(VM* vm);
/* Dictionary operations */
DictEntry* vm_find_word(VM* vm, const char* name, size_t len);
/* Arbitrated bucket scan: returns the newest visible (non-hidden, non-smudged)
* entry matching name among ALL candidates in the bucket. Buckets can be
* reordered by heat (dict_reorganize_buckets_by_heat), so first-match scans
* are unsound for shadowed/redefined names; every lookup path must resolve
* through this. Age is arbitrated via the vm->latest link chain. */
DictEntry* vm_dict_resolve_in_bucket(VM* vm, DictEntry** bucket, size_t n,
const char* name, size_t len);
DictEntry* vm_create_word(VM* vm, const char* name, size_t len, word_func_t func);
void vm_make_immediate(VM* vm);
void vm_bootstrap_root_vocabulary(VM *vm, const char *name);
void vm_hide_word(VM* vm);
void vm_smudge_word(VM* vm); /* Added for FORTH-79 SMUDGE */
void vm_pin_execution_heat(VM* vm); /* Pin execution heat (prevent decay) */
void vm_unpin_execution_heat(VM* vm); /* Unpin execution heat (allow decay) */
/* Enhanced dictionary search functions */
DictEntry* vm_dictionary_find_by_func(VM* vm, word_func_t func);
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);
cell_t* vm_dictionary_get_data_field(DictEntry* entry);
void vm_compile_word(VM* vm, DictEntry* entry);
/* Zuse cert one-time install (blows the fuse). seed and pubkey are each 32
* bytes, copied into the VM struct. Returns 0 on success, -1 if already
* installed -- a second call is a caller bug, not a runtime error to
* recover from silently. C-only: no FORTH word wraps this. */
int vm_zuse_cert_install(VM* vm, const uint8_t seed[32], const uint8_t pubkey[32]);
/* Memory management */
void* vm_allot(VM* vm, size_t bytes);
void vm_align(VM* vm);
/* Input parsing */
int vm_parse_word(VM* vm, char* word, size_t max_len);
int vm_parse_number(VM* vm, const char* str, cell_t* value);
/* Compilation */
void vm_enter_compile_mode(VM* vm, const char* name, size_t len);
void vm_exit_compile_mode(VM* vm);
/* Colon word execution (exposed for SEE decompiler) */
void execute_colon_word(VM* vm);
void vm_compile_call(VM* vm, word_func_t func);
void vm_compile_literal(VM* vm, cell_t value);
void vm_compile_exit(VM* vm);
void vm_interpret_word(VM* vm, const char* word_str, size_t len);
/* Block system integration */
void* vm_get_block_addr(VM* vm, int block_num);
int vm_addr_to_block(VM* vm, void* addr);
/* Testing functions */
void vm_run_smoke_tests(VM* vm);
/* Add cleanup function declaration */
void vm_cleanup(VM* vm);
/* ===== VM Heartbeat (Time-Driven Tuning Dispatcher) =====================
* Centralized coordination of Loop #3 and Loop #5 operations.
* Called periodically from main execution loop.
*/
void vm_tick(VM* vm); /* Main heartbeat dispatcher */
void vm_tick_inference_engine(VM* vm); /* Unified inference engine (Phase 2, replaces Loops #3 & #5) */
void vm_tick_window_tuner(VM* vm); /* Loop #5: Context-aware window tuning (legacy, kept for compatibility) */
void vm_tick_slope_validator(VM* vm); /* Loop #3: Heat decay validation (legacy, kept for compatibility) */
void vm_snapshot_read(const VM* vm, HeartbeatSnapshot* out_snapshot); /* Copy latest heartbeat snapshot */
/* Real-time heartbeat tick emission (Phase 2: Multivariate Dynamics) */
void heartbeat_capture_tick_snapshot(VM* vm, HeartbeatTickSnapshot* snapshot); /* Capture current VM metrics into tick snapshot */
void heartbeat_emit_tick_row(VM* vm, HeartbeatTickSnapshot* snapshot); /* Emit tick snapshot as CSV row to stderr */
/* Start background heartbeat thread and/or enable heartbeat processing. */
void vm_heartbeat_start(VM* vm);
/* ===== Performance optimizations for release builds ==================== */
#ifdef STARFORTH_PERFORMANCE
/* Fast inline stack operations - skip bounds checking in performance builds */
static inline void vm_push_fast(VM* vm, cell_t value)
{
vm->data_stack[++vm->dsp] = value;
}
static inline cell_t vm_pop_fast(VM* vm)
{
return vm->data_stack[vm->dsp--];
}
static inline void vm_rpush_fast(VM* vm, cell_t value)
{
vm->return_stack[++vm->rsp] = value;
}
static inline cell_t vm_rpop_fast(VM* vm)
{
return vm->return_stack[vm->rsp--];
}
/* Performance macros - use fast paths in hot code */
#define VM_PUSH(vm, val) vm_push_fast(vm, val)
#define VM_POP(vm) vm_pop_fast(vm)
#define VM_RPUSH(vm, val) vm_rpush_fast(vm, val)
#define VM_RPOP(vm) vm_rpop_fast(vm)
/* Likely/unlikely branch prediction hints */
#define LIKELY(x) __builtin_expect(!!(x), 1)
#define UNLIKELY(x) __builtin_expect(!!(x), 0)
#else
/* Safe versions with bounds checking for debug builds */
#define VM_PUSH(vm, val) vm_push(vm, val)
#define VM_POP(vm) vm_pop(vm)
#define VM_RPUSH(vm, val) vm_rpush(vm, val)
#define VM_RPOP(vm) vm_rpop(vm)
#define LIKELY(x) (x)
#define UNLIKELY(x) (x)
#endif
#endif /* VM_H */
v3/include/vm_api.h
+130
View File
@@ -0,0 +1,130 @@
/*
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.
*/
/**
* @file vm_api.h
* @brief StarForth Virtual Machine Public API
*
* This header provides the public interface for interacting with the StarForth
* Virtual Machine, particularly focusing on input handling and memory management.
*/
#ifndef VM_API_H
#define VM_API_H
#include "vm.h"
#ifdef __cplusplus
extern "C" {
#endif
/**
* @defgroup vm_input VM Input Operations
* @{
* Public API for managing VM input operations including Terminal Input Buffer (TIB),
* input pointer (>IN), and input span (SPAN) handling.
*/
/*
* @brief Ensures input buffer initialization
* @param vm Pointer to VM instance
* @return 0 on success, non-zero on failure
*
* Allocates and initializes input buffer if not already done.
*/
int vm_input_ensure(VM * vm);
/*
* @brief Retrieves Terminal Input Buffer address
* @param vm Pointer to VM instance
* @return Pointer to TIB buffer
*/
unsigned char *vm_input_tib(VM * vm);
/*
* @brief Retrieves input pointer address
* @param vm Pointer to VM instance
* @return Pointer to >IN cell
*/
cell_t *vm_input_in(VM * vm);
/*
* @brief Retrieves span cell address
* @param vm Pointer to VM instance
* @return Pointer to SPAN cell
*/
cell_t *vm_input_span(VM * vm);
/*
* @brief Loads a line into TIB
* @param vm Pointer to VM instance
* @param src Source string to copy
* @param n Number of bytes to copy
*
* Copies data into TIB, updates SPAN, and resets >IN.
*/
void vm_input_load_line(VM *vm, const char *src, size_t n);
/*
* @brief Gets current input source
* @param vm Pointer to VM instance
* @param out_addr Output parameter for source address
* @param out_len Output parameter for source length
*
* Returns SOURCE pair (address, length) for current input.
*/
void vm_input_source(VM * vm, cell_t * out_addr, cell_t * out_len);
/*
* @brief Converts host pointer to Forth address
* @param vm Pointer to VM instance
* @param p Host memory pointer
* @return Forth memory address (offset into vm->memory)
*/
cell_t vm_addr_from_ptr(VM *vm, void *p);
/** @} */
#ifdef __cplusplus
}
#endif
#endif /* VM_API_H */
v3/include/vm_asm_opt.h
+606
View File
@@ -0,0 +1,606 @@
/*
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 ***
vm_asm_opt.h - x86_64 Inline Assembly Optimizations
Compatible with: Linux, bare metal x86_64
HISTORICAL: the "L4Re Compatibility" notes throughout this file describe
a target that was supported through mid-2026. L4Re support has since
been removed as an active target; these notes are retained as historical
design rationale (pure computational/unprivileged code has no reason to
become L4Re-incompatible, so the analysis still holds, it's just no
longer relevant to any build).
This work is released under license terms in LICENSE file.
No warranty. Use at your own risk.
*/
#ifndef VM_ASM_OPT_H
#define VM_ASM_OPT_H
#include "vm.h"
#include <stdint.h>
/*
* Configuration: Define USE_ASM_OPT=1 to enable assembly optimizations
* Define USE_ASM_OPT=0 or leave undefined to use standard C implementations
*/
#ifndef USE_ASM_OPT
#define USE_ASM_OPT 0
#endif
/**
* @defgroup stack_ops Stack Operations
* @{
*
* @brief Optimized stack manipulation operations
* @details Critical optimizations for vm_push, vm_pop, vm_rpush, vm_rpop
*
* Impact: EXTREME - These are called on nearly every Forth word execution
*
* Benefits:
* - Eliminates function call overhead (inline)
* - Reduces branch mispredictions with conditional moves
* - Keeps frequently-used values in registers
* - Uses lea for pointer arithmetic (no flags affected)
*
* L4Re Compatibility: YES - Pure computational code, no syscalls
*/
#if USE_ASM_OPT
/* vm_push optimized - Data stack push */
/**
* @brief Optimized data stack push operation
* @param vm Pointer to VM context
* @param value Value to push onto stack
* @return void
* @note Sets vm->error on stack overflow
*/
static inline void vm_push_asm(VM *vm, cell_t value) {
int error = 0;
__asm__ __volatile__(
/* Load current dsp into register with sign extension */
"movslq %[dsp], %%rax\n\t"
/* Check for overflow: dsp >= STACK_SIZE-1 (1023) */
"cmpq $1022, %%rax\n\t"
"jg 1f\n\t" /* Jump if overflow */
/* No overflow: increment dsp */
"addq $1, %%rax\n\t" /* rax = dsp + 1 */
"movl %%eax, %[dsp]\n\t" /* Save new dsp (32-bit) */
/* Store value: vm->data_stack[dsp] = value (dsp already incremented) */
"movq %[val], (%[stack], %%rax, 8)\n\t"
/* Success: set error = 0 */
"xorl %[err], %[err]\n\t"
"jmp 2f\n\t"
/* Overflow path */
"1:\n\t"
"movl $1, %[err]\n\t"
"2:\n\t"
: [dsp]"+m"(vm->dsp),
[err]"=&r"(error)
: [val]"r"(value),
[stack]"r"(vm->data_stack)
: "rax", "cc", "memory"
);
if (__builtin_expect(error, 0)) {
vm->error = 1;
/* Note: Logging omitted for performance - enable in debug builds only */
}
}
/* vm_pop optimized - Data stack pop */
/**
* @brief Optimized data stack pop operation
* @param vm Pointer to VM context
* @return Top value from stack, 0 on underflow
* @note Sets vm->error on stack underflow
*/
static inline cell_t vm_pop_asm(VM *vm) {
cell_t value = 0;
int error = 0;
__asm__ __volatile__(
/* Load current dsp with sign extension */
"movslq %[dsp], %%rax\n\t"
/* Check for underflow: dsp < 0 */
"testq %%rax, %%rax\n\t"
"js 1f\n\t" /* Jump if negative (underflow) */
/* No underflow: load value */
"movq (%[stack], %%rax, 8), %[val]\n\t"
/* Decrement dsp */
"subq $1, %%rax\n\t"
"movl %%eax, %[dsp]\n\t"
/* Success: set error = 0 */
"xorl %[err], %[err]\n\t"
"jmp 2f\n\t"
/* Underflow path */
"1:\n\t"
"movl $1, %[err]\n\t"
"xorq %%rax, %%rax\n\t" /* Return 0 on error */
"movq %%rax, %[val]\n\t"
"2:\n\t"
: [dsp]"+m"(vm->dsp),
[val]"=&r"(value),
[err]"=&r"(error)
: [stack]"r"(vm->data_stack)
: "rax", "cc", "memory"
);
if (__builtin_expect(error, 0)) {
vm->error = 1;
}
return value;
}
/* vm_rpush optimized - Return stack push */
/**
* @brief Optimized return stack push operation
* @param vm Pointer to VM context
* @param value Value to push onto return stack
* @return void
* @note Sets vm->error on stack overflow
*/
static inline void vm_rpush_asm(VM *vm, cell_t value) {
int error = 0;
__asm__ __volatile__(
"movslq %[rsp], %%rax\n\t"
"cmpq $1022, %%rax\n\t"
"jg 1f\n\t"
"addq $1, %%rax\n\t"
"movl %%eax, %[rsp]\n\t"
"movq %[val], (%[stack], %%rax, 8)\n\t"
"xorl %[err], %[err]\n\t"
"jmp 2f\n\t"
"1:\n\t"
"movl $1, %[err]\n\t"
"2:\n\t"
: [rsp]"+m"(vm->rsp),
[err]"=&r"(error)
: [val]"r"(value),
[stack]"r"(vm->return_stack)
: "rax", "cc", "memory"
);
if (__builtin_expect(error, 0)) {
vm->error = 1;
}
}
/* vm_rpop optimized - Return stack pop */
/**
* @brief Optimized return stack pop operation
* @param vm Pointer to VM context
* @return Top value from return stack, 0 on underflow
* @note Sets vm->error on stack underflow
*/
static inline cell_t vm_rpop_asm(VM *vm) {
cell_t value = 0;
int error = 0;
__asm__ __volatile__(
"movslq %[rsp], %%rax\n\t"
"testq %%rax, %%rax\n\t"
"js 1f\n\t"
"movq (%[stack], %%rax, 8), %[val]\n\t"
"subq $1, %%rax\n\t"
"movl %%eax, %[rsp]\n\t"
"xorl %[err], %[err]\n\t"
"jmp 2f\n\t"
"1:\n\t"
"movl $1, %[err]\n\t"
"xorq %%rax, %%rax\n\t"
"movq %%rax, %[val]\n\t"
"2:\n\t"
: [rsp]"+m"(vm->rsp),
[val]"=&r"(value),
[err]"=&r"(error)
: [stack]"r"(vm->return_stack)
: "rax", "cc", "memory"
);
if (__builtin_expect(error, 0)) {
vm->error = 1;
}
return value;
}
/* ============================================================================
* OPTIMIZATION 2: Fast Arithmetic with Overflow Detection
* ============================================================================
*
* IMPACT: MEDIUM-HIGH
*
* Benefits:
* - Uses CPU overflow flag instead of manual checks
* - Eliminates branches in common (no overflow) case
* - Single instruction for addition/subtraction with flag check
*
* L4Re Compatibility: YES
* ============================================================================
*/
/* Fast add with overflow detection */
/**
* @brief Performs addition with hardware overflow detection
* @param a First operand
* @param b Second operand
* @param result Pointer to store result
* @return 1 if overflow occurred, 0 otherwise
*/
static inline int vm_add_check_overflow(cell_t a, cell_t b, cell_t *result) {
cell_t res;
int overflow;
__asm__(
"movq %[a], %%rax\n\t"
"addq %[b], %%rax\n\t"
"movq %%rax, %[res]\n\t"
"seto %%al\n\t" /* Set AL to 1 if overflow occurred */
"movzbl %%al, %[ovf]\n\t"
: [res]"=r"(res),
[ovf]"=r"(overflow)
: [a]"r"(a),
[b]"r"(b)
: "rax", "cc"
);
*result = res;
return overflow;
}
/* Fast subtract with overflow detection */
/**
* @brief Performs subtraction with hardware overflow detection
* @param a First operand (minuend)
* @param b Second operand (subtrahend)
* @param result Pointer to store result
* @return 1 if overflow occurred, 0 otherwise
*/
static inline int vm_sub_check_overflow(cell_t a, cell_t b, cell_t *result) {
cell_t res;
int overflow;
__asm__(
"movq %[a], %%rax\n\t"
"subq %[b], %%rax\n\t"
"movq %%rax, %[res]\n\t"
"seto %%al\n\t" /* Set AL to 1 if overflow occurred */
"movzbl %%al, %[ovf]\n\t"
: [res]"=r"(res),
[ovf]"=r"(overflow)
: [a]"r"(a),
[b]"r"(b)
: "rax", "cc"
);
*result = res;
return overflow;
}
/* Fast multiply with double-width result for */ /* MOD operations */
/**
* @brief Performs double-width multiplication
* @param a First operand
* @param b Second operand
* @param hi Pointer to store high 64 bits
* @param lo Pointer to store low 64 bits
*/
static inline void vm_mul_double(cell_t a, cell_t b, cell_t *hi, cell_t *lo) {
__asm__(
"movq %[a], %%rax\n\t"
"imulq %[b]\n\t" /* rdx:rax = rax * b (signed) */
"movq %%rax, %[lo]\n\t"
"movq %%rdx, %[hi]\n\t"
: [lo]"=r"(*lo),
[hi]"=r"(*hi)
: [a]"r"(a),
[b]"r"(b)
: "rax", "rdx", "cc"
);
}
/* Fast divide with remainder (for /MOD) */
/**
* @brief Performs division with remainder
* @param dividend Dividend value
* @param divisor Divisor value
* @param quotient Pointer to store quotient
* @param remainder Pointer to store remainder
*/
static inline void vm_divmod(cell_t dividend, cell_t divisor,
cell_t *quotient, cell_t *remainder) {
cell_t quot, rem;
__asm__(
"movq %[dividend], %%rax\n\t"
"cqo\n\t" /* Sign-extend rax into rdx:rax */
"idivq %[divisor]\n\t" /* rax = quotient, rdx = remainder */
"movq %%rax, %[quot]\n\t"
"movq %%rdx, %[rem]\n\t"
: [quot]"=r"(quot),
[rem]"=r"(rem)
: [dividend]"r"(dividend),
[divisor]"r"(divisor)
: "rax", "rdx", "cc"
);
*quotient = quot;
*remainder = rem;
}
/* ============================================================================
* OPTIMIZATION 3: Fast String Operations for Dictionary Lookup
* ============================================================================
*
* IMPACT: HIGH
*
* Benefits:
* - Uses hardware string comparison (rep cmpsb)
* - Processes bytes in parallel
* - Much faster than byte-by-byte C loop
*
* L4Re Compatibility: YES
* ============================================================================
*/
/* Fast string comparison - returns 0 if equal, non-zero otherwise */
/**
* @brief Hardware-accelerated string comparison
* @param s1 First string
* @param s2 Second string
* @param len Length to compare
* @return 0 if equal, non-zero otherwise
*/
static inline int vm_strcmp_asm(const char *s1, const char *s2, size_t len) {
int result;
__asm__(
"movq %[s1], %%rsi\n\t"
"movq %[s2], %%rdi\n\t"
"movq %[len], %%rcx\n\t"
"xorl %%eax, %%eax\n\t"
"repe cmpsb\n\t" /* Compare bytes while equal */
"je 1f\n\t" /* If all equal, result = 0 */
"movl $1, %%eax\n\t" /* Not equal, result = 1 */
"1:\n\t"
: "=a"(result)
: [s1]"r"(s1),
[s2]"r"(s2),
[len]"r"(len)
: "rsi", "rdi", "rcx", "cc", "memory"
);
return result;
}
/* Fast memory copy for block operations */
/**
* @brief Hardware-accelerated memory copy
* @param dest Destination buffer
* @param src Source buffer
* @param len Number of bytes to copy
*/
static inline void vm_memcpy_asm(void *dest, const void *src, size_t len) {
__asm__ __volatile__(
"movq %[dst], %%rdi\n\t"
"movq %[src], %%rsi\n\t"
"movq %[len], %%rcx\n\t"
"rep movsb\n\t" /* Copy bytes */
:
: [dst]"r"(dest),
[src]"r"(src),
[len]"r"(len)
: "rdi", "rsi", "rcx", "memory"
);
}
/* Fast memory zero for alignment padding */
/**
* @brief Hardware-accelerated memory zero
* @param dest Buffer to zero
* @param len Number of bytes to zero
*/
static inline void vm_memzero_asm(void *dest, size_t len) {
__asm__ __volatile__(
"movq %[dst], %%rdi\n\t"
"xorl %%eax, %%eax\n\t"
"movq %[len], %%rcx\n\t"
"rep stosb\n\t" /* Store zeros */
:
: [dst]"r"(dest),
[len]"r"(len)
: "rdi", "rax", "rcx", "memory"
);
}
/* ============================================================================
* OPTIMIZATION 4: Branchless Min/Max
* ============================================================================
*
* IMPACT: MEDIUM
*
* Benefits:
* - No branches = no mispredictions
* - Single cmov instruction
*
* L4Re Compatibility: YES
* ============================================================================
*/
/**
* @brief Branchless minimum calculation
* @param a First value
* @param b Second value
* @return Smaller of a and b
*/
static inline cell_t vm_min_asm(cell_t a, cell_t b) {
cell_t result;
__asm__(
"movq %[a], %%rax\n\t"
"movq %[b], %%rcx\n\t"
"cmpq %%rcx, %%rax\n\t"
"cmovg %%rcx, %%rax\n\t" /* Move if a > b */
"movq %%rax, %[res]\n\t"
: [res]"=r"(result)
: [a]"r"(a),
[b]"r"(b)
: "rax", "rcx", "cc"
);
return result;
}
/**
* @brief Branchless maximum calculation
* @param a First value
* @param b Second value
* @return Larger of a and b
*/
static inline cell_t vm_max_asm(cell_t a, cell_t b) {
cell_t result;
__asm__(
"movq %[a], %%rax\n\t"
"movq %[b], %%rcx\n\t"
"cmpq %%rcx, %%rax\n\t"
"cmovl %%rcx, %%rax\n\t" /* Move if a < b */
"movq %%rax, %[res]\n\t"
: [res]"=r"(result)
: [a]"r"(a),
[b]"r"(b)
: "rax", "rcx", "cc"
);
return result;
}
/* ============================================================================
* OPTIMIZATION 5: CPU Feature Detection
* ============================================================================
*
* For future SIMD optimizations
* L4Re Compatibility: YES (cpuid is unprivileged)
* ============================================================================
*/
/**
* @brief Wrapper for CPUID instruction
* @param leaf CPUID leaf number
* @param eax Pointer to store EAX result
* @param ebx Pointer to store EBX result
* @param ecx Pointer to store ECX result
* @param edx Pointer to store EDX result
*/
static inline void vm_cpuid(uint32_t leaf, uint32_t *eax, uint32_t *ebx,
uint32_t *ecx, uint32_t *edx) {
__asm__(
"cpuid"
: "=a"(*eax), "=b"(*ebx), "=c"(*ecx), "=d"(*edx)
: "a"(leaf)
);
}
/* Check for SSE4.2 support (for fast string operations) */
/**
* @brief Checks for SSE4.2 support
* @return 1 if SSE4.2 is supported, 0 otherwise
*/
static inline int vm_has_sse42(void) {
uint32_t eax, ebx, ecx, edx;
vm_cpuid(1, &eax, &ebx, &ecx, &edx);
return (ecx >> 20) & 1; /* Bit 20 = SSE4.2 */
}
#else /* !USE_ASM_OPT */
/* Fallback to standard implementations when assembly is disabled */
#define vm_push_asm(vm, val) vm_push(vm, val)
#define vm_pop_asm(vm) vm_pop(vm)
#define vm_rpush_asm(vm, val) vm_rpush(vm, val)
#define vm_rpop_asm(vm) vm_rpop(vm)
#endif /* USE_ASM_OPT */
/* ============================================================================
* L4Re SPECIFIC NOTES
* ============================================================================
*
* All optimizations above are L4Re-compatible because they:
* 1. Don't use privileged instructions
* 2. Don't make syscalls
* 3. Don't access hardware directly
* 4. Are pure computational optimizations
*
* For L4Re integration:
* - Compile with -march=native or -march=x86-64-v3 for modern CPUs
* - Use L4Re's memory allocators for VM memory
* - Consider using L4Re IPC for inter-VM communication
* - Profile using L4Re's performance counters
*
* Build flags for optimal performance:
* -DUSE_ASM_OPT=1 -O3 -march=native -flto
*
* For StarshipOS integration:
* - These functions can be used in both userspace and kernel contexts
* - No floating point operations (safe for kernel mode)
* - No stack-intensive operations (safe for small kernel stacks)
* ============================================================================
*/
#endif /* VM_ASM_OPT_H */
v3/include/vm_asm_opt_arm64.h
+783
View File
@@ -0,0 +1,783 @@
/*
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.
*/
#ifndef VM_ASM_OPT_ARM64_H
#define VM_ASM_OPT_ARM64_H
#include "vm.h"
#include <stdint.h>
#ifdef __linux__
#include <sys/auxv.h> /* For getauxval, AT_HWCAP */
#include <asm/hwcap.h> /* For HWCAP_ASIMD */
#endif
/*
* Configuration: Define USE_ASM_OPT=1 to enable assembly optimizations
*/
#ifndef USE_ASM_OPT
#define USE_ASM_OPT 0
#endif
/*
* ARM64 Architecture Notes:
* =========================
*
* Registers (64-bit):
* - x0-x7: Argument/result registers
* - x8: Indirect result location
* - x9-x15: Temporary registers (caller-saved)
* - x16-x17: Intra-procedure-call temporary (IP0, IP1)
* - x18: Platform register (reserved on some platforms)
* - x19-x28: Callee-saved registers (must preserve)
* - x29: Frame pointer (FP)
* - x30: Link register (LR)
* - sp: Stack pointer
*
* 32-bit variants: w0-w30 (lower 32 bits of x0-x30)
*
* Advantages over x86_64:
* - More registers (31 general-purpose vs 16)
* - Conditional execution on most instructions
* - Load/store with auto-increment
* - Better power efficiency
*
* Raspberry Pi 4 specifics:
* - Cortex-A72 CPU (4 cores @ 1.5GHz)
* - ARMv8-A architecture
* - 32KB L1I + 32KB L1D per core
* - 1MB shared L2 cache
* - NEON SIMD support
*/
/* ============================================================================
* OPTIMIZATION 1: Stack Operations (vm_push, vm_pop, vm_rpush, vm_rpop)
* ============================================================================
*
* ARM64 advantages:
* - Conditional execution eliminates branches
* - Load/store with immediate offset
* - Post-increment addressing modes
*
* ============================================================================
*/
#if USE_ASM_OPT
/* vm_push optimized - Data stack push */
/**
* @brief Optimized assembly implementation of data stack push operation
* @param vm Pointer to VM instance
* @param value Value to push onto data stack
* @note Sets vm->error on stack overflow
*/
static inline void vm_push_asm(VM *vm, cell_t value) {
int error = 0;
__asm__ __volatile__(
/* Load current dsp */
"ldr w0, %[dsp]\n\t"
/* Check for overflow: dsp >= 1022 */
"cmp w0, #1022\n\t"
"b.ge 1f\n\t" /* Branch if >= */
/* No overflow: increment dsp */
"add w1, w0, #1\n\t" /* w1 = dsp + 1 */
"str w1, %[dsp]\n\t"
/* Store value: vm->data_stack[dsp+1] = value */
/* Calculate address: base + (dsp+1)*8 */
"str %[val], [%[stack], w1, sxtw #3]\n\t" /* base + index*8 */
/* Set error=0 in success path */
"mov w3, #0\n\t"
"str w3, %[err]\n\t"
"b 2f\n\t"
/* Overflow path */
"1:\n\t"
"mov w3, #1\n\t"
"str w3, %[err]\n\t"
"2:\n\t"
: [dsp]"+m"(vm->dsp),
[err]"=m"(error)
: [val]"r"(value),
[stack]"r"(vm->data_stack)
: "x0", "x1", "x3", "cc", "memory"
);
if (__builtin_expect(error, 0)) {
vm->error = 1;
}
}
/* vm_pop optimized - Data stack pop */
/**
* @brief Optimized assembly implementation of data stack pop operation
* @param vm Pointer to VM instance
* @return Popped value, or 0 on underflow
* @note Sets vm->error on stack underflow
*/
static inline cell_t vm_pop_asm(VM *vm) {
cell_t value = 0;
int error = 0;
__asm__ __volatile__(
/* Load current dsp */
"ldr w0, %[dsp]\n\t"
/* Check for underflow: dsp < 0 */
"cmp w0, #0\n\t"
"b.lt 1f\n\t" /* Branch if less than */
/* No underflow: load value */
"ldr %[val], [%[stack], w0, sxtw #3]\n\t" /* base + index*8 */
/* Decrement dsp */
"sub w1, w0, #1\n\t"
"str w1, %[dsp]\n\t"
/* Set error=0 in success path */
"mov w3, #0\n\t"
"str w3, %[err]\n\t"
"b 2f\n\t"
/* Underflow path */
"1:\n\t"
"mov w3, #1\n\t"
"str w3, %[err]\n\t"
"mov %[val], #0\n\t" /* Return 0 on error */
"2:\n\t"
: [dsp]"+m"(vm->dsp),
[val]"=r"(value),
[err]"=m"(error)
: [stack]"r"(vm->data_stack)
: "x0", "x1", "x3", "cc", "memory"
);
if (__builtin_expect(error, 0)) {
vm->error = 1;
}
return value;
}
/* vm_rpush optimized - Return stack push */
/**
* @brief Optimized assembly implementation of return stack push operation
* @param vm Pointer to VM instance
* @param value Value to push onto return stack
* @note Sets vm->error on stack overflow
*/
static inline void vm_rpush_asm(VM *vm, cell_t value) {
int error = 0;
__asm__ __volatile__(
"ldr w0, %[rsp]\n\t"
"cmp w0, #1022\n\t"
"b.ge 1f\n\t"
"add w1, w0, #1\n\t"
"str w1, %[rsp]\n\t"
"str %[val], [%[stack], w1, sxtw #3]\n\t"
"mov w3, #0\n\t"
"str w3, %[err]\n\t"
"b 2f\n\t"
"1:\n\t"
"mov w3, #1\n\t"
"str w3, %[err]\n\t"
"2:\n\t"
: [rsp]"+m"(vm->rsp),
[err]"=m"(error)
: [val]"r"(value),
[stack]"r"(vm->return_stack)
: "x0", "x1", "x3", "cc", "memory"
);
if (__builtin_expect(error, 0)) {
vm->error = 1;
}
}
/* vm_rpop optimized - Return stack pop */
/**
* @brief Optimized assembly implementation of return stack pop operation
* @param vm Pointer to VM instance
* @return Popped value, or 0 on underflow
* @note Sets vm->error on stack underflow
*/
static inline cell_t vm_rpop_asm(VM *vm) {
cell_t value = 0;
int error = 0;
__asm__ __volatile__(
"ldr w0, %[rsp]\n\t"
"cmp w0, #0\n\t"
"b.lt 1f\n\t"
"ldr %[val], [%[stack], w0, sxtw #3]\n\t"
"sub w1, w0, #1\n\t"
"str w1, %[rsp]\n\t"
"mov w3, #0\n\t"
"str w3, %[err]\n\t"
"b 2f\n\t"
"1:\n\t"
"mov w3, #1\n\t"
"str w3, %[err]\n\t"
"mov %[val], #0\n\t"
"2:\n\t"
: [rsp]"+m"(vm->rsp),
[val]"=r"(value),
[err]"=m"(error)
: [stack]"r"(vm->return_stack)
: "x0", "x1", "x3", "cc", "memory"
);
if (__builtin_expect(error, 0)) {
vm->error = 1;
}
return value;
}
/* ============================================================================
* OPTIMIZATION 2: Fast Arithmetic with Overflow Detection
* ============================================================================
*
* ARM64 has excellent support for overflow detection via condition flags
* and conditional select instructions
*
* ============================================================================
*/
/* Fast add with overflow detection using ADDS and conditional select */
/**
* @brief Fast addition with overflow detection using ARM64 ADDS instruction
* @param a First operand
* @param b Second operand
* @param result Pointer to store result
* @return 1 if overflow occurred, 0 otherwise
*/
static inline int vm_add_check_overflow(cell_t a, cell_t b, cell_t *result) {
cell_t res;
int overflow;
__asm__(
"adds %[res], %[a], %[b]\n\t" /* Add and set flags */
"cset %w[ovf], vs\n\t" /* Set overflow flag (V flag) */
: [res]"=r"(res),
[ovf]"=r"(overflow)
: [a]"r"(a),
[b]"r"(b)
: "cc"
);
*result = res;
return overflow;
}
/* Fast subtract with overflow detection */
/**
* @brief Fast subtraction with overflow detection using ARM64 SUBS instruction
* @param a First operand
* @param b Second operand
* @param result Pointer to store result
* @return 1 if overflow occurred, 0 otherwise
*/
static inline int vm_sub_check_overflow(cell_t a, cell_t b, cell_t *result) {
cell_t res;
int overflow;
__asm__(
"subs %[res], %[a], %[b]\n\t"
"cset %w[ovf], vs\n\t"
: [res]"=r"(res),
[ovf]"=r"(overflow)
: [a]"r"(a),
[b]"r"(b)
: "cc"
);
*result = res;
return overflow;
}
/* Fast multiply with high-word result (for star-slash-MOD) */
/**
* @brief Fast 128-bit multiplication using ARM64 SMULH instruction
* @param a First operand
* @param b Second operand
* @param hi Pointer to store high 64 bits of result
* @param lo Pointer to store low 64 bits of result
*/
static inline void vm_mul_double(cell_t a, cell_t b, cell_t *hi, cell_t *lo) {
__asm__(
"mul %[lo], %[a], %[b]\n\t" /* Low 64 bits */
"smulh %[hi], %[a], %[b]\n\t" /* High 64 bits (signed) */
: [lo]"=r"(*lo),
[hi]"=r"(*hi)
: [a]"r"(a),
[b]"r"(b)
);
}
/* Fast divide with remainder (for /MOD) */
/**
* @brief Fast division with remainder using ARM64 SDIV and MSUB instructions
* @param dividend Dividend value
* @param divisor Divisor value
* @param quotient Pointer to store quotient
* @param remainder Pointer to store remainder
*/
static inline void vm_divmod(cell_t dividend, cell_t divisor,
cell_t *quotient, cell_t *remainder) {
cell_t quot, rem;
__asm__(
"sdiv %[quot], %[dividend], %[divisor]\n\t" /* Quotient */
"msub %[rem], %[quot], %[divisor], %[dividend]\n\t" /* Remainder = dividend - quot*divisor */
: [quot]"=r"(quot),
[rem]"=r"(rem)
: [dividend]"r"(dividend),
[divisor]"r"(divisor)
);
*quotient = quot;
*remainder = rem;
}
/* ============================================================================
* OPTIMIZATION 3: Fast String Operations for Dictionary Lookup
* ============================================================================
*
* ARM64 doesn't have rep-style instructions, but we can:
* - Use NEON for parallel comparison
* - Use load-multiple for cache efficiency
* - Unroll loops for small strings
*
* ============================================================================
*/
/* Fast string comparison for short strings (<=32 bytes) */
/**
* @brief Optimized string comparison for short strings (<=32 bytes)
* @param s1 First string
* @param s2 Second string
* @param len Length to compare
* @return 0 if equal, 1 if different
*/
static inline int vm_strcmp_short_asm(const char *s1, const char *s2, size_t len) {
int result = 0;
if (len <= 8) {
/* Use single 64-bit load for strings <= 8 bytes */
__asm__(
"mov x0, #0\n\t" /* result = 0 */
"cbz %[len], 2f\n\t" /* if len==0, equal */
"ldr x1, [%[s1]]\n\t"
"ldr x2, [%[s2]]\n\t"
"eor x3, x1, x2\n\t" /* XOR to find differences */
/* Mask off bits beyond length */
"mov x4, #64\n\t"
"lsl x5, %[len], #3\n\t" /* len * 8 */
"sub x4, x4, x5\n\t"
"lsr x1, x1, x4\n\t"
"lsr x2, x2, x4\n\t"
"eor x3, x1, x2\n\t"
"cmp x3, #0\n\t"
"cset %w[res], ne\n\t" /* result = (x3 != 0) */
"2:\n\t"
: [res]"=r"(result)
: [s1]"r"(s1),
[s2]"r"(s2),
[len]"r"(len)
: "x0", "x1", "x2", "x3", "x4", "x5", "cc", "memory"
);
} else {
/* Fallback to byte-by-byte for longer strings */
for (size_t i = 0; i < len; i++) {
if (s1[i] != s2[i]) {
result = 1;
break;
}
}
}
return result;
}
/* Fast string comparison using NEON (for longer strings) */
#ifdef __ARM_NEON
static inline int vm_strcmp_neon(const char *s1, const char *s2, size_t len) {
int result = 0;
/* Process 16 bytes at a time using NEON */
while (len >= 16) {
__asm__ __volatile__(
"ld1 {v0.16b}, [%[s1]], #16\n\t" /* Load 16 bytes from s1, post-increment */
"ld1 {v1.16b}, [%[s2]], #16\n\t" /* Load 16 bytes from s2, post-increment */
"cmeq v2.16b, v0.16b, v1.16b\n\t" /* Compare equal */
"uminv b3, v2.16b\n\t" /* Get minimum (all must be 0xFF for equal) */
"fmov %w[res], s3\n\t" /* Move to general register */
"cmp %w[res], #0xff\n\t"
"b.ne 1f\n\t" /* If not all equal, exit */
"1:\n\t"
: [res]"=r"(result),
[s1]"+r"(s1),
[s2]"+r"(s2)
:
: "v0", "v1", "v2", "v3", "cc", "memory"
);
if (result != 0xFF) {
return 1; /* Not equal */
}
len -= 16;
}
/* Handle remaining bytes */
while (len > 0) {
if (*s1++ != *s2++) return 1;
len--;
}
return 0;
}
#endif
/* Main string comparison wrapper */
static inline int vm_strcmp_asm(const char *s1, const char *s2, size_t len) {
#ifdef __ARM_NEON
if (len>= 16) {
return vm_strcmp_neon(s1, s2, len);
}
#endif
return vm_strcmp_short_asm(s1, s2, len);
}
/* Fast memory copy optimized for ARM64 */
/**
* @brief Optimized memory copy using ARM64 load/store pair instructions
* @param dest Destination buffer
* @param src Source buffer
* @param len Number of bytes to copy
*/
static inline void vm_memcpy_asm(void *dest, const void *src, size_t len) {
/* ARM64 has efficient load/store pair instructions */
if (len >= 16) {
__asm__ __volatile__(
"1:\n\t"
"ldp x0, x1, [%[src]], #16\n\t" /* Load pair, post-increment */
"stp x0, x1, [%[dst]], #16\n\t" /* Store pair, post-increment */
"subs %[len], %[len], #16\n\t"
"b.ge 1b\n\t"
: [src]"+r"(src),
[dst]"+r"(dest),
[len]"+r"(len)
:
: "x0", "x1", "cc", "memory"
);
len += 16; /* Adjust for overshoot */
}
/* Copy remaining bytes */
char *d = (char *) dest;
const char *s = (const char *) src;
while (len-- > 0) {
*d++ = *s++;
}
}
/* Fast memory zero using store pair */
/**
* @brief Fast memory zeroing using ARM64 store pair instructions
* @param dest Buffer to zero
* @param len Number of bytes to zero
*/
static inline void vm_memzero_asm(void *dest, size_t len) {
if (len >= 16) {
__asm__ __volatile__(
"1:\n\t"
"stp xzr, xzr, [%[dst]], #16\n\t" /* Store zero pair */
"subs %[len], %[len], #16\n\t"
"b.ge 1b\n\t"
: [dst]"+r"(dest),
[len]"+r"(len)
:
: "cc", "memory"
);
len += 16;
}
/* Zero remaining bytes */
char *d = (char *) dest;
while (len-- > 0) {
*d++ = 0;
}
}
/* ============================================================================
* OPTIMIZATION 4: Branchless Min/Max using CSEL
* ============================================================================
*
* ARM64's conditional select is perfect for branchless operations
*
* ============================================================================
*/
static inline cell_t vm_min_asm(cell_t a, cell_t b) {
cell_t result;
__asm__(
"cmp %[a], %[b]\n\t"
"csel %[res], %[a], %[b], lt\n\t" /* Select a if a < b, else b */
: [res]"=r"(result)
: [a]"r"(a),
[b]"r"(b)
: "cc"
);
return result;
}
static inline cell_t vm_max_asm(cell_t a, cell_t b) {
cell_t result;
__asm__(
"cmp %[a], %[b]\n\t"
"csel %[res], %[a], %[b], gt\n\t" /* Select a if a > b, else b */
: [res]"=r"(result)
: [a]"r"(a),
[b]"r"(b)
: "cc"
);
return result;
}
/* Absolute value using conditional negate */
static inline cell_t vm_abs_asm(cell_t a) {
cell_t result;
__asm__(
"cmp %[a], #0\n\t"
"cneg %[res], %[a], lt\n\t" /* Negate if negative */
: [res]"=r"(result)
: [a]"r"(a)
: "cc"
);
return result;
}
/* ============================================================================
* OPTIMIZATION 5: Bit Manipulation
* ============================================================================
*
* ARM64 has excellent bit manipulation instructions
*
* ============================================================================
*/
/* Count leading zeros */
static inline int vm_clz(cell_t x) {
int result;
__asm__("clz %[res], %[x]": [res]"=r"(result): [x]"r"(x));
return result;
}
/* Count trailing zeros */
static inline int vm_ctz(cell_t x) {
int result;
__asm__(
"rbit %[tmp], %[x]\n\t" /* Reverse bits */
"clz %[res], %[tmp]\n\t" /* Count leading zeros of reversed */
: [res]"=r"(result),
[tmp]"=r"(x)
: [x]"r"(x)
);
return result;
}
/* Population count (count set bits) */
static inline int vm_popcnt(cell_t x) {
int result;
__asm__(
"fmov d0, %[x]\n\t" /* Move to NEON register */
"cnt v0.8b, v0.8b\n\t" /* Count bits in each byte */
"addv b0, v0.8b\n\t" /* Sum all bytes */
"fmov %w[res], s0\n\t" /* Move back to general register */
: [res]"=r"(result)
: [x]"r"(x)
: "v0"
);
return result;
}
/* ============================================================================
* OPTIMIZATION 6: CPU Feature Detection
* ============================================================================
*
* ARM64 uses a different mechanism than x86 CPUID
*
* ============================================================================
*/
/* Read ARM64 CPU ID register */
static inline uint64_t vm_read_midr(void) {
uint64_t midr;
__asm__("mrs %0, midr_el1": "=r"(midr));
return midr;
}
/* Check for specific CPU features via auxiliary control register */
static inline int vm_has_neon(void) {
#ifdef __ARM_NEON
return 1;
#else
return 0;
#endif
}
/* Check for Cortex-A72 (Raspberry Pi 4) */
static inline int vm_is_cortex_a72(void) {
/* Cortex-A72 MIDR: 0x410FD083 */
/* Note: Reading MIDR requires EL1, may not work in userspace */
/* Use hwcaps instead for userspace detection */
#ifdef __linux__
unsigned long hwcap = getauxval(AT_HWCAP);
return (hwcap &HWCAP_ASIMD)!= 0; /* ASIMD = Advanced SIMD (NEON) */
#else
return 0;
#endif
}
/* ============================================================================
* OPTIMIZATION 7: Cache Management (Raspberry Pi 4 specific)
* ============================================================================
*
* Raspberry Pi 4 cache hierarchy:
* - L1I: 32KB (3-way, 64-byte lines)
* - L1D: 32KB (2-way, 64-byte lines)
* - L2: 1MB (16-way, 64-byte lines)
*
* ============================================================================
*/
/* Prefetch data into cache */
static inline void vm_prefetch(const void *addr) {
__asm__ __volatile__(
"prfm pldl1keep, [%0]\n\t" /* Prefetch for load, L1 cache, temporal */
:
: "r"(addr)
: "memory"
);
}
/* Prefetch with streaming hint (for sequential access) */
static inline void vm_prefetch_stream(const void *addr) {
__asm__ __volatile__(
"prfm pldl1strm, [%0]\n\t" /* Prefetch for load, L1 cache, streaming */
:
: "r"(addr)
: "memory"
);
}
/* Data cache zero (fast way to zero cache lines) */
static inline void vm_dc_zva(void *addr) {
__asm__ __volatile__(
"dc zva, %0\n\t" /* Zero entire cache line (64 bytes) */
:
: "r"(addr)
: "memory"
);
}
#else /* !USE_ASM_OPT */
/* Fallback to standard implementations */
#define vm_push_asm(vm, val) vm_push(vm, val)
#define vm_pop_asm(vm) vm_pop(vm)
#define vm_rpush_asm(vm, val) vm_rpush(vm, val)
#define vm_rpop_asm(vm) vm_rpop(vm)
#endif /* USE_ASM_OPT */
/* ============================================================================
* RASPBERRY PI 4 SPECIFIC NOTES
* ============================================================================
*
* CPU: Broadcom BCM2711 (Quad-core Cortex-A72 @ 1.5GHz)
* Architecture: ARMv8-A
* L1 Cache: 32KB I + 32KB D per core
* L2 Cache: 1MB shared
* RAM: 1GB/2GB/4GB/8GB LPDDR4-3200
*
* Optimization Tips:
* 1. Align hot data to 64-byte cache lines
* 2. Use NEON for parallel operations
* 3. Prefetch sequential data access
* 4. Keep hot code < 32KB (fits in L1I)
* 5. Use load/store pairs (ldp/stp) for efficiency
*
* Thermal Throttling:
* - CPU throttles at 80°C
* - Add heatsink for sustained performance
* - Monitor: vcgencmd measure_temp
*
* Build Flags:
* -march=armv8-a+crc+simd -mtune=cortex-a72 -O3 -DUSE_ASM_OPT=1
*
* Cross-compilation:
* CC=aarch64-linux-gnu-gcc
*
* ============================================================================
*/
#endif /* VM_ASM_OPT_ARM64_H */
v3/include/vm_asm_opt_riscv64.h
+525
View File
@@ -0,0 +1,525 @@
/*
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.
*/
#ifndef VM_ASM_OPT_RISCV64_H
#define VM_ASM_OPT_RISCV64_H
#include "vm.h"
#include <stdint.h>
/*
* Configuration: Define USE_ASM_OPT=1 to enable assembly optimizations
*/
#ifndef USE_ASM_OPT
#define USE_ASM_OPT 0
#endif
/*
* RISC-V 64 Architecture Notes:
* ==============================
*
* Register ABI (RV64GC / rv64gc):
* - x0 (zero): hardwired zero
* - x1 (ra): return address
* - x2 (sp): stack pointer
* - x3 (gp): global pointer
* - x4 (tp): thread pointer
* - x5–x7 (t0–t2): temporaries (caller-saved)
* - x8–x9 (s0–s1): callee-saved / frame pointer
* - x10–x17 (a0–a7): argument/return (caller-saved)
* - x18–x27 (s2–s11): callee-saved
* - x28–x31 (t3–t6): temporaries (caller-saved)
*
* Key differences vs x86_64 / ARM64:
* - Pure load/store architecture — all ops work on registers
* - No flags register; overflow detection requires explicit instructions
* - No conditional move in base ISA (Zicond ext adds czero.eqz/czero.nez)
* - No string-comparison instructions; byte loops required
* - M extension: mul, mulh, div, rem — all present in rv64gc
* - B extension (Zba/Zbb/Zbc): clz, ctz, cpop, etc. — NOT guaranteed in rv64gc
*
* Branchless min/max without Zicond:
* slt t0, a, b # t0 = (a < b) ? 1 : 0
* neg t0, t0 # t0 = (a < b) ? -1 : 0 (all-ones mask or zero)
* sub t1, a, b # t1 = a - b
* and t1, t1, t0 # t1 = (a-b) if a<b, else 0
* add res, b, t1 # res = b + (a-b if a<b) = min(a,b)
*
* Overflow detection (no flags):
* add res, a, b
* # signed overflow iff same-sign operands produce opposite-sign result
* xor t0, a, b # t0[63]=0 means same sign
* xor t1, a, res # t1[63]=1 means sign changed
* srai t0, t0, 63 # 0 or -1
* srai t1, t1, 63 # 0 or -1
* xori t0, t0, -1 # invert: -1 -> 0, 0 -> -1
* and ovf, t0, t1 # -1 iff overflow
* snez ovf, ovf # 0 or 1
*/
#if USE_ASM_OPT
/* ============================================================================
* OPTIMIZATION 1: Stack Operations
* ============================================================================
*/
static inline void vm_push_asm(VM *vm, cell_t value) {
int error = 0;
__asm__ __volatile__(
"lw t0, %[dsp]\n\t" /* t0 = dsp */
"li t1, 1022\n\t"
"bge t0, t1, 1f\n\t" /* branch if dsp >= 1022 (overflow) */
"addi t0, t0, 1\n\t" /* dsp++ */
"sw t0, %[dsp]\n\t"
"slli t1, t0, 3\n\t" /* t1 = dsp * 8 */
"add t1, %[stack], t1\n\t" /* t1 = &data_stack[dsp] */
"sd %[val], 0(t1)\n\t" /* store value */
"sw zero, %[err]\n\t"
"j 2f\n\t"
"1:\n\t"
"li t0, 1\n\t"
"sw t0, %[err]\n\t"
"2:\n\t"
: [dsp]"+m"(vm->dsp),
[err]"=m"(error)
: [val]"r"(value),
[stack]"r"(vm->data_stack)
: "t0", "t1", "memory"
);
if (__builtin_expect(error, 0)) {
vm->error = 1;
}
}
static inline cell_t vm_pop_asm(VM *vm) {
cell_t value = 0;
int error = 0;
__asm__ __volatile__(
"lw t0, %[dsp]\n\t"
"bltz t0, 1f\n\t" /* branch if dsp < 0 (underflow) */
"slli t1, t0, 3\n\t"
"add t1, %[stack], t1\n\t" /* t1 = &data_stack[dsp] (old dsp) */
"addi t0, t0, -1\n\t"
"sw t0, %[dsp]\n\t" /* write dsp back BEFORE loading the
value: %[dsp] is a memory operand
referenced twice in this template
(read above, write here); loading
%[val] (a register output) before
this write-back let clang's
allocator reuse %[dsp]'s address
register for %[val], corrupting
the write-back — GCC happened to
pick different registers and
never hit it. Loading %[val] last
means %[dsp]'s final use has
already happened by the time the
output register is live. */
"ld %[val], 0(t1)\n\t"
"sw zero, %[err]\n\t"
"j 2f\n\t"
"1:\n\t"
"li t0, 1\n\t"
"sw t0, %[err]\n\t"
"mv %[val], zero\n\t"
"2:\n\t"
: [dsp]"+m"(vm->dsp),
[val]"=r"(value),
[err]"=m"(error)
: [stack]"r"(vm->data_stack)
: "t0", "t1", "memory"
);
if (__builtin_expect(error, 0)) {
vm->error = 1;
}
return value;
}
static inline void vm_rpush_asm(VM *vm, cell_t value) {
int error = 0;
__asm__ __volatile__(
"lw t0, %[rsp]\n\t"
"li t1, 1022\n\t"
"bge t0, t1, 1f\n\t"
"addi t0, t0, 1\n\t"
"sw t0, %[rsp]\n\t"
"slli t1, t0, 3\n\t"
"add t1, %[stack], t1\n\t"
"sd %[val], 0(t1)\n\t"
"sw zero, %[err]\n\t"
"j 2f\n\t"
"1:\n\t"
"li t0, 1\n\t"
"sw t0, %[err]\n\t"
"2:\n\t"
: [rsp]"+m"(vm->rsp),
[err]"=m"(error)
: [val]"r"(value),
[stack]"r"(vm->return_stack)
: "t0", "t1", "memory"
);
if (__builtin_expect(error, 0)) {
vm->error = 1;
}
}
static inline cell_t vm_rpop_asm(VM *vm) {
cell_t value = 0;
int error = 0;
__asm__ __volatile__(
"lw t0, %[rsp]\n\t"
"bltz t0, 1f\n\t"
"slli t1, t0, 3\n\t"
"add t1, %[stack], t1\n\t" /* t1 = &return_stack[rsp] (old rsp) */
"addi t0, t0, -1\n\t"
"sw t0, %[rsp]\n\t" /* write rsp back before loading the
value — see vm_pop_asm for why */
"ld %[val], 0(t1)\n\t"
"sw zero, %[err]\n\t"
"j 2f\n\t"
"1:\n\t"
"li t0, 1\n\t"
"sw t0, %[err]\n\t"
"mv %[val], zero\n\t"
"2:\n\t"
: [rsp]"+m"(vm->rsp),
[val]"=r"(value),
[err]"=m"(error)
: [stack]"r"(vm->return_stack)
: "t0", "t1", "memory"
);
if (__builtin_expect(error, 0)) {
vm->error = 1;
}
return value;
}
/* ============================================================================
* OPTIMIZATION 2: Arithmetic with Overflow Detection
* ============================================================================
*
* RISC-V has no flags register. Overflow is detected by inspecting operand
* and result sign bits directly.
*
* Signed addition overflows iff operands have the same sign and the result
* has the opposite sign:
* ovf = ~(a XOR b)[63] AND (a XOR result)[63]
* ============================================================================
*/
static inline int vm_add_check_overflow(cell_t a, cell_t b, cell_t *result) {
cell_t res;
cell_t ovf;
__asm__(
"add %[res], %[a], %[b]\n\t"
"xor t0, %[a], %[b]\n\t" /* t0[63]=0 if same sign */
"xor t1, %[a], %[res]\n\t" /* t1[63]=1 if sign changed */
"not t0, t0\n\t" /* invert: same-sign -> MSB=1 */
"and t0, t0, t1\n\t" /* both conditions met */
"srli %[ovf], t0, 63\n\t" /* extract MSB as 0 or 1 */
: [res]"=r"(res), [ovf]"=r"(ovf)
: [a]"r"(a), [b]"r"(b)
: "t0", "t1"
);
*result = res;
return (int)ovf;
}
static inline int vm_sub_check_overflow(cell_t a, cell_t b, cell_t *result) {
cell_t res;
cell_t ovf;
__asm__(
"sub %[res], %[a], %[b]\n\t"
/* Signed subtraction a-b overflows iff a and b have different signs
* AND result has different sign from a:
* ovf = (a XOR b)[63] AND (a XOR result)[63] */
"xor t0, %[a], %[b]\n\t" /* t0[63]=1 if different sign */
"xor t1, %[a], %[res]\n\t" /* t1[63]=1 if result sign differs */
"and t0, t0, t1\n\t"
"srli %[ovf], t0, 63\n\t"
: [res]"=r"(res), [ovf]"=r"(ovf)
: [a]"r"(a), [b]"r"(b)
: "t0", "t1"
);
*result = res;
return (int)ovf;
}
/* RV64M: mulh gives the high 64 bits of signed 64×64 product */
static inline void vm_mul_double(cell_t a, cell_t b, cell_t *hi, cell_t *lo) {
__asm__(
"mul %[lo], %[a], %[b]\n\t" /* low 64 bits */
"mulh %[hi], %[a], %[b]\n\t" /* high 64 bits (signed) */
: [lo]"=r"(*lo), [hi]"=r"(*hi)
: [a]"r"(a), [b]"r"(b)
);
}
/* RV64M: div and rem */
static inline void vm_divmod(cell_t dividend, cell_t divisor,
cell_t *quotient, cell_t *remainder) {
cell_t quot, rem;
__asm__(
"div %[quot], %[dividend], %[divisor]\n\t"
"rem %[rem], %[dividend], %[divisor]\n\t"
: [quot]"=r"(quot), [rem]"=r"(rem)
: [dividend]"r"(dividend), [divisor]"r"(divisor)
);
*quotient = quot;
*remainder = rem;
}
/* ============================================================================
* OPTIMIZATION 3: String Operations
* ============================================================================
*
* RISC-V has no string or SIMD instructions in the base ISA (rv64gc).
* We write tight scalar loops in asm to avoid libc call overhead inside
* the inner interpreter hot path.
* ============================================================================
*/
static inline int vm_strcmp_asm(const char *s1, const char *s2, size_t len) {
int result = 0;
__asm__ __volatile__(
"beqz %[len], 2f\n\t"
"1:\n\t"
"lb t0, 0(%[s1])\n\t"
"lb t1, 0(%[s2])\n\t"
"bne t0, t1, 3f\n\t"
"addi %[s1], %[s1], 1\n\t"
"addi %[s2], %[s2], 1\n\t"
"addi %[len], %[len], -1\n\t"
"bnez %[len], 1b\n\t"
"2:\n\t"
"mv %[res], zero\n\t"
"j 4f\n\t"
"3:\n\t"
"li %[res], 1\n\t"
"4:\n\t"
: [res]"=r"(result),
[s1]"+r"(s1), [s2]"+r"(s2), [len]"+r"(len)
:
: "t0", "t1", "memory"
);
return result;
}
static inline void vm_memcpy_asm(void *dest, const void *src, size_t len) {
/* Copy 8 bytes at a time, then handle remainder */
__asm__ __volatile__(
"srli t2, %[len], 3\n\t" /* t2 = len / 8 */
"beqz t2, 2f\n\t"
"1:\n\t"
"ld t0, 0(%[src])\n\t"
"sd t0, 0(%[dst])\n\t"
"addi %[src], %[src], 8\n\t"
"addi %[dst], %[dst], 8\n\t"
"addi t2, t2, -1\n\t"
"bnez t2, 1b\n\t"
"2:\n\t"
"andi %[len], %[len], 7\n\t" /* remaining bytes */
"beqz %[len], 4f\n\t"
"3:\n\t"
"lb t0, 0(%[src])\n\t"
"sb t0, 0(%[dst])\n\t"
"addi %[src], %[src], 1\n\t"
"addi %[dst], %[dst], 1\n\t"
"addi %[len], %[len], -1\n\t"
"bnez %[len], 3b\n\t"
"4:\n\t"
: [src]"+r"(src), [dst]"+r"(dest), [len]"+r"(len)
:
: "t0", "t2", "memory"
);
}
static inline void vm_memzero_asm(void *dest, size_t len) {
__asm__ __volatile__(
"srli t2, %[len], 3\n\t"
"beqz t2, 2f\n\t"
"1:\n\t"
"sd zero, 0(%[dst])\n\t"
"addi %[dst], %[dst], 8\n\t"
"addi t2, t2, -1\n\t"
"bnez t2, 1b\n\t"
"2:\n\t"
"andi %[len], %[len], 7\n\t"
"beqz %[len], 4f\n\t"
"3:\n\t"
"sb zero, 0(%[dst])\n\t"
"addi %[dst], %[dst], 1\n\t"
"addi %[len], %[len], -1\n\t"
"bnez %[len], 3b\n\t"
"4:\n\t"
: [dst]"+r"(dest), [len]"+r"(len)
:
: "t2", "memory"
);
}
/* ============================================================================
* OPTIMIZATION 4: Branchless Min/Max
* ============================================================================
*
* RISC-V base ISA has no conditional move. The bit-mask trick avoids branches:
* mask = -(a < b) → all-ones if a<b, zero otherwise
* min = b + (a-b) & mask
* ============================================================================
*/
static inline cell_t vm_min_asm(cell_t a, cell_t b) {
cell_t result;
__asm__(
"slt t0, %[a], %[b]\n\t" /* t0 = (a < b) ? 1 : 0 */
"neg t0, t0\n\t" /* t0 = mask (-1 or 0) */
"sub t1, %[a], %[b]\n\t"
"and t1, t1, t0\n\t"
"add %[res], %[b], t1\n\t"
: [res]"=r"(result)
: [a]"r"(a), [b]"r"(b)
: "t0", "t1"
);
return result;
}
static inline cell_t vm_max_asm(cell_t a, cell_t b) {
cell_t result;
__asm__(
"slt t0, %[b], %[a]\n\t" /* t0 = (b < a) ? 1 : 0 → (a > b) */
"neg t0, t0\n\t"
"sub t1, %[a], %[b]\n\t"
"and t1, t1, t0\n\t"
"add %[res], %[b], t1\n\t"
: [res]"=r"(result)
: [a]"r"(a), [b]"r"(b)
: "t0", "t1"
);
return result;
}
static inline cell_t vm_abs_asm(cell_t a) {
cell_t result;
__asm__(
"srai t0, %[a], 63\n\t" /* t0 = sign mask (-1 or 0) */
"xor %[res], %[a], t0\n\t" /* flip bits if negative */
"sub %[res], %[res], t0\n\t" /* add 1 if negative (two's complement) */
: [res]"=r"(result)
: [a]"r"(a)
: "t0"
);
return result;
}
/* ============================================================================
* OPTIMIZATION 5: Bit Manipulation
* ============================================================================
*
* rv64gc does NOT include the B extension (Zbb), so clz/ctz/cpop are not
* available as single instructions. GCC builtins map to the best available
* form — if the toolchain targets Zbb they'll lower to single instructions;
* on plain rv64gc they fall back to efficient multi-instruction sequences.
* ============================================================================
*/
static inline int vm_clz(cell_t x) {
return __builtin_clzll((unsigned long long)x);
}
static inline int vm_ctz(cell_t x) {
return __builtin_ctzll((unsigned long long)x);
}
static inline int vm_popcnt(cell_t x) {
return __builtin_popcountll((unsigned long long)x);
}
/* ============================================================================
* OPTIMIZATION 6: Cache Operations
* ============================================================================
*
* RISC-V uses fence.i for instruction cache coherence.
* There is no user-space prefetch instruction in the base ISA;
* we use GCC's __builtin_prefetch which lowers to a hint if the target
* supports one (e.g., Zicbop extension), otherwise it's a no-op.
* ============================================================================
*/
static inline void vm_prefetch(const void *addr) {
__builtin_prefetch(addr, 0, 3);
}
static inline void vm_prefetch_stream(const void *addr) {
__builtin_prefetch(addr, 0, 0);
}
/* ============================================================================
* OPTIMIZATION 7: CPU Feature Detection
* ============================================================================
*
* RISC-V has no CPUID equivalent in user space. Extension detection requires
* either kernel support (/proc/cpuinfo, riscv_hwprobe syscall on Linux 6.4+)
* or compiler defines. We expose a simple interface here.
* ============================================================================
*/
static inline int vm_has_riscv_m_ext(void) {
#if defined(__riscv_mul)
return 1;
#else
return 0;
#endif
}
static inline int vm_has_riscv_b_ext(void) {
#if defined(__riscv_zbb)
return 1;
#else
return 0;
#endif
}
#else /* !USE_ASM_OPT */
#define vm_push_asm(vm, val) vm_push(vm, val)
#define vm_pop_asm(vm) vm_pop(vm)
#define vm_rpush_asm(vm, val) vm_rpush(vm, val)
#define vm_rpop_asm(vm) vm_rpop(vm)
#endif /* USE_ASM_OPT */
#endif /* VM_ASM_OPT_RISCV64_H */
v3/include/vm_debug.h
+71
View File
@@ -0,0 +1,71 @@
/*
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.
*/
/** @cond */
#ifndef VM_DEBUG_H
#define VM_DEBUG_H
/** @endcond */
#include "vm.h"
/**
* @brief Sets the VM instance to dump state for when signals occur
* @param vm Pointer to the VM instance to monitor
* @note Should be called once after vm_init
*/
void vm_debug_set_current_vm(VM * vm);
/**
* @brief Installs signal handlers for SIGSEGV and SIGABRT
* @details The handlers will print VM state before re-raising the signal
*/
void vm_debug_install_signal_handlers(void);
/**
* @brief Manually dumps the state of a VM instance
* @param vm The VM instance to dump state for
* @param reason Description of why the dump was triggered
* @note Typically called before exit(1) on test failure
*/
void vm_debug_dump_state(const VM *vm, const char *reason);
#endif /* VM_DEBUG_H */
v3/include/vm_host.h
+178
View File
@@ -0,0 +1,178 @@
/*
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.
*/
/**
* vm_host.h - Host services abstraction for StarForth VM
*
* Provides pluggable allocator, time, and mutex services.
* Hosted builds use libc; kernel builds use PMM/kmalloc/TSC.
*
* M7 Non-Negotiable: All allocation goes through these hooks.
* No direct malloc/free in VM code.
*/
#ifndef STARKERNEL_VM_HOST_H
#define STARKERNEL_VM_HOST_H
#include <stdint.h>
#include <stddef.h>
#include <stdbool.h>
struct DictEntry;
/**
* Host allocator function signature
* Returns NULL on failure
*/
typedef void* (*sk_alloc_fn)(size_t size, size_t align);
/**
* Host free function signature
*/
typedef void (*sk_free_fn)(void *ptr);
/**
* Host monotonic time function signature
* Returns nanoseconds since arbitrary epoch
* In PARITY_MODE, returns deterministic fake time
*/
typedef uint64_t (*sk_time_fn)(void);
/**
* Host mutex operations (no-op in kernel single-threaded mode)
*/
typedef int (*sk_mutex_init_fn)(void *mutex);
typedef int (*sk_mutex_lock_fn)(void *mutex);
typedef int (*sk_mutex_unlock_fn)(void *mutex);
typedef void (*sk_mutex_destroy_fn)(void *mutex);
/**
* Host console output (for words that print)
* Returns number of bytes written, or -1 on error
*/
typedef int (*sk_puts_fn)(const char *str);
typedef int (*sk_putc_fn)(int c);
/**
* Host execution-token validation
* Returns 1 if pointer is executable, 0 otherwise
*/
typedef bool (*sk_xt_validate_fn)(const void *ptr);
/**
* Host dictionary entry ownership check
*/
typedef bool (*sk_xt_entry_owns_fn)(const void *entry, size_t bytes);
/**
* Host fatal handler (panic)
*/
typedef void (*sk_panic_fn)(const char *message);
/**
* VMHostServices - pluggable host operations
*
* Hosted builds point these at libc functions.
* Kernel builds point these at kernel implementations.
*/
typedef struct VMHostServices {
/* Memory allocation */
sk_alloc_fn alloc;
sk_free_fn free;
/* Monotonic time source */
sk_time_fn monotonic_ns;
/* Mutex operations (can be no-ops) */
sk_mutex_init_fn mutex_init;
sk_mutex_lock_fn mutex_lock;
sk_mutex_unlock_fn mutex_unlock;
sk_mutex_destroy_fn mutex_destroy;
/* Console output */
sk_puts_fn puts;
sk_putc_fn putc;
/* XT validation */
sk_xt_validate_fn is_executable_ptr;
sk_xt_entry_owns_fn owns_xt_entry;
sk_panic_fn panic;
/* Flags */
int parity_mode; /* 1 = deterministic time */
int verbose; /* 1 = enable logging */
} VMHostServices;
/**
* Get the current host services instance.
* Returns hosted or kernel services depending on build.
*/
const VMHostServices* sk_host_services(void);
/**
* Initialize host services for kernel build.
* Must be called before any VM operations.
*/
#ifdef __STARKERNEL__
void sk_host_init(void);
#endif
/**
* Convenience macros for common operations
* Use these instead of direct malloc/free/etc.
*/
#define SK_ALLOC(size) (sk_host_services()->alloc((size), sizeof(void*)))
#define SK_ALLOC_ALIGNED(s, a) (sk_host_services()->alloc((s), (a)))
#define SK_FREE(ptr) (sk_host_services()->free(ptr))
#define SK_TIME_NS() (sk_host_services()->monotonic_ns())
#define SK_PUTS(str) (sk_host_services()->puts(str))
#define SK_PUTC(c) (sk_host_services()->putc(c))
/**
* Mutex wrapper macros
*/
#define SK_MUTEX_INIT(m) (sk_host_services()->mutex_init(m))
#define SK_MUTEX_LOCK(m) (sk_host_services()->mutex_lock(m))
#define SK_MUTEX_UNLOCK(m) (sk_host_services()->mutex_unlock(m))
#define SK_MUTEX_DESTROY(m) (sk_host_services()->mutex_destroy(m))
#endif /* STARKERNEL_VM_HOST_H */
v3/include/vm_inner_interp_arm64.h
+556
View File
@@ -0,0 +1,556 @@
/*
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.
*/
#ifndef VM_INNER_INTERP_ARM64_H
#define VM_INNER_INTERP_ARM64_H
#include "vm.h"
/*
* ARM64 DIRECT-THREADED INNER INTERPRETER
* ========================================
*
* ARM64 advantages over x86_64:
* - More registers (31 vs 16)
* - Better branch prediction
* - Conditional execution
* - Load/store with auto-increment
* - Lower power consumption
*
* Register Allocation (using callee-saved registers):
* - x19: VM pointer (callee-saved)
* - x20: Instruction Pointer (IP)
* - x21: Data Stack Pointer (DSP) - actual pointer
* - x22: Return Stack Pointer (RSP) - actual pointer
* - x23: Top of Stack cache (TOS) - keep in register
* - x24-x28: Available for future use
*
* Why more registers help:
* - Can keep TOS in register (x23)
* - More scratch registers for complex operations
* - Less memory traffic
*
* Performance on Raspberry Pi 4:
* - Expected 3-5x speedup for threaded code
* - Better than x86_64 due to more registers
* - Lower power = less thermal throttling
*/
#ifndef USE_DIRECT_THREADING
#define USE_DIRECT_THREADING 0
#endif
#if USE_DIRECT_THREADING
/*
* NEXT macro - ARM64 version
*
* On ARM64, we can use:
* - Load with post-increment (ldr x0, [x20], #8)
* - Indirect branch (br x0)
*/
#define NEXT_ARM64() \
__asm__ __volatile__ ( \
"ldr x0, [x20], #8\n\t" /* Load word ptr from [IP], IP += 8 */ \
"br x0\n\t" /* Branch to word */ \
::: "x0", "memory" \
)
/*
* DOCOL - Enter a colon definition (ARM64)
*/
static inline void vm_docol_arm64(VM *vm) {
__asm__ __volatile__(
/* Save current IP on return stack */
"str x20, [x22], #8\n\t" /* [RSP] = IP, RSP += 8 */
/* IP = address of colon definition body */
"ldr x0, %[entry]\n\t"
"ldr x20, [x0]\n\t" /* IP = entry->code_field */
/* Continue with NEXT */
"ldr x0, [x20], #8\n\t"
"br x0\n\t"
:
: [entry]"m"(vm->current_executing_entry)
: "x0", "x20", "x22", "memory"
);
}
/*
* EXIT - Return from a colon definition (ARM64)
*/
static inline void vm_exit_arm64(void) {
__asm__ __volatile__(
/* Restore IP from return stack */
"ldr x20, [x22, #-8]!\n\t" /* RSP -= 8, IP = [RSP] (pre-decrement) */
/* Continue with NEXT */
"ldr x0, [x20], #8\n\t"
"br x0\n\t"
::: "x0", "x20", "x22", "memory"
);
}
/*
* Setup registers before entering inner loop
*/
static inline void vm_setup_registers_arm64(VM *vm) {
__asm__ __volatile__(
/* Save callee-saved registers (required by ARM64 ABI) */
"stp x19, x20, [sp, #-80]!\n\t"
"stp x21, x22, [sp, #16]\n\t"
"stp x23, x24, [sp, #32]\n\t"
"stp x25, x26, [sp, #48]\n\t"
"stp x27, x28, [sp, #64]\n\t"
/* Load VM pointer */
"mov x19, %[vm]\n\t" /* x19 = VM pointer */
/* Load IP */
"ldr x20, %[ip]\n\t" /* x20 = IP */
/* Calculate data stack pointer */
"ldr w0, %[dsp]\n\t"
"ldr x1, %[dstack]\n\t"
"add x21, x1, x0, sxtw #3\n\t" /* x21 = &data_stack[dsp] */
/* Calculate return stack pointer */
"ldr w0, %[rsp]\n\t"
"ldr x1, %[rstack]\n\t"
"add x22, x1, x0, sxtw #3\n\t" /* x22 = &return_stack[rsp] */
/* Load TOS into x23 if stack not empty */
"ldr w0, %[dsp]\n\t"
"cmp w0, #0\n\t"
"b.lt 1f\n\t"
"ldr x23, [x21]\n\t" /* x23 = TOS (cached) */
"1:\n\t"
:
: [vm]"r"(vm),
[ip]"m"(vm->ip),
[dsp]"m"(vm->dsp),
[rsp]"m"(vm->rsp),
[dstack]"m"(vm->data_stack),
[rstack]"m"(vm->return_stack)
: "x0", "x1", "x19", "x20", "x21", "x22", "x23", "x24",
"x25", "x26", "x27", "x28", "memory"
);
}
/*
* Save registers back to VM structure
*/
static inline void vm_save_registers_arm64(VM *vm) {
__asm__ __volatile__(
/* Save TOS back to stack */
"str x23, [x21]\n\t"
/* Save IP */
"str x20, %[ip]\n\t"
/* Calculate and save dsp */
"ldr x0, %[dstack]\n\t"
"sub x1, x21, x0\n\t"
"lsr x1, x1, #3\n\t" /* / 8 */
"str w1, %[dsp]\n\t"
/* Calculate and save rsp */
"ldr x0, %[rstack]\n\t"
"sub x1, x22, x0\n\t"
"lsr x1, x1, #3\n\t"
"str w1, %[rsp]\n\t"
/* Restore callee-saved registers */
"ldp x27, x28, [sp, #64]\n\t"
"ldp x25, x26, [sp, #48]\n\t"
"ldp x23, x24, [sp, #32]\n\t"
"ldp x21, x22, [sp, #16]\n\t"
"ldp x19, x20, [sp], #80\n\t"
: [ip]"=m"(vm->ip),
[dsp]"=m"(vm->dsp),
[rsp]"=m"(vm->rsp)
: [dstack]"m"(vm->data_stack),
[rstack]"m"(vm->return_stack)
: "x0", "x1", "memory"
);
}
/**
* @defgroup primitives Fast Primitive Word Implementations
* @brief Register-based stack primitives optimized for ARM64
*
* Key optimization: TOS stays in x23, avoiding memory traffic
* @{
*/
/** @brief DUP primitive - duplicates top of stack item */
#define PRIM_DUP_ARM64() \
__asm__ __volatile__ ( \
"str x23, [x21, #8]!\n\t" /* Store TOS, advance DSP */ \
::: "x21", "memory" \
)
/* DROP - remove top of stack */
#define PRIM_DROP_ARM64() \
__asm__ __volatile__ ( \
"ldr x23, [x21], #-8\n\t" /* Load new TOS, decrement DSP */ \
::: "x21", "x23", "memory" \
)
/* SWAP - swap top two stack items */
#define PRIM_SWAP_ARM64() \
__asm__ __volatile__ ( \
"ldr x0, [x21]\n\t" /* Load NOS */ \
"str x23, [x21]\n\t" /* Store TOS to NOS position */ \
"mov x23, x0\n\t" /* TOS = old NOS */ \
::: "x0", "x23", "memory" \
)
/* OVER - copy second item to top */
#define PRIM_OVER_ARM64() \
__asm__ __volatile__ ( \
"ldr x0, [x21]\n\t" /* Load NOS */ \
"str x23, [x21, #8]!\n\t" /* Store TOS, advance DSP */ \
"mov x23, x0\n\t" /* TOS = NOS */ \
::: "x0", "x21", "x23", "memory" \
)
/* ROT - rotate top three items */
#define PRIM_ROT_ARM64() \
__asm__ __volatile__ ( \
"ldr x0, [x21]\n\t" /* Load item2 */ \
"ldr x1, [x21, #-8]\n\t" /* Load item3 */ \
"str x1, [x21]\n\t" /* item3 -> NOS */ \
"str x23, [x21, #-8]\n\t" /* TOS -> item3 */ \
"mov x23, x0\n\t" /* item2 -> TOS */ \
::: "x0", "x1", "x23", "memory" \
)
/* + - add top two stack items */
#define PRIM_PLUS_ARM64() \
__asm__ __volatile__ ( \
"ldr x0, [x21], #-8\n\t" /* Load NOS, decrement DSP */ \
"add x23, x23, x0\n\t" /* TOS = TOS + NOS */ \
::: "x0", "x21", "x23" \
)
/* - - subtract top from second */
#define PRIM_MINUS_ARM64() \
__asm__ __volatile__ ( \
"ldr x0, [x21], #-8\n\t" /* Load NOS, decrement DSP */ \
"sub x23, x0, x23\n\t" /* TOS = NOS - TOS */ \
::: "x0", "x21", "x23" \
)
/* * - multiply top two stack items */
#define PRIM_STAR_ARM64() \
__asm__ __volatile__ ( \
"ldr x0, [x21], #-8\n\t" /* Load NOS, decrement DSP */ \
"mul x23, x23, x0\n\t" /* TOS = TOS * NOS */ \
::: "x0", "x21", "x23" \
)
/* / - divide second by top */
#define PRIM_SLASH_ARM64() \
__asm__ __volatile__ ( \
"ldr x0, [x21], #-8\n\t" /* Load NOS (dividend), decrement DSP */ \
"sdiv x23, x0, x23\n\t" /* TOS = NOS / TOS */ \
::: "x0", "x21", "x23" \
)
/* MOD - modulo */
#define PRIM_MOD_ARM64() \
__asm__ __volatile__ ( \
"ldr x0, [x21], #-8\n\t" /* Load NOS, decrement DSP */ \
"sdiv x1, x0, x23\n\t" /* quotient = NOS / TOS */ \
"msub x23, x1, x23, x0\n\t" /* TOS = NOS - quotient * TOS */ \
::: "x0", "x1", "x21", "x23" \
)
/* AND - bitwise and */
#define PRIM_AND_ARM64() \
__asm__ __volatile__ ( \
"ldr x0, [x21], #-8\n\t" \
"and x23, x23, x0\n\t" \
::: "x0", "x21", "x23" \
)
/* OR - bitwise or */
#define PRIM_OR_ARM64() \
__asm__ __volatile__ ( \
"ldr x0, [x21], #-8\n\t" \
"orr x23, x23, x0\n\t" \
::: "x0", "x21", "x23" \
)
/* XOR - bitwise xor */
#define PRIM_XOR_ARM64() \
__asm__ __volatile__ ( \
"ldr x0, [x21], #-8\n\t" \
"eor x23, x23, x0\n\t" \
::: "x0", "x21", "x23" \
)
/* INVERT - bitwise not */
#define PRIM_INVERT_ARM64() \
__asm__ __volatile__ ( \
"mvn x23, x23\n\t" \
::: "x23" \
)
/* NEGATE - two's complement */
#define PRIM_NEGATE_ARM64() \
__asm__ __volatile__ ( \
"neg x23, x23\n\t" \
::: "x23" \
)
/* @ - fetch cell from memory */
#define PRIM_FETCH_ARM64() \
__asm__ __volatile__ ( \
"ldr x0, [x19]\n\t" /* Load VM->memory */ \
"ldr x23, [x0, x23]\n\t" /* TOS = memory[TOS] */ \
::: "x0", "x23", "memory" \
)
/* ! - store cell to memory */
#define PRIM_STORE_ARM64() \
__asm__ __volatile__ ( \
"ldr x0, [x21], #-8\n\t" /* Load address, decrement DSP */ \
"ldr x1, [x19]\n\t" /* Load VM->memory */ \
"str x23, [x1, x0]\n\t" /* memory[addr] = value */ \
"ldr x23, [x21]\n\t" /* Load new TOS */ \
::: "x0", "x1", "x21", "x23", "memory" \
)
/* C@ - fetch byte from memory */
#define PRIM_C_FETCH_ARM64() \
__asm__ __volatile__ ( \
"ldr x0, [x19]\n\t" \
"ldrb w23, [x0, x23]\n\t" /* Load byte, zero-extend */ \
::: "x0", "x23", "memory" \
)
/* C! - store byte to memory */
#define PRIM_C_STORE_ARM64() \
__asm__ __volatile__ ( \
"ldr x0, [x21], #-8\n\t" \
"ldr x1, [x19]\n\t" \
"strb w23, [x1, x0]\n\t" /* Store byte */ \
"ldr x23, [x21]\n\t" \
::: "x0", "x1", "x21", "x23", "memory" \
)
/* >R - push to return stack */
#define PRIM_TO_R_ARM64() \
__asm__ __volatile__ ( \
"str x23, [x22], #8\n\t" /* Store to RS, advance RSP */ \
"ldr x23, [x21], #-8\n\t" /* Load new TOS, decrement DSP */ \
::: "x21", "x22", "x23", "memory" \
)
/* R> - pop from return stack */
#define PRIM_R_FROM_ARM64() \
__asm__ __volatile__ ( \
"str x23, [x21, #8]!\n\t" /* Store TOS, advance DSP */ \
"ldr x23, [x22, #-8]!\n\t" /* Load from RS, decrement RSP */ \
::: "x21", "x22", "x23", "memory" \
)
/* R@ - copy top of return stack to data stack */
#define PRIM_R_FETCH_ARM64() \
__asm__ __volatile__ ( \
"str x23, [x21, #8]!\n\t" /* Store TOS, advance DSP */ \
"ldr x23, [x22, #-8]\n\t" /* Load from RS (don't pop) */ \
::: "x21", "x23", "memory" \
)
/* 2DUP - duplicate top two items */
#define PRIM_2DUP_ARM64() \
__asm__ __volatile__ ( \
"ldr x0, [x21]\n\t" /* Load NOS */ \
"stp x0, x23, [x21, #8]\n\t" /* Store pair */ \
"add x21, x21, #16\n\t" /* DSP += 2 */ \
::: "x0", "x21", "memory" \
)
/* 2DROP - drop top two items */
#define PRIM_2DROP_ARM64() \
__asm__ __volatile__ ( \
"ldr x23, [x21, #-8]\n\t" /* Load new TOS */ \
"sub x21, x21, #16\n\t" /* DSP -= 2 */ \
::: "x21", "x23", "memory" \
)
/* 0= - test if zero */
#define PRIM_ZERO_EQUALS_ARM64() \
__asm__ __volatile__ ( \
"cmp x23, #0\n\t" \
"cset x23, eq\n\t" /* Set to 1 if zero, else 0 */ \
"neg x23, x23\n\t" /* Convert to -1 (true flag) */ \
::: "x23", "cc" \
)
/* 0< - test if negative */
#define PRIM_ZERO_LESS_ARM64() \
__asm__ __volatile__ ( \
"cmp x23, #0\n\t" \
"cset x23, lt\n\t" \
"neg x23, x23\n\t" \
::: "x23", "cc" \
)
/* = - test equality */
#define PRIM_EQUALS_ARM64() \
__asm__ __volatile__ ( \
"ldr x0, [x21], #-8\n\t" \
"cmp x0, x23\n\t" \
"cset x23, eq\n\t" \
"neg x23, x23\n\t" \
::: "x0", "x21", "x23", "cc" \
)
/* < - test less than (signed) */
#define PRIM_LESS_ARM64() \
__asm__ __volatile__ ( \
"ldr x0, [x21], #-8\n\t" \
"cmp x0, x23\n\t" \
"cset x23, lt\n\t" \
"neg x23, x23\n\t" \
::: "x0", "x21", "x23", "cc" \
)
/* > - test greater than (signed) */
#define PRIM_GREATER_ARM64() \
__asm__ __volatile__ ( \
"ldr x0, [x21], #-8\n\t" \
"cmp x0, x23\n\t" \
"cset x23, gt\n\t" \
"neg x23, x23\n\t" \
::: "x0", "x21", "x23", "cc" \
)
/*
* Control flow primitives
*/
/* BRANCH - unconditional branch */
#define PRIM_BRANCH_ARM64() \
__asm__ __volatile__ ( \
"ldr x0, [x20]\n\t" /* Load offset */ \
"add x20, x20, x0\n\t" /* IP += offset */ \
::: "x0", "x20", "memory" \
)
/* 0BRANCH - branch if TOS is zero */
#define PRIM_ZBRANCH_ARM64() \
__asm__ __volatile__ ( \
"ldr x0, [x20]\n\t" /* Load offset */ \
"cmp x23, #0\n\t" \
"add x1, x20, x0\n\t" /* Calculate target */ \
"add x2, x20, #8\n\t" /* Calculate skip */ \
"csel x20, x1, x2, eq\n\t" /* Select target if zero */ \
"ldr x23, [x21], #-8\n\t" /* Load new TOS */ \
::: "x0", "x1", "x2", "x20", "x21", "x23", "cc", "memory" \
)
/* EXECUTE - execute word whose xt is on stack */
#define PRIM_EXECUTE_ARM64() \
__asm__ __volatile__ ( \
"ldr x23, [x21], #-8\n\t" /* Load new TOS */ \
"br x0\n\t" /* Branch to xt */ \
::: "x0", "x21", "x23", "memory" \
)
#else /* !USE_DIRECT_THREADING */
/* Fallback definitions */
#define NEXT_ARM64() do {} while(0)
#define vm_setup_registers_arm64(vm) do {} while(0)
#define vm_save_registers_arm64(vm) do {} while(0)
#endif /* USE_DIRECT_THREADING */
/*
* ============================================================================
* RASPBERRY PI 4 PERFORMANCE TUNING
* ============================================================================
*
* Cache Optimization:
* -------------------
* 1. Align VM structure to cache line (64 bytes):
* typedef struct VM { ... } __attribute__((aligned(64))) VM;
*
* 2. Separate hot/cold data:
* - Keep stacks, IP, SP together (hot)
* - Move error handling, I/O to separate structure (cold)
*
* 3. Prefetch dictionary entries:
* vm_prefetch(vm->latest);
* vm_prefetch(vm->latest->link);
*
* Thermal Management:
* -------------------
* 1. Monitor temperature:
* vcgencmd measure_temp
*
* 2. Add heatsink or fan for sustained load
*
* 3. Reduce CPU frequency if needed:
* echo 1200000 > /sys/devices/system/cpu/cpu0/cpufreq/scaling_max_freq
*
* Power Optimization:
* -------------------
* 1. Use WFE (Wait For Event) in idle loops
* 2. Disable unused cores if single-threaded
* 3. Use NEON for parallel operations (lower power than scalar)
*
* Build Configuration:
* --------------------
* Native: -march=armv8-a+crc+simd -mtune=cortex-a72
* Cross: CC=aarch64-linux-gnu-gcc
*
* ============================================================================
*/
#endif /* VM_INNER_INTERP_ARM64_H */
v3/include/vm_inner_interp_asm.h
+643
View File
@@ -0,0 +1,643 @@
/*
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 ***
vm_inner_interp_asm.h - Optimized Inner Interpreter using Direct Threading
Compatible with: Linux, bare metal x86_64
HISTORICAL: the "L4Re Compatibility"/"L4RE INTEGRATION NOTES" throughout
this file describe a target that was supported through mid-2026. L4Re
support has since been removed as an active target; these notes are
retained as historical design rationale.
This work is released under license terms in LICENSE file.
No warranty. Use at your own risk.
*/
#ifndef VM_INNER_INTERP_ASM_H
#define VM_INNER_INTERP_ASM_H
#include "vm.h"
/*
* INNER INTERPRETER OPTIMIZATION
* ===============================
*
* This is the MOST CRITICAL optimization for Forth performance.
*
* Background:
* -----------
* Forth uses "threaded code" where compiled words are sequences of pointers
* to other words. The inner interpreter's job is to:
* 1. Fetch the next word pointer (IP)
* 2. Execute that word
* 3. Increment IP
* 4. Repeat
*
* Traditional C implementation has massive overhead:
* - Function call/return for each word (push/pop return address)
* - Register spilling
* - No tail-call optimization in most C compilers
*
* This optimization uses:
* - Direct threading: Each word ends with a jump to NEXT
* - Register allocation: Keep IP, SP, RP in registers
* - Tail calls: Use jmp instead of call/ret
* - Computed goto: Fast dispatch using indirect jump
*
* Performance Impact:
* ------------------
* Can improve interpreter speed by 2-5x for threaded code execution
*
* L4Re Compatibility: YES
* All operations are unprivileged and pure computation
*/
#ifndef USE_DIRECT_THREADING
#define USE_DIRECT_THREADING 0
#endif
#if USE_DIRECT_THREADING
/**
* @brief Register allocation strategy for optimized execution
*
* Register usage:
* @arg r12 VM pointer (callee-saved, preserved across calls)
* @arg r13 Instruction Pointer (IP) - points to current cell
* @arg r14 Data Stack Pointer (DSP) - points to vm->data_stack[vm->dsp]
* @arg r15 Return Stack Pointer (RSP) - points to vm->return_stack[vm->rsp]
*
* Callee-saved registers are used because:
* - They're preserved across function calls
* - Allows mixing C and assembly code
* - No need to save/restore on each word execution
*/
/**
* @brief Core inner interpreter macro - executes next word
* @details Fetches next word pointer from IP, increments IP, and jumps to word
*/
#define NEXT_ASM() \
__asm__ __volatile__ ( \
"movq (%%r13), %%rax\n\t" /* Load word pointer from [IP] */ \
"addq $8, %%r13\n\t" /* IP++ */ \
"jmpq *%%rax\n\t" /* Jump to word's code */ \
::: "rax", "memory" \
)
/**
* @brief Enter a colon definition (DOCOL)
* @param vm Pointer to VM instance
* @details Called when executing a user-defined word
*/
static inline void vm_docol_asm(VM *vm) {
__asm__ __volatile__(
/* Save current IP on return stack */
"movq %%r13, (%%r15)\n\t" /* *RSP = IP */
"addq $8, %%r15\n\t" /* RSP++ */
/* IP = address of colon definition body (from DictEntry) */
"movq %[entry], %%rax\n\t"
"movq (%%rax), %%r13\n\t" /* IP = entry->code_field */
/* Continue with NEXT */
"movq (%%r13), %%rax\n\t"
"addq $8, %%r13\n\t"
"jmpq *%%rax\n\t"
:
: [entry]"r"(vm->current_executing_entry)
: "rax", "r13", "r15", "memory"
);
}
/**
* @brief Return from a colon definition (EXIT)
* @details Pops IP from return stack and continues execution
*/
static inline void vm_exit_asm(void) {
__asm__ __volatile__(
/* Restore IP from return stack */
"subq $8, %%r15\n\t" /* RSP-- */
"movq (%%r15), %%r13\n\t" /* IP = *RSP */
/* Continue with NEXT */
"movq (%%r13), %%rax\n\t"
"addq $8, %%r13\n\t"
"jmpq *%%rax\n\t"
::: "rax", "r13", "r15", "memory"
);
}
/**
* @brief Main interpreter loop implementation
* @details Replaces execute_colon_word function with optimized assembly
*
* Usage example:
* @code
* vm_setup_registers(vm);
* VM_INNER_LOOP();
* @endcode
*/
/* Setup registers before entering inner loop */
static inline void vm_setup_registers(VM *vm) {
__asm__ __volatile__(
"movq %[vm], %%r12\n\t" /* R12 = VM pointer */
"movq %[ip], %%r13\n\t" /* R13 = IP */
/* Calculate actual stack pointers */
"movl %[dsp], %%eax\n\t"
"leaq (%[dstack], %%rax, 8), %%r14\n\t" /* R14 = &data_stack[dsp] */
"movl %[rsp], %%eax\n\t"
"leaq (%[rstack], %%rax, 8), %%r15\n\t" /* R15 = &return_stack[rsp] */
:
: [vm]"r"(vm),
[ip]"r"(vm->ip),
[dsp]"m"(vm->dsp),
[rsp]"m"(vm->rsp),
[dstack]"r"(vm->data_stack),
[rstack]"r"(vm->return_stack)
: "r12", "r13", "r14", "r15", "rax", "memory"
);
}
/* Save registers back to VM structure */
static inline void vm_save_registers(VM *vm) {
__asm__ __volatile__(
"movq %%r13, %[ip]\n\t" /* Save IP */
/* Calculate dsp from R14 */
"movq %%r14, %%rax\n\t"
"subq %[dstack], %%rax\n\t"
"shrq $3, %%rax\n\t" /* / 8 */
"movl %%eax, %[dsp]\n\t"
/* Calculate rsp from R15 */
"movq %%r15, %%rax\n\t"
"subq %[rstack], %%rax\n\t"
"shrq $3, %%rax\n\t"
"movl %%eax, %[rsp]\n\t"
: [ip]"=m"(vm->ip),
[dsp]"=m"(vm->dsp),
[rsp]"=m"(vm->rsp)
: [dstack]"r"(vm->data_stack),
[rstack]"r"(vm->return_stack)
: "rax", "memory"
);
}
/*
* Fast primitive word implementations using register-based stacks
*
* These use the register-allocated stack pointers (R14/R15) directly
* without going through memory or function calls
*/
/* DUP - duplicate top of stack */
#define PRIM_DUP() \
__asm__ __volatile__ ( \
"movq (%%r14), %%rax\n\t" /* Load TOS */ \
"addq $8, %%r14\n\t" /* DSP++ */ \
"movq %%rax, (%%r14)\n\t" /* Store duplicate */ \
::: "rax", "r14", "memory" \
)
/* DROP - remove top of stack */
#define PRIM_DROP() \
__asm__ __volatile__ ( \
"subq $8, %%r14\n\t" /* DSP-- */ \
::: "r14" \
)
/* SWAP - swap top two stack items */
#define PRIM_SWAP() \
__asm__ __volatile__ ( \
"movq (%%r14), %%rax\n\t" /* Load TOS */ \
"movq -8(%%r14), %%rcx\n\t" /* Load NOS */ \
"movq %%rcx, (%%r14)\n\t" /* Store NOS to TOS */ \
"movq %%rax, -8(%%r14)\n\t" /* Store TOS to NOS */ \
::: "rax", "rcx", "memory" \
)
/* + - add top two stack items */
#define PRIM_PLUS() \
__asm__ __volatile__ ( \
"movq (%%r14), %%rax\n\t" /* Load TOS */ \
"addq %%rax, -8(%%r14)\n\t" /* Add to NOS */ \
"subq $8, %%r14\n\t" /* DSP-- */ \
::: "rax", "r14", "cc", "memory" \
)
/* - - subtract top from second */
#define PRIM_MINUS() \
__asm__ __volatile__ ( \
"movq (%%r14), %%rax\n\t" /* Load TOS */ \
"subq %%rax, -8(%%r14)\n\t" /* Subtract from NOS */ \
"subq $8, %%r14\n\t" /* DSP-- */ \
::: "rax", "r14", "cc", "memory" \
)
/* * - multiply top two stack items */
#define PRIM_STAR() \
__asm__ __volatile__ ( \
"movq (%%r14), %%rax\n\t" /* Load TOS */ \
"imulq -8(%%r14), %%rax\n\t" /* Multiply with NOS */ \
"movq %%rax, -8(%%r14)\n\t" /* Store result */ \
"subq $8, %%r14\n\t" /* DSP-- */ \
::: "rax", "rdx", "r14", "cc", "memory" \
)
/* @ - fetch cell from memory */
#define PRIM_FETCH() \
__asm__ __volatile__ ( \
"movq (%%r14), %%rax\n\t" /* Load address from TOS */ \
"movq (%%r12), %%rcx\n\t" /* Load VM->memory */ \
"movq (%%rcx, %%rax, 1), %%rax\n\t" /* Load cell from memory */ \
"movq %%rax, (%%r14)\n\t" /* Store to TOS */ \
::: "rax", "rcx", "memory" \
)
/* ! - store cell to memory */
#define PRIM_STORE() \
__asm__ __volatile__ ( \
"movq (%%r14), %%rax\n\t" /* Load address from TOS */ \
"movq -8(%%r14), %%rcx\n\t" /* Load value from NOS */ \
"movq (%%r12), %%rdx\n\t" /* Load VM->memory */ \
"movq %%rcx, (%%rdx, %%rax, 1)\n\t" /* Store to memory */ \
"subq $16, %%r14\n\t" /* DSP -= 2 */ \
::: "rax", "rcx", "rdx", "r14", "memory" \
)
/* >R - push to return stack */
#define PRIM_TO_R() \
__asm__ __volatile__ ( \
"movq (%%r14), %%rax\n\t" /* Load from TOS */ \
"subq $8, %%r14\n\t" /* DSP-- */ \
"movq %%rax, (%%r15)\n\t" /* Store to return stack */ \
"addq $8, %%r15\n\t" /* RSP++ */ \
::: "rax", "r14", "r15", "memory" \
)
/* R> - pop from return stack */
#define PRIM_R_FROM() \
__asm__ __volatile__ ( \
"subq $8, %%r15\n\t" /* RSP-- */ \
"movq (%%r15), %%rax\n\t" /* Load from return stack */ \
"addq $8, %%r14\n\t" /* DSP++ */ \
"movq %%rax, (%%r14)\n\t" /* Store to TOS */ \
::: "rax", "r14", "r15", "memory" \
)
/* R@ - copy top of return stack to data stack */
#define PRIM_R_FETCH() \
__asm__ __volatile__ ( \
"movq -8(%%r15), %%rax\n\t" /* Load from top of return stack */ \
"addq $8, %%r14\n\t" /* DSP++ */ \
"movq %%rax, (%%r14)\n\t" /* Store to TOS */ \
::: "rax", "r14", "memory" \
)
/*
* BRANCH and 0BRANCH - Control flow primitives
* These modify IP based on conditions
*/
/* BRANCH - unconditional branch */
#define PRIM_BRANCH() \
__asm__ __volatile__ ( \
"movq (%%r13), %%rax\n\t" /* Load offset from IP */ \
"addq %%rax, %%r13\n\t" /* IP += offset */ \
::: "rax", "r13", "memory" \
)
/* 0BRANCH - branch if TOS is zero */
#define PRIM_ZBRANCH() \
__asm__ __volatile__ ( \
"movq (%%r14), %%rax\n\t" /* Load TOS */ \
"subq $8, %%r14\n\t" /* DSP-- */ \
"testq %%rax, %%rax\n\t" /* Test if zero */ \
"jnz 1f\n\t" /* Skip if non-zero */ \
"movq (%%r13), %%rax\n\t" /* Load offset */ \
"addq %%rax, %%r13\n\t" /* IP += offset */ \
"jmp 2f\n\t" \
"1:\n\t" \
"addq $8, %%r13\n\t" /* Skip offset */ \
"2:\n\t" \
::: "rax", "r13", "r14", "cc", "memory" \
)
/* OVER - copy second item to top of stack */
#define PRIM_OVER() \
__asm__ __volatile__ ( \
"movq -8(%%r14), %%rax\n\t" /* Load NOS */ \
"addq $8, %%r14\n\t" /* DSP++ */ \
"movq %%rax, (%%r14)\n\t" /* Store NOS as new TOS */ \
::: "rax", "r14", "memory" \
)
/* ROT - rotate top three items ( a b c -- b c a ) */
#define PRIM_ROT() \
__asm__ __volatile__ ( \
"movq (%%r14), %%rax\n\t" /* c = TOS */ \
"movq -8(%%r14), %%rcx\n\t" /* b = NOS */ \
"movq -16(%%r14), %%rdx\n\t" /* a = third */ \
"movq %%rdx, -8(%%r14)\n\t" /* a -> NOS */ \
"movq %%rax, -16(%%r14)\n\t" /* c -> third */ \
"movq %%rcx, (%%r14)\n\t" /* b -> TOS */ \
::: "rax", "rcx", "rdx", "memory" \
)
/* / - signed divide second by top */
#define PRIM_SLASH() \
__asm__ __volatile__ ( \
"movq -8(%%r14), %%rax\n\t" /* Load dividend (NOS) */ \
"cqo\n\t" /* Sign-extend rax to rdx:rax */ \
"idivq (%%r14)\n\t" /* Divide by TOS */ \
"movq %%rax, -8(%%r14)\n\t" /* Store quotient to NOS slot */ \
"subq $8, %%r14\n\t" /* DSP-- */ \
::: "rax", "rdx", "r14", "cc", "memory" \
)
/* MOD - signed modulo */
#define PRIM_MOD() \
__asm__ __volatile__ ( \
"movq -8(%%r14), %%rax\n\t" /* Load dividend (NOS) */ \
"cqo\n\t" /* Sign-extend */ \
"idivq (%%r14)\n\t" /* rdx = remainder */ \
"movq %%rdx, -8(%%r14)\n\t" /* Store remainder to NOS slot */ \
"subq $8, %%r14\n\t" /* DSP-- */ \
::: "rax", "rdx", "r14", "cc", "memory" \
)
/* AND - bitwise and */
#define PRIM_AND() \
__asm__ __volatile__ ( \
"movq (%%r14), %%rax\n\t" /* Load TOS */ \
"andq %%rax, -8(%%r14)\n\t" /* NOS &= TOS */ \
"subq $8, %%r14\n\t" /* DSP-- */ \
::: "rax", "r14", "cc", "memory" \
)
/* OR - bitwise or */
#define PRIM_OR() \
__asm__ __volatile__ ( \
"movq (%%r14), %%rax\n\t" /* Load TOS */ \
"orq %%rax, -8(%%r14)\n\t" /* NOS |= TOS */ \
"subq $8, %%r14\n\t" /* DSP-- */ \
::: "rax", "r14", "cc", "memory" \
)
/* XOR - bitwise xor */
#define PRIM_XOR() \
__asm__ __volatile__ ( \
"movq (%%r14), %%rax\n\t" /* Load TOS */ \
"xorq %%rax, -8(%%r14)\n\t" /* NOS ^= TOS */ \
"subq $8, %%r14\n\t" /* DSP-- */ \
::: "rax", "r14", "cc", "memory" \
)
/* INVERT - bitwise complement */
#define PRIM_INVERT() \
__asm__ __volatile__ ( \
"notq (%%r14)\n\t" /* TOS = ~TOS */ \
::: "memory" \
)
/* NEGATE - two's complement negation */
#define PRIM_NEGATE() \
__asm__ __volatile__ ( \
"negq (%%r14)\n\t" /* TOS = -TOS */ \
::: "cc", "memory" \
)
/* C@ - fetch byte from memory */
#define PRIM_C_FETCH() \
__asm__ __volatile__ ( \
"movq (%%r14), %%rax\n\t" /* Load address from TOS */ \
"movq (%%r12), %%rcx\n\t" /* Load VM->memory */ \
"movzbq (%%rcx, %%rax, 1), %%rax\n\t" /* Load byte, zero-extend */ \
"movq %%rax, (%%r14)\n\t" /* Store byte value to TOS */ \
::: "rax", "rcx", "memory" \
)
/* C! - store byte to memory */
#define PRIM_C_STORE() \
__asm__ __volatile__ ( \
"movq (%%r14), %%rax\n\t" /* Load address from TOS */ \
"movq -8(%%r14), %%rcx\n\t" /* Load byte value from NOS */ \
"movq (%%r12), %%rdx\n\t" /* Load VM->memory */ \
"movb %%cl, (%%rdx, %%rax, 1)\n\t" /* Store byte */ \
"subq $16, %%r14\n\t" /* DSP -= 2 */ \
::: "rax", "rcx", "rdx", "r14", "memory" \
)
/* 2DUP - duplicate top two items ( a b -- a b a b ) */
#define PRIM_2DUP() \
__asm__ __volatile__ ( \
"movq -8(%%r14), %%rax\n\t" /* Load NOS (a) */ \
"movq (%%r14), %%rcx\n\t" /* Load TOS (b) */ \
"movq %%rax, 8(%%r14)\n\t" /* Store a above TOS */ \
"movq %%rcx, 16(%%r14)\n\t" /* Store b above that */ \
"addq $16, %%r14\n\t" /* DSP += 2 */ \
::: "rax", "rcx", "r14", "memory" \
)
/* 2DROP - drop top two items */
#define PRIM_2DROP() \
__asm__ __volatile__ ( \
"subq $16, %%r14\n\t" /* DSP -= 2 */ \
::: "r14" \
)
/* 0= - true (-1) if TOS is zero, false (0) otherwise */
#define PRIM_ZERO_EQUALS() \
__asm__ __volatile__ ( \
"movq (%%r14), %%rax\n\t" /* Load TOS */ \
"testq %%rax, %%rax\n\t" /* Test for zero */ \
"sete %%al\n\t" /* AL = 1 if zero */ \
"movzbq %%al, %%rax\n\t" /* Zero-extend */ \
"negq %%rax\n\t" /* -1 if true, 0 if false */ \
"movq %%rax, (%%r14)\n\t" /* Store result */ \
::: "rax", "cc", "memory" \
)
/* 0< - true (-1) if TOS is negative, false (0) otherwise */
#define PRIM_ZERO_LESS() \
__asm__ __volatile__ ( \
"movq (%%r14), %%rax\n\t" /* Load TOS */ \
"sarq $63, %%rax\n\t" /* Arithmetic shift: -1 if negative, 0 otherwise */ \
"movq %%rax, (%%r14)\n\t" /* Store result */ \
::: "rax", "cc", "memory" \
)
/* = - true (-1) if top two items are equal, false (0) otherwise */
#define PRIM_EQUALS() \
__asm__ __volatile__ ( \
"movq (%%r14), %%rax\n\t" /* Load TOS (b) */ \
"cmpq %%rax, -8(%%r14)\n\t" /* Compare NOS (a) with TOS (b) */ \
"sete %%al\n\t" /* AL = 1 if equal */ \
"movzbq %%al, %%rax\n\t" /* Zero-extend */ \
"negq %%rax\n\t" /* -1 if true, 0 if false */ \
"movq %%rax, -8(%%r14)\n\t" /* Store result to NOS slot */ \
"subq $8, %%r14\n\t" /* DSP-- */ \
::: "rax", "r14", "cc", "memory" \
)
/* < - true (-1) if NOS < TOS (signed), false (0) otherwise */
#define PRIM_LESS() \
__asm__ __volatile__ ( \
"movq (%%r14), %%rcx\n\t" /* Load TOS (b) */ \
"movq -8(%%r14), %%rax\n\t" /* Load NOS (a) */ \
"cmpq %%rcx, %%rax\n\t" /* rax - rcx: signed compare a vs b */ \
"setl %%al\n\t" /* AL = 1 if a < b */ \
"movzbq %%al, %%rax\n\t" /* Zero-extend */ \
"negq %%rax\n\t" /* -1 if true, 0 if false */ \
"movq %%rax, -8(%%r14)\n\t" /* Store result to NOS slot */ \
"subq $8, %%r14\n\t" /* DSP-- */ \
::: "rax", "rcx", "r14", "cc", "memory" \
)
/* > - true (-1) if NOS > TOS (signed), false (0) otherwise */
#define PRIM_GREATER() \
__asm__ __volatile__ ( \
"movq (%%r14), %%rcx\n\t" /* Load TOS (b) */ \
"movq -8(%%r14), %%rax\n\t" /* Load NOS (a) */ \
"cmpq %%rcx, %%rax\n\t" /* rax - rcx: signed compare a vs b */ \
"setg %%al\n\t" /* AL = 1 if a > b */ \
"movzbq %%al, %%rax\n\t" /* Zero-extend */ \
"negq %%rax\n\t" /* -1 if true, 0 if false */ \
"movq %%rax, -8(%%r14)\n\t" /* Store result to NOS slot */ \
"subq $8, %%r14\n\t" /* DSP-- */ \
::: "rax", "rcx", "r14", "cc", "memory" \
)
/* EXECUTE - execute word whose execution token is on stack */
#define PRIM_EXECUTE() \
__asm__ __volatile__ ( \
"movq (%%r14), %%rax\n\t" /* Load xt from TOS */ \
"subq $8, %%r14\n\t" /* DSP-- */ \
"jmpq *%%rax\n\t" /* Jump to execution token */ \
::: "rax", "r14", "memory" \
)
#else /* !USE_DIRECT_THREADING */
/* Fallback definitions when direct threading is disabled */
#define NEXT_ASM() do {} while(0)
#define vm_setup_registers(vm) do {} while(0)
#define vm_save_registers(vm) do {} while(0)
#endif /* USE_DIRECT_THREADING */
/*
* ============================================================================
* INTEGRATION GUIDE
* ============================================================================
*
* To integrate these optimizations:
*
* 1. Enable in your build:
* -DUSE_DIRECT_THREADING=1 -DUSE_ASM_OPT=1
*
* 2. Modify your inner interpreter in vm.c:
*
* void execute_threaded_code(VM *vm) {
* vm_setup_registers(vm);
*
* // Execute words...
* // Each primitive word should use PRIM_* macros
* // and end with NEXT_ASM()
*
* vm_save_registers(vm);
* }
*
* 3. For each primitive word, replace function with macro:
*
* Instead of:
* void word_dup(VM *vm) { vm_push(vm, vm->data_stack[vm->dsp]); }
*
* Use:
* PRIM_DUP(); NEXT_ASM();
*
* 4. Benchmark before and after!
*
* ============================================================================
* PERFORMANCE NOTES
* ============================================================================
*
* Expected speedup: 2-5x for threaded code execution
*
* Why so fast?
* - No function call overhead (10+ cycles saved per word)
* - Register allocation eliminates memory traffic
* - Direct jumps instead of call/return (better branch prediction)
* - Cache-friendly: hot path stays in I-cache
*
* Trade-offs:
* - More complex code
* - Harder to debug (use regular C version for debugging)
* - Platform-specific (x86_64 only)
* - Requires more careful register management
*
* ============================================================================
* L4RE INTEGRATION NOTES
* ============================================================================
*
* All safe for L4Re because:
* - No privileged instructions
* - No system calls
* - Preserved ABI (callee-saved registers)
* - Can be used in both user and kernel contexts
*
* For StarshipOS:
* - These optimizations work in L4Re tasks
* - Safe for real-time contexts (deterministic timing)
* - No FPU usage (kernel-safe)
* - Stack usage is minimal
*
* ============================================================================
*/
#endif /* VM_INNER_INTERP_ASM_H */
v3/include/vm_inner_interp_riscv64.h
+539
View File
@@ -0,0 +1,539 @@
/*
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.
*/
#ifndef VM_INNER_INTERP_RISCV64_H
#define VM_INNER_INTERP_RISCV64_H
#include "vm.h"
/*
* RISC-V 64 DIRECT-THREADED INNER INTERPRETER
* ============================================
*
* Register Allocation (callee-saved s2–s6):
* - s2 (x18): VM pointer
* - s3 (x19): Instruction Pointer (IP)
* - s4 (x20): Data Stack Pointer (DSP) — pointer to TOS cell
* - s5 (x21): Return Stack Pointer (RSP) — pointer to top return entry
* - s6 (x22): Top-Of-Stack cache (TOS) — avoids memory round-trip for TOS
*
* Using callee-saved registers means the compiler will save/restore them
* around any C calls made while the inner interpreter is running.
*
* Stack convention (matches x86_64 and ARM64 implementations):
* - Stack grows upward; DSP points to the current TOS cell.
* - TOS is additionally cached in s6 to avoid one load per operation.
* - RSP points to the top return-address cell (not past it).
*
* NEXT macro (direct-threaded dispatch):
* ld a0, 0(s3) # a0 = *IP
* addi s3, s3, 8 # IP += 8
* jr a0 # jump to code field (jalr x0, a0, 0)
*
* Expected performance: 1.5–2.5x vs interpreter loop (fewer branch
* mispredictions, tighter dispatch path). Less than ARM64 TOS-cache gain
* because RISC-V lacks post-increment addressing for combined load+advance.
*/
#ifndef USE_DIRECT_THREADING
#define USE_DIRECT_THREADING 0
#endif
#if USE_DIRECT_THREADING
/*
* NEXT — fetch and dispatch the next word
*
* 'jr a0' is a pseudoinstruction for 'jalr x0, a0, 0' which discards
* the return address (x0 is hardwired zero).
*/
#define NEXT_RV64() \
__asm__ __volatile__ ( \
"ld a0, 0(s3)\n\t" /* a0 = *IP */ \
"addi s3, s3, 8\n\t" /* IP++ */ \
"jr a0\n\t" /* jump to code field */ \
::: "a0", "memory" \
)
/*
* DOCOL — enter a colon definition
*/
static inline void vm_docol_rv64(VM *vm) {
__asm__ __volatile__(
/* Push IP onto return stack */
"addi s5, s5, 8\n\t"
"sd s3, 0(s5)\n\t"
/* Load new IP from current_executing_entry->code_field */
"ld a0, %[entry]\n\t"
"ld s3, 0(a0)\n\t"
/* NEXT */
"ld a0, 0(s3)\n\t"
"addi s3, s3, 8\n\t"
"jr a0\n\t"
:
: [entry]"m"(vm->current_executing_entry)
: "a0", "s3", "s5", "memory"
);
}
/*
* EXIT — return from a colon definition
*/
static inline void vm_exit_rv64(void) {
__asm__ __volatile__(
/* Pop IP from return stack */
"ld s3, 0(s5)\n\t"
"addi s5, s5, -8\n\t"
/* NEXT */
"ld a0, 0(s3)\n\t"
"addi s3, s3, 8\n\t"
"jr a0\n\t"
::: "a0", "s3", "s5", "memory"
);
}
/*
* Setup registers before entering the inner interpreter loop.
* Saves all callee-saved registers we're about to clobber, then
* loads VM state into s2–s6.
*/
static inline void vm_setup_registers_rv64(VM *vm) {
__asm__ __volatile__(
/* Save callee-saved regs we're about to use */
"addi sp, sp, -80\n\t"
"sd s2, 0(sp)\n\t"
"sd s3, 8(sp)\n\t"
"sd s4, 16(sp)\n\t"
"sd s5, 24(sp)\n\t"
"sd s6, 32(sp)\n\t"
"sd s7, 40(sp)\n\t"
"sd s8, 48(sp)\n\t"
"sd s9, 56(sp)\n\t"
"sd s10,64(sp)\n\t"
"sd s11,72(sp)\n\t"
/* s2 = VM pointer */
"mv s2, %[vm]\n\t"
/* s3 = IP */
"ld s3, %[ip]\n\t"
/* s4 = &data_stack[dsp] */
"lw a0, %[dsp]\n\t"
"ld a1, %[dstack]\n\t"
"slli a0, a0, 3\n\t"
"add s4, a1, a0\n\t"
/* s5 = &return_stack[rsp] */
"lw a0, %[rsp]\n\t"
"ld a1, %[rstack]\n\t"
"slli a0, a0, 3\n\t"
"add s5, a1, a0\n\t"
/* s6 = TOS (load if stack non-empty) */
"lw a0, %[dsp]\n\t"
"bltz a0, 1f\n\t"
"ld s6, 0(s4)\n\t"
"1:\n\t"
:
: [vm]"r"(vm),
[ip]"m"(vm->ip),
[dsp]"m"(vm->dsp),
[rsp]"m"(vm->rsp),
[dstack]"m"(vm->data_stack),
[rstack]"m"(vm->return_stack)
: "a0", "a1",
"s2", "s3", "s4", "s5", "s6", "s7", "s8", "s9", "s10", "s11",
"memory"
);
}
/*
* Save registers back to VM structure and restore callee-saved regs.
*/
static inline void vm_save_registers_rv64(VM *vm) {
__asm__ __volatile__(
/* Flush TOS back to stack */
"sd s6, 0(s4)\n\t"
/* Save IP */
"sd s3, %[ip]\n\t"
/* dsp = (s4 - data_stack_base) / 8 */
"ld a0, %[dstack]\n\t"
"sub a1, s4, a0\n\t"
"srli a1, a1, 3\n\t"
"sw a1, %[dsp]\n\t"
/* rsp = (s5 - return_stack_base) / 8 */
"ld a0, %[rstack]\n\t"
"sub a1, s5, a0\n\t"
"srli a1, a1, 3\n\t"
"sw a1, %[rsp]\n\t"
/* Restore callee-saved regs */
"ld s2, 0(sp)\n\t"
"ld s3, 8(sp)\n\t"
"ld s4, 16(sp)\n\t"
"ld s5, 24(sp)\n\t"
"ld s6, 32(sp)\n\t"
"ld s7, 40(sp)\n\t"
"ld s8, 48(sp)\n\t"
"ld s9, 56(sp)\n\t"
"ld s10,64(sp)\n\t"
"ld s11,72(sp)\n\t"
"addi sp, sp, 80\n\t"
: [ip]"=m"(vm->ip),
[dsp]"=m"(vm->dsp),
[rsp]"=m"(vm->rsp)
: [dstack]"m"(vm->data_stack),
[rstack]"m"(vm->return_stack)
: "a0", "a1", "memory"
);
}
/* ============================================================================
* Primitive Word Macros
*
* TOS is cached in s6. s4 = DSP (pointer to TOS cell). s5 = RSP.
* s2 = VM pointer (used for memory-relative ops).
* a0/a1 are scratch (caller-saved, safe to clobber).
* ============================================================================
*/
/* DUP — duplicate TOS */
#define PRIM_DUP_RV64() \
__asm__ __volatile__ ( \
"addi s4, s4, 8\n\t" /* DSP++ */ \
"sd s6, 0(s4)\n\t" /* push TOS copy */ \
::: "s4", "memory" \
)
/* DROP — discard TOS */
#define PRIM_DROP_RV64() \
__asm__ __volatile__ ( \
"ld s6, -8(s4)\n\t" /* new TOS = NOS */ \
"addi s4, s4, -8\n\t" /* DSP-- */ \
::: "s4", "s6", "memory" \
)
/* SWAP — swap TOS and NOS */
#define PRIM_SWAP_RV64() \
__asm__ __volatile__ ( \
"ld a0, 0(s4)\n\t" /* a0 = NOS */ \
"sd s6, 0(s4)\n\t" /* NOS = old TOS */ \
"mv s6, a0\n\t" /* TOS = old NOS */ \
::: "a0", "s6", "memory" \
)
/* OVER — copy NOS to TOS */
#define PRIM_OVER_RV64() \
__asm__ __volatile__ ( \
"ld a0, 0(s4)\n\t" /* a0 = NOS */ \
"addi s4, s4, 8\n\t" /* DSP++ */ \
"sd s6, 0(s4)\n\t" /* push old TOS */ \
"mv s6, a0\n\t" /* TOS = NOS */ \
::: "a0", "s4", "s6", "memory" \
)
/* ROT — rotate top three: ( a b c — b c a ) */
#define PRIM_ROT_RV64() \
__asm__ __volatile__ ( \
"ld a0, 0(s4)\n\t" /* a0 = item2 (NOS) */ \
"ld a1, -8(s4)\n\t" /* a1 = item3 */ \
"sd a1, 0(s4)\n\t" /* item3 -> NOS position */ \
"sd s6, -8(s4)\n\t" /* TOS -> item3 position */ \
"mv s6, a0\n\t" /* item2 -> TOS */ \
::: "a0", "a1", "s6", "memory" \
)
/* + */
#define PRIM_PLUS_RV64() \
__asm__ __volatile__ ( \
"ld a0, 0(s4)\n\t" \
"addi s4, s4, -8\n\t" \
"add s6, s6, a0\n\t" \
::: "a0", "s4", "s6" \
)
/* - */
#define PRIM_MINUS_RV64() \
__asm__ __volatile__ ( \
"ld a0, 0(s4)\n\t" /* a0 = NOS */ \
"addi s4, s4, -8\n\t" \
"sub s6, a0, s6\n\t" /* TOS = NOS - TOS */ \
::: "a0", "s4", "s6" \
)
/* * */
#define PRIM_STAR_RV64() \
__asm__ __volatile__ ( \
"ld a0, 0(s4)\n\t" \
"addi s4, s4, -8\n\t" \
"mul s6, s6, a0\n\t" \
::: "a0", "s4", "s6" \
)
/* / — signed divide NOS/TOS */
#define PRIM_SLASH_RV64() \
__asm__ __volatile__ ( \
"ld a0, 0(s4)\n\t" /* a0 = NOS (dividend) */ \
"addi s4, s4, -8\n\t" \
"div s6, a0, s6\n\t" /* TOS = NOS / TOS */ \
::: "a0", "s4", "s6" \
)
/* MOD */
#define PRIM_MOD_RV64() \
__asm__ __volatile__ ( \
"ld a0, 0(s4)\n\t" \
"addi s4, s4, -8\n\t" \
"rem s6, a0, s6\n\t" \
::: "a0", "s4", "s6" \
)
/* AND */
#define PRIM_AND_RV64() \
__asm__ __volatile__ ( \
"ld a0, 0(s4)\n\t" \
"addi s4, s4, -8\n\t" \
"and s6, s6, a0\n\t" \
::: "a0", "s4", "s6" \
)
/* OR */
#define PRIM_OR_RV64() \
__asm__ __volatile__ ( \
"ld a0, 0(s4)\n\t" \
"addi s4, s4, -8\n\t" \
"or s6, s6, a0\n\t" \
::: "a0", "s4", "s6" \
)
/* XOR */
#define PRIM_XOR_RV64() \
__asm__ __volatile__ ( \
"ld a0, 0(s4)\n\t" \
"addi s4, s4, -8\n\t" \
"xor s6, s6, a0\n\t" \
::: "a0", "s4", "s6" \
)
/* INVERT — bitwise NOT */
#define PRIM_INVERT_RV64() \
__asm__ __volatile__ ( \
"not s6, s6\n\t" \
::: "s6" \
)
/* NEGATE — two's complement */
#define PRIM_NEGATE_RV64() \
__asm__ __volatile__ ( \
"neg s6, s6\n\t" \
::: "s6" \
)
/* @ — fetch cell from VM memory */
#define PRIM_FETCH_RV64() \
__asm__ __volatile__ ( \
"ld a0, 0(s2)\n\t" /* a0 = vm->memory */ \
"add a0, a0, s6\n\t" /* a0 = &memory[TOS] */ \
"ld s6, 0(a0)\n\t" /* TOS = memory[TOS] */ \
::: "a0", "s6", "memory" \
)
/* ! — store cell to VM memory */
#define PRIM_STORE_RV64() \
__asm__ __volatile__ ( \
"ld a0, 0(s4)\n\t" /* a0 = addr (NOS) */ \
"addi s4, s4, -8\n\t" \
"ld a1, 0(s2)\n\t" /* a1 = vm->memory */ \
"add a1, a1, a0\n\t" \
"sd s6, 0(a1)\n\t" /* memory[addr] = TOS */ \
"ld s6, 0(s4)\n\t" /* load new TOS */ \
"addi s4, s4, -8\n\t" \
::: "a0", "a1", "s4", "s6", "memory" \
)
/* C@ — fetch byte */
#define PRIM_C_FETCH_RV64() \
__asm__ __volatile__ ( \
"ld a0, 0(s2)\n\t" \
"add a0, a0, s6\n\t" \
"lbu s6, 0(a0)\n\t" /* zero-extend byte */ \
::: "a0", "s6", "memory" \
)
/* C! — store byte */
#define PRIM_C_STORE_RV64() \
__asm__ __volatile__ ( \
"ld a0, 0(s4)\n\t" /* a0 = addr */ \
"addi s4, s4, -8\n\t" \
"ld a1, 0(s2)\n\t" \
"add a1, a1, a0\n\t" \
"sb s6, 0(a1)\n\t" \
"ld s6, 0(s4)\n\t" \
"addi s4, s4, -8\n\t" \
::: "a0", "a1", "s4", "s6", "memory" \
)
/* >R — push TOS to return stack */
#define PRIM_TO_R_RV64() \
__asm__ __volatile__ ( \
"addi s5, s5, 8\n\t" \
"sd s6, 0(s5)\n\t" /* RS[top] = TOS */ \
"ld s6, 0(s4)\n\t" /* new TOS = NOS */ \
"addi s4, s4, -8\n\t" \
::: "s4", "s5", "s6", "memory" \
)
/* R> — pop return stack to data stack */
#define PRIM_R_FROM_RV64() \
__asm__ __volatile__ ( \
"addi s4, s4, 8\n\t" \
"sd s6, 0(s4)\n\t" /* push old TOS */ \
"ld s6, 0(s5)\n\t" /* TOS = RS top */ \
"addi s5, s5, -8\n\t" \
::: "s4", "s5", "s6", "memory" \
)
/* R@ — copy top of return stack (no pop) */
#define PRIM_R_FETCH_RV64() \
__asm__ __volatile__ ( \
"addi s4, s4, 8\n\t" \
"sd s6, 0(s4)\n\t" \
"ld s6, 0(s5)\n\t" /* TOS = RS top (no pop) */ \
::: "s4", "s6", "memory" \
)
/* 2DUP — duplicate top two */
#define PRIM_2DUP_RV64() \
__asm__ __volatile__ ( \
"ld a0, 0(s4)\n\t" /* a0 = NOS */ \
"addi s4, s4, 8\n\t" \
"sd a0, 0(s4)\n\t" /* push NOS */ \
"addi s4, s4, 8\n\t" \
"sd s6, 0(s4)\n\t" /* push TOS copy */ \
::: "a0", "s4", "memory" \
)
/* 2DROP — drop top two */
#define PRIM_2DROP_RV64() \
__asm__ __volatile__ ( \
"ld s6, -8(s4)\n\t" /* new TOS = item3 */ \
"addi s4, s4, -16\n\t" \
::: "s4", "s6", "memory" \
)
/* 0= */
#define PRIM_ZERO_EQUALS_RV64() \
__asm__ __volatile__ ( \
"seqz s6, s6\n\t" /* 1 if zero, else 0 */ \
"neg s6, s6\n\t" /* convert to -1 (true) */ \
::: "s6" \
)
/* 0< */
#define PRIM_ZERO_LESS_RV64() \
__asm__ __volatile__ ( \
"srai s6, s6, 63\n\t" /* -1 if negative, 0 if >= 0 */ \
::: "s6" \
)
/* = */
#define PRIM_EQUALS_RV64() \
__asm__ __volatile__ ( \
"ld a0, 0(s4)\n\t" \
"addi s4, s4, -8\n\t" \
"sub s6, a0, s6\n\t" \
"seqz s6, s6\n\t" \
"neg s6, s6\n\t" \
::: "a0", "s4", "s6" \
)
/* < — NOS < TOS */
#define PRIM_LESS_RV64() \
__asm__ __volatile__ ( \
"ld a0, 0(s4)\n\t" /* a0 = NOS */ \
"addi s4, s4, -8\n\t" \
"slt s6, a0, s6\n\t" /* 1 if NOS < TOS */ \
"neg s6, s6\n\t" \
::: "a0", "s4", "s6" \
)
/* > — NOS > TOS */
#define PRIM_GREATER_RV64() \
__asm__ __volatile__ ( \
"ld a0, 0(s4)\n\t" \
"addi s4, s4, -8\n\t" \
"slt s6, s6, a0\n\t" /* 1 if TOS < NOS, i.e. NOS > TOS */ \
"neg s6, s6\n\t" \
::: "a0", "s4", "s6" \
)
/* BRANCH — unconditional */
#define PRIM_BRANCH_RV64() \
__asm__ __volatile__ ( \
"ld a0, 0(s3)\n\t" /* offset */ \
"add s3, s3, a0\n\t" /* IP += offset */ \
::: "a0", "s3", "memory" \
)
/* 0BRANCH — branch if TOS == 0 */
#define PRIM_ZBRANCH_RV64() \
__asm__ __volatile__ ( \
"ld a0, 0(s3)\n\t" /* offset */ \
"ld s6, 0(s4)\n\t" /* new TOS */ \
"addi s4, s4, -8\n\t" \
/* if old TOS was zero: IP += offset; else IP += 8 */ \
"bnez s6, 1f\n\t" /* skip branch if nonzero */ \
"add s3, s3, a0\n\t" \
"j 2f\n\t" \
"1:\n\t" \
"addi s3, s3, 8\n\t" \
"2:\n\t" \
::: "a0", "s3", "s4", "s6", "memory" \
)
/* EXECUTE — execute word whose xt is TOS */
#define PRIM_EXECUTE_RV64() \
__asm__ __volatile__ ( \
"mv a0, s6\n\t" /* a0 = xt */ \
"ld s6, 0(s4)\n\t" /* new TOS */ \
"addi s4, s4, -8\n\t" \
"jr a0\n\t" /* jump to xt */ \
::: "a0", "s4", "s6", "memory" \
)
#else /* !USE_DIRECT_THREADING */
#define NEXT_RV64() do {} while(0)
#define vm_setup_registers_rv64(vm) do {} while(0)
#define vm_save_registers_rv64(vm) do {} while(0)
#endif /* USE_DIRECT_THREADING */
#endif /* VM_INNER_INTERP_RISCV64_H */
v3/include/word_registry.h
+62
View File
@@ -0,0 +1,62 @@
/*
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.
*/
#ifndef WORD_REGISTRY_H
#define WORD_REGISTRY_H
#include "vm.h"
/**
* @brief Registers a single FORTH word in the virtual machine
* @param vm Pointer to the virtual machine instance
* @param name Name of the FORTH word to register
* @param func Function pointer to the word's implementation
*/
void register_word(VM *vm, const char *name, word_func_t func);
/*
* @brief Registers all standard FORTH-79 words in the virtual machine
* @param vm Pointer to the virtual machine instance
*/
void register_forth79_words(VM * vm);
#endif /* WORD_REGISTRY_H */
v3/src/README.md
+58
View File
@@ -0,0 +1,58 @@
# src/
Hosted StarForth VM implementation (compiled by the root `Makefile`).
Bare-metal kernel sources live in `src/starkernel/`; FORTH word
implementations in `src/word_source/`; the test harness in
`src/test_runner/`; platform shims in `src/platform/`.
**Entry point / interpreter core**
- `main.c` — CLI entry point, VM init, DoE mode dispatch.
- `vm.c` — interpreter loop, stacks, dictionary state (the central
runtime file).
- `vm_api.c` — external VM API implementation.
- `vm_bootstrap.c` — VM bootstrap initialization.
- `vm_debug.c` — debugging utilities.
- `vm_time.c` — time-related VM operations.
- `vm_internal.h` — internal-only declarations shared across the `vm_*.c`
files, not part of the public `include/vm_api.h` surface.
- `repl.c` — REPL read-eval-print loop.
- `cli.c` — CLI argument parsing.
- `io.c` — I/O operations.
- `log.c` — logging infrastructure.
**Memory / dictionary / blocks**
- `memory_management.c` — dictionary allocator.
- `dictionary_management.c` — dictionary allocation and search.
- `dictionary_heat_optimization.c` — Loop #1 execution-heat tracking.
- `word_registry.c` — word registration system.
- `block_subsystem.c` — logical→physical block mapper.
- `blkio_file.c`, `blkio_ram.c`, `blkio_factory.c` — block I/O backends
(file-backed, RAM-backed) and the factory that selects between them.
- `stack_management.c` — stack operations.
**Physics-driven adaptive runtime (7 feedback loops)**
- `physics_runtime.c` — main physics coordinator.
- `physics_hotwords_cache.c` — Loop #1 hot-words caching.
- `physics_metadata.c` — per-word metadata tracking.
- `physics_pipelining_metrics.c` — Loop #4 word-transition prediction.
- `physics_execution_hooks.c` — execution instrumentation.
- `rolling_window_of_truth.c` — Loop #2 circular execution-history buffer.
- `inference_engine.c` — Loops #5/#6, statistical inference (window-width,
decay-slope).
- `ssm_jacquard.c` — L8 Jacquard steady-state mode selector; consumes
`compudynamics.c` for tuning-word/config lookups.
- `compudynamics.c` — generic compudynamics module (`cd_tuning_word()`,
`cd_tuning_vm()`); the score/UCB/reward/weight constants for the L8
adaptive table live here, not in `ssm_jacquard.c`.
- `heartbeat_export.c` — heartbeat metrics export (CSV export function
itself not yet implemented — see `docs/working/architecture/heartbeat_csv_export.md`).
**Math / measurement**
- `math_portable.c` — portable math functions.
- `profiler.c` — performance profiling.
- `doe_metrics.c` — Design of Experiments metrics (2^7 factorial).
Any `.bak` file alongside a `.c` file here (`doe_metrics.c.bak`,
`inference_engine.c.bak`, `vm.c.bak`) is a pre-edit backup left by a past
maintenance script (see `scripts/remove_loop_conditionals.sh`), not a
build input.
v3/src/blkio_factory.c
+170
View File
@@ -0,0 +1,170 @@
/*
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 I/O Factory (Implementation)
// -----------------------------------------------------------------------------
#include <stdint.h>
#include <stddef.h>
#include <string.h>
#include "blkio.h"
#include "blkio_factory.h"
/* Backends */
extern size_t blkio_file_state_size(void);
extern const blkio_vtable_t *blkio_file_vtable(void);
extern int blkio_file_init_state(void *state_mem, size_t state_len,
const char *path,
uint32_t total_blocks,
uint32_t fbs,
uint8_t read_only,
uint8_t create_if_missing,
uint8_t truncate_to_size,
void **out_opaque);
extern size_t blkio_ram_state_size(void);
extern const blkio_vtable_t *blkio_ram_vtable(void);
extern int blkio_ram_init_state(void *state_mem, size_t state_len,
uint8_t *base, uint32_t total_blocks,
uint32_t fbs, uint8_t read_only,
void **out_opaque);
/** @brief Return 1 if string @c s is non-NULL and non-empty. */
static int nonempty(const char *s) { return (s && *s); }
/**
* @brief Open a block I/O device using the best available backend.
*
* Selects the file backend when @c disk_img_path is non-empty, otherwise
* falls back to the RAM backend using @c ram_base / @c ram_blocks.
*
* File backend behaviour:
* - Creates the file if it does not exist (unless @c read_only is set).
* - Derives @c total_blocks from the file size when @c total_blocks == 0.
* - Sets @c *out_used_file = 1 on success.
*
* RAM backend behaviour:
* - @c ram_base must point to at least @c ram_blocks * @c fbs bytes of
* caller-owned memory that outlives the device.
*
* @param dev Output device handle to populate
* @param disk_img_path Path to disk image file, or NULL/empty for RAM
* @param read_only 1 = open read-only, 0 = read-write
* @param total_blocks Desired block count (0 = derive from file size)
* @param fbs FORTH block size in bytes (0 = use @c BLKIO_FORTH_BLOCK_SIZE)
* @param state_mem Caller-allocated state buffer (must be large enough)
* @param state_len Size of @c state_mem in bytes
* @param ram_base Base of RAM block array (used only when no disk path)
* @param ram_blocks Number of blocks in @c ram_base
* @param out_used_file Optional output: set to 1 if the file backend was used
* @return @c BLKIO_OK on success, or a @c BLKIO_E* error code
*/
int blkio_factory_open(blkio_dev_t *dev,
const char *disk_img_path,
uint8_t read_only,
uint32_t total_blocks,
uint32_t fbs,
void *state_mem,
size_t state_len,
uint8_t *ram_base,
uint32_t ram_blocks,
uint8_t *out_used_file) {
if (out_used_file) *out_used_file = 0;
if (!dev || !state_mem || state_len == 0) return BLKIO_EINVAL;
const uint32_t efbs = (fbs ? fbs : BLKIO_FORTH_BLOCK_SIZE);
if (nonempty(disk_img_path)) {
const size_t need = blkio_file_state_size();
if (state_len < need) return BLKIO_ENOSPACE;
void *opaque = NULL;
const uint8_t create_if_missing = read_only ? 0u : 1u;
const uint8_t truncate_to_size = (!read_only && total_blocks > 0) ? 1u : 0u;
int rc = blkio_file_init_state(state_mem, state_len,
disk_img_path,
total_blocks,
efbs,
read_only,
create_if_missing,
truncate_to_size,
&opaque);
if (rc != BLKIO_OK) return rc;
blkio_params_t p = {
.forth_block_size = efbs,
.total_blocks = total_blocks, /* 0 => derive in file_open */
.opaque = opaque
};
rc = blkio_open(dev, blkio_file_vtable(), &p);
if (rc == BLKIO_OK && out_used_file) *out_used_file = 1u;
return rc;
}
if (!ram_base || ram_blocks == 0) return BLKIO_EINVAL;
const size_t need_ram = blkio_ram_state_size();
if (state_len < need_ram) return BLKIO_ENOSPACE;
void *opaque = NULL;
int rc = blkio_ram_init_state(state_mem, state_len,
ram_base, ram_blocks,
efbs, read_only,
&opaque);
if (rc != BLKIO_OK) return rc;
const blkio_params_t p = {
.forth_block_size = efbs,
.total_blocks = ram_blocks,
.opaque = opaque
};
return blkio_open(dev, blkio_ram_vtable(), &p);
}
v3/src/blkio_file.c
+400
View File
@@ -0,0 +1,400 @@
/*
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 - File-backed Block I/O backend (portable)
// - Uses lseek()+read()/write() shims (no pread/pwrite requirement).
// - Deterministic full-block I/O; rejects short I/O.
// - Single-process/serialized access expected for correctness.
// -----------------------------------------------------------------------------
#include "blkio.h"
#include <unistd.h> // read, write, lseek, close
#include <fcntl.h> // open flags
#include <sys/stat.h> // fstat
#include <sys/types.h> // off_t
#include <errno.h>
#include <string.h> // memset
#include <stdint.h>
#ifndef PATH_MAX
#define PATH_MAX 4096
#endif
typedef struct {
int fd;
char path[PATH_MAX];
uint32_t total_blocks;
uint32_t fbs;
uint8_t read_only;
} blkio_file_state_t;
/**
* @brief Return the byte size required for a @c blkio_file_state_t.
*
* Used by @c blkio_factory_open() to verify the caller's state buffer is
* large enough before calling @c blkio_file_init_state().
*
* @return sizeof(blkio_file_state_t)
*/
size_t blkio_file_state_size(void) { return sizeof(blkio_file_state_t); }
/**
* @brief Initialise a @c blkio_file_state_t in caller-provided memory.
*
* Copies the path into state (truncated to PATH_MAX-1), sets @c fbs,
* @c total_blocks, and @c read_only, and writes the state pointer to
* @c *out_opaque. The file descriptor is initialised to -1; the actual
* @c open() call happens in @c file_open() (the vtable open method).
* @c create_if_missing and @c truncate_to_size are accepted for API
* compatibility but currently unused (creation is handled in @c file_open()).
*
* @param state_mem Caller-allocated state buffer
* @param state_len Size of @c state_mem (must be >= blkio_file_state_size())
* @param path Path to the disk image file
* @param total_blocks Total block count (0 = derive from file size at open)
* @param fbs FORTH block size in bytes
* @param read_only 1 = open read-only, 0 = read-write
* @param create_if_missing Ignored (reserved for future use)
* @param truncate_to_size Ignored (reserved for future use)
* @param out_opaque Output: set to @c state_mem on success
* @return @c BLKIO_OK on success, @c BLKIO_EINVAL on bad arguments
*/
int blkio_file_init_state(void *state_mem, size_t state_len,
const char *path,
uint32_t total_blocks,
uint32_t fbs,
uint8_t read_only,
uint8_t create_if_missing,
uint8_t truncate_to_size,
void **out_opaque) {
(void) create_if_missing;
(void) truncate_to_size;
if (!state_mem || state_len < sizeof(blkio_file_state_t) || !path || !out_opaque)
return BLKIO_EINVAL;
blkio_file_state_t *st = (blkio_file_state_t *) state_mem;
memset(st, 0, sizeof(*st));
st->fd = -1;
size_t n = 0;
while (path[n] && n < (PATH_MAX - 1)) {
st->path[n] = path[n];
n++;
}
st->path[n] = '\0';
if (st->path[0] == '\0') return BLKIO_EINVAL;
st->fbs = (fbs ? fbs : BLKIO_FORTH_BLOCK_SIZE);
st->total_blocks = total_blocks; // may be 0 (derive later)
st->read_only = read_only ? 1u : 0u;
*out_opaque = (void *) st;
return BLKIO_OK;
}
/**
* @brief Perform a complete read of @c len bytes at absolute offset @c off_abs.
*
* Uses @c lseek() + @c read() loops to handle short reads and EINTR.
* Not safe for concurrent readers/writers on the same file descriptor.
* Returns -1 on any I/O error or unexpected EOF.
*
* @param fd Open file descriptor
* @param buf Destination buffer (must be >= @c len bytes)
* @param len Number of bytes to read
* @param off_abs Absolute byte offset within the file
* @return 0 on success, -1 on error (errno set)
*/
static int full_read_at(int fd, void *buf, size_t len, off_t off_abs) {
uint8_t *p = (uint8_t *) buf;
size_t done = 0;
while (done < len) {
if (lseek(fd, off_abs + (off_t) done, SEEK_SET) == (off_t) - 1) return -1;
ssize_t r = read(fd, p + done, len - done);
if (r < 0) {
if (errno == EINTR) continue;
return -1;
}
if (r == 0) {
errno = EIO;
return -1;
} /* unexpected EOF */
done += (size_t) r;
}
return 0;
}
/**
* @brief Perform a complete write of @c len bytes at absolute offset @c off_abs.
*
* Uses @c lseek() + @c write() loops to handle short writes and EINTR.
* Not safe for concurrent readers/writers on the same file descriptor.
* Returns -1 on any I/O error.
*
* @param fd Open file descriptor
* @param buf Source buffer (must be >= @c len bytes)
* @param len Number of bytes to write
* @param off_abs Absolute byte offset within the file
* @return 0 on success, -1 on error (errno set)
*/
static int full_write_at(int fd, const void *buf, size_t len, off_t off_abs) {
const uint8_t *p = (const uint8_t *) buf;
size_t done = 0;
while (done < len) {
if (lseek(fd, off_abs + (off_t) done, SEEK_SET) == (off_t) - 1) return -1;
ssize_t w = write(fd, p + done, len - done);
if (w < 0) {
if (errno == EINTR) continue;
return -1;
}
if (w == 0) {
errno = EIO;
return -1;
} /* should not happen */
done += (size_t) w;
}
return 0;
}
/** @brief Open the file and attach it to the device handle. */
static int file_open(blkio_dev_t *dev, const blkio_params_t *p);
/** @brief Close the file descriptor held by the device. */
static int file_close(blkio_dev_t * dev);
/** @brief Read one FORTH block from the file into @c dst. */
static int file_read(blkio_dev_t *dev, uint32_t fblock, void *dst);
/** @brief Write one FORTH block from @c src into the file. */
static int file_write(blkio_dev_t *dev, uint32_t fblock, const void *src);
/** @brief Flush (fsync) pending writes to the file. */
static int file_flush(blkio_dev_t * dev);
/** @brief Return device info (block size, count, physical size, read-only flag). */
static int file_info(blkio_dev_t * dev, blkio_info_t * out);
static const blkio_vtable_t BLKIO_FILE_VT = {
.open = file_open,
.close = file_close,
.read = file_read,
.write = file_write,
.flush = file_flush,
.info = file_info
};
/**
* @brief Return the vtable for the file-backed block I/O backend.
* @return Pointer to the static @c blkio_vtable_t for file devices
*/
const blkio_vtable_t *blkio_file_vtable(void) { return &BLKIO_FILE_VT; }
/**
* @brief Open the underlying file and populate the device handle.
*
* Opens @c st->path with @c O_RDONLY or @c O_RDWR|O_CREAT depending on
* @c st->read_only. Derives @c total_blocks from the file size if the state
* value is 0 — the file size must then be a multiple of @c fbs. Sets
* @c dev->state, @c dev->forth_block_size, and @c dev->total_blocks on success.
*
* @param dev Uninitialised device handle
* @param p Parameters including the pre-initialised opaque state pointer
* @return @c BLKIO_OK on success, @c BLKIO_EIO or @c BLKIO_EINVAL on failure
*/
static int file_open(blkio_dev_t *dev, const blkio_params_t *p) {
if (!dev || !p || !p->opaque) return BLKIO_EINVAL;
blkio_file_state_t *st = (blkio_file_state_t *) p->opaque;
if (st->fd != -1) {
close(st->fd);
st->fd = -1;
}
int oflags = st->read_only ? O_RDONLY : O_RDWR;
if (!st->read_only) oflags |= O_CREAT;
#ifdef O_CLOEXEC
oflags |= O_CLOEXEC;
#endif
const int fd = open(st->path, oflags, 0644);
if (fd < 0) return BLKIO_EIO;
st->fd = fd;
struct stat sb;
if (fstat(fd, &sb) < 0) {
close(fd);
st->fd = -1;
return BLKIO_EIO;
}
/* If caller didn’t specify blocks, derive from file size (must be multiple of fbs). */
if (st->total_blocks == 0) {
if (st->fbs == 0) {
close(fd);
st->fd = -1;
return BLKIO_EINVAL;
}
if ((uint64_t) sb.st_size % (uint64_t) st->fbs != 0) {
close(fd);
st->fd = -1;
return BLKIO_EINVAL;
}
uint64_t blocks = (uint64_t) sb.st_size / (uint64_t) st->fbs;
if (blocks == 0 || blocks > 0xffffffffULL) {
close(fd);
st->fd = -1;
return BLKIO_EINVAL;
}
st->total_blocks = (uint32_t) blocks;
}
dev->state = st;
dev->forth_block_size = st->fbs;
dev->total_blocks = st->total_blocks;
return BLKIO_OK;
}
/**
* @brief Close the file descriptor held by the device.
*
* @param dev Device handle (must have valid state)
* @return @c BLKIO_OK on success, @c BLKIO_EIO if @c close() fails
*/
static int file_close(blkio_dev_t *dev) {
if (!dev || !dev->state) return BLKIO_EINVAL;
blkio_file_state_t *st = (blkio_file_state_t *) dev->state;
if (st->fd >= 0) {
int rc = close(st->fd);
st->fd = -1;
return (rc == 0) ? BLKIO_OK : BLKIO_EIO;
}
return BLKIO_OK;
}
/**
* @brief Read one FORTH block from the file backend.
*
* @param dev Open file device
* @param fblock Logical block number (must be < @c dev->total_blocks)
* @param dst Destination buffer (must be >= @c fbs bytes)
* @return @c BLKIO_OK, @c BLKIO_EINVAL if @c fblock is out of range, or @c BLKIO_EIO
*/
static int file_read(blkio_dev_t *dev, uint32_t fblock, void *dst) {
if (!dev || !dst) return BLKIO_EINVAL;
if (fblock >= dev->total_blocks) return BLKIO_EINVAL;
blkio_file_state_t *st = (blkio_file_state_t *) dev->state;
if (st->fd < 0) return BLKIO_ECLOSED;
const off_t off = (off_t)((uint64_t) fblock * (uint64_t) st->fbs);
if (full_read_at(st->fd, dst, st->fbs, off) < 0) return BLKIO_EIO;
return BLKIO_OK;
}
/**
* @brief Write one FORTH block to the file backend.
*
* @param dev Open file device (must not be read-only)
* @param fblock Logical block number (must be < @c dev->total_blocks)
* @param src Source buffer (must be >= @c fbs bytes)
* @return @c BLKIO_OK, @c BLKIO_ENOSUP if read-only, @c BLKIO_EINVAL if out of range,
* or @c BLKIO_EIO on write failure
*/
static int file_write(blkio_dev_t *dev, uint32_t fblock, const void *src) {
if (!dev || !src) return BLKIO_EINVAL;
if (fblock >= dev->total_blocks) return BLKIO_EINVAL;
blkio_file_state_t *st = (blkio_file_state_t *) dev->state;
if (st->fd < 0) return BLKIO_ECLOSED;
if (st->read_only) return BLKIO_ENOSUP;
const off_t off = (off_t)((uint64_t) fblock * (uint64_t) st->fbs);
if (full_write_at(st->fd, src, st->fbs, off) < 0) return BLKIO_EIO;
return BLKIO_OK;
}
/**
* @brief Flush pending writes via @c fsync() on Linux/POSIX; no-op elsewhere.
*
* @param dev Open file device
* @return @c BLKIO_OK on success, @c BLKIO_EIO if @c fsync() fails
*/
static int file_flush(blkio_dev_t *dev) {
if (!dev) return BLKIO_EINVAL;
blkio_file_state_t *st = (blkio_file_state_t *) dev->state;
#if defined(__linux__) || defined(__APPLE__) || defined(__unix__)
if (st->fd < 0) return BLKIO_ECLOSED;
if (fsync(st->fd) < 0) return BLKIO_EIO;
return BLKIO_OK;
#else
(void) st;
return BLKIO_OK;
#endif
}
/**
* @brief Return device info for the file backend.
*
* Physical sector size is reported as 512 (best-effort guess; no ioctl used).
* Physical size in bytes comes from @c fstat().
*
* @param dev Open file device
* @param out Output struct to populate
* @return @c BLKIO_OK on success, @c BLKIO_EIO if @c fstat() fails
*/
static int file_info(blkio_dev_t *dev, blkio_info_t *out) {
if (!dev || !out) return BLKIO_EINVAL;
blkio_file_state_t *st = (blkio_file_state_t *) dev->state;
struct stat sb;
if (fstat(st->fd, &sb) < 0) return BLKIO_EIO;
out->forth_block_size = st->fbs;
out->total_blocks = st->total_blocks;
out->phys_sector_size = 512; // best-effort guess
out->phys_size_bytes = (uint64_t) sb.st_size;
out->read_only = st->read_only;
return BLKIO_OK;
}
v3/src/blkio_ram.c
+237
View File
@@ -0,0 +1,237 @@
/*
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 - RAM Block I/O backend
// -----------------------------------------------------------------------------
#include "blkio.h"
#include <string.h>
typedef struct {
uint8_t *base;
uint32_t total_blocks;
uint32_t fbs;
uint8_t read_only;
} blkio_ram_state_t;
/**
* @brief Return the byte size required for a @c blkio_ram_state_t.
* @return sizeof(blkio_ram_state_t)
*/
size_t blkio_ram_state_size(void) { return sizeof(blkio_ram_state_t); }
/**
* @brief Initialise a @c blkio_ram_state_t in caller-provided memory.
*
* Stores @c base, @c total_blocks, @c fbs (defaulting to
* @c BLKIO_FORTH_BLOCK_SIZE if zero), and @c read_only into the state struct
* at @c state_mem. Sets @c *out_opaque to point to the state. The caller
* owns the @c base memory and must ensure it remains valid for the device lifetime.
*
* @param state_mem Caller-allocated buffer (must be >= blkio_ram_state_size())
* @param state_len Size of @c state_mem in bytes
* @param base Pointer to the RAM block array
* @param total_blocks Number of FORTH blocks in @c base
* @param fbs FORTH block size in bytes (0 = use default)
* @param read_only 1 = deny writes, 0 = allow reads and writes
* @param out_opaque Output: set to @c state_mem on success
* @return @c BLKIO_OK on success, @c BLKIO_EINVAL on bad arguments
*/
int blkio_ram_init_state(void *state_mem, size_t state_len,
uint8_t *base, uint32_t total_blocks,
uint32_t fbs, uint8_t read_only,
void **out_opaque) {
if (!state_mem || state_len < sizeof(blkio_ram_state_t) || !base || !out_opaque)
return BLKIO_EINVAL;
blkio_ram_state_t *st = (blkio_ram_state_t *) state_mem;
st->base = base;
st->total_blocks = total_blocks;
st->fbs = (fbs ? fbs : BLKIO_FORTH_BLOCK_SIZE);
st->read_only = read_only ? 1u : 0u;
*out_opaque = (void *) st;
return BLKIO_OK;
}
/** @brief Attach state to the device handle and validate parameters. */
static int ram_open(blkio_dev_t *dev, const blkio_params_t *p);
/** @brief Close the RAM device (no-op; caller owns the memory). */
static int ram_close(blkio_dev_t * dev);
/** @brief Read one FORTH block from the RAM array into @c dst. */
static int ram_read(blkio_dev_t *dev, uint32_t fblock, void *dst);
/** @brief Write one FORTH block from @c src into the RAM array. */
static int ram_write(blkio_dev_t *dev, uint32_t fblock, const void *src);
/** @brief Flush the RAM device — always a no-op since data is in memory. */
static int ram_flush(blkio_dev_t * dev);
/** @brief Return device info (block size, count, physical size, read-only flag). */
static int ram_info(blkio_dev_t * dev, blkio_info_t * out);
static const blkio_vtable_t BLKIO_RAM_VT = {
.open = ram_open,
.close = ram_close,
.read = ram_read,
.write = ram_write,
.flush = ram_flush,
.info = ram_info
};
/**
* @brief Return the vtable for the RAM block I/O backend.
* @return Pointer to the static @c blkio_vtable_t for RAM devices
*/
const blkio_vtable_t *blkio_ram_vtable(void) { return &BLKIO_RAM_VT; }
/**
* @brief Test whether @c fb is a valid block number for the RAM device.
* @param st RAM state (may be NULL)
* @param fb Block number to test
* @return 1 if in bounds, 0 otherwise
*/
static inline int in_bounds(const blkio_ram_state_t *st, uint32_t fb) {
return st && (fb < st->total_blocks);
}
/**
* @brief Attach the RAM state to the device handle.
*
* Validates that @c base and @c fbs are non-zero, then sets
* @c dev->state, @c dev->forth_block_size, and @c dev->total_blocks.
*
* @param dev Uninitialised device handle
* @param p Parameters with pre-initialised opaque RAM state pointer
* @return @c BLKIO_OK on success, @c BLKIO_EINVAL on bad arguments
*/
static int ram_open(blkio_dev_t *dev, const blkio_params_t *p) {
if (!dev || !p || !p->opaque) return BLKIO_EINVAL;
blkio_ram_state_t *st = (blkio_ram_state_t *) p->opaque;
if (!st->base || st->fbs == 0) return BLKIO_EINVAL;
dev->state = st;
dev->forth_block_size = st->fbs;
dev->total_blocks = st->total_blocks;
return BLKIO_OK;
}
/**
* @brief Close the RAM device — caller retains ownership of the RAM buffer.
*
* @param dev Device handle
* @return @c BLKIO_OK always (no resources to release)
*/
static int ram_close(blkio_dev_t *dev) {
if (!dev || !dev->state) return BLKIO_EINVAL;
return BLKIO_OK; /* caller owns memory */
}
/**
* @brief Copy one FORTH block from the RAM array to @c dst.
*
* @param dev Open RAM device
* @param fblock Logical block number (must be < @c total_blocks)
* @param dst Destination buffer (must be >= @c fbs bytes)
* @return @c BLKIO_OK on success, @c BLKIO_EINVAL if out of range or NULL pointer
*/
static int ram_read(blkio_dev_t *dev, uint32_t fblock, void *dst) {
if (!dev || !dst) return BLKIO_EINVAL;
blkio_ram_state_t *st = (blkio_ram_state_t *) dev->state;
if (!in_bounds(st, fblock)) return BLKIO_EINVAL;
const uint8_t *src = st->base + ((size_t) fblock * st->fbs);
memcpy(dst, src, st->fbs);
return BLKIO_OK;
}
/**
* @brief Copy one FORTH block from @c src into the RAM array.
*
* @param dev Open RAM device (must not be read-only)
* @param fblock Logical block number (must be < @c total_blocks)
* @param src Source buffer (must be >= @c fbs bytes)
* @return @c BLKIO_OK on success, @c BLKIO_ENOSUP if read-only,
* @c BLKIO_EINVAL if out of range or NULL pointer
*/
static int ram_write(blkio_dev_t *dev, uint32_t fblock, const void *src) {
if (!dev || !src) return BLKIO_EINVAL;
blkio_ram_state_t *st = (blkio_ram_state_t *) dev->state;
if (st->read_only) return BLKIO_ENOSUP;
if (!in_bounds(st, fblock)) return BLKIO_EINVAL;
uint8_t *dst = st->base + ((size_t) fblock * st->fbs);
memcpy(dst, src, st->fbs);
return BLKIO_OK;
}
/**
* @brief Flush the RAM device — no-op since data is always in memory.
*
* @param dev Device handle (unused)
* @return @c BLKIO_OK always
*/
static int ram_flush(blkio_dev_t *dev) {
(void) dev;
return BLKIO_OK;
}
/**
* @brief Return device info for the RAM backend.
*
* Physical sector size equals @c fbs (RAM has no physical sector constraint).
* Physical size in bytes = @c fbs * @c total_blocks.
*
* @param dev Open RAM device
* @param out Output struct to populate
* @return @c BLKIO_OK on success, @c BLKIO_EINVAL if @c dev or @c out is NULL
*/
static int ram_info(blkio_dev_t *dev, blkio_info_t *out) {
if (!dev || !out) return BLKIO_EINVAL;
blkio_ram_state_t *st = (blkio_ram_state_t *) dev->state;
out->forth_block_size = st->fbs;
out->total_blocks = st->total_blocks;
out->phys_sector_size = st->fbs;
out->phys_size_bytes = (uint64_t) st->fbs * (uint64_t) st->total_blocks;
out->read_only = st->read_only;
return BLKIO_OK;
}
v3/src/block_subsystem.c
+1699
View File
File diff suppressed because it is too large Load Diff
v3/src/cli.c
+238
View File
@@ -0,0 +1,238 @@
/*
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.
*/
#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#include "cli.h"
#include "version.h"
/* Parse helper for --ram-disk */
static int parse_u32(const char* s, uint32_t* out)
{
if (!s || !*s) return -1;
uint64_t v = 0;
for (const char* p = s; *p; ++p)
{
if (*p < '0' || *p > '9') return -1;
v = v * 10u + (uint32_t)(*p - '0');
if (v > 0xffffffffULL) return -1;
}
*out = (uint32_t)v;
return 0;
}
/**
* @brief Print usage/help information
*/
void cli_print_usage(const char* program_name)
{
printf("Usage: %s [OPTIONS]\n", program_name);
printf("StarForth - A lightweight Forth virtual machine\n\n");
printf("Options:\n");
printf(" -s Script/silent mode - suppress prompts and 'ok' output (for piped input)\n");
printf(" --break-me 🔥 ULTRA-COMPREHENSIVE diagnostic mode - tests EVERYTHING\n");
printf(" --benchmark [N] Run performance benchmarks (default: 1000 iterations)\n");
printf(" --log-error Set logging level to ERROR (only errors)\n");
printf(" --log-warn Set logging level to WARN (warnings and errors)\n");
printf(" --log-info Set logging level to INFO (default)\n");
printf(" --log-test Set logging level to TEST (test results_run_01_2025_12_08 only)\n");
printf(" --log-debug Set logging level to DEBUG (all messages)\n");
printf(" --log-none Disable all logging (maximum performance)\n");
printf(" --fail-fast Stop test suite immediately on first failure\n");
printf(" --doe Run DoE experiment: output CSV metrics to stdout and exit\n");
printf(" --heartbeat-log=<mode> Heartbeat logging mode (off|summary|full)\n");
printf(" off: No heartbeat output (default)\n");
printf(" summary: Bucket aggregates in main CSV\n");
printf(" full: Per-tick CSV to hb/run-<id>.csv\n");
printf(" --disk-img=<path> Use raw disk image file at <path>\n");
printf(" --ram-disk=<MB> RAM fallback size if no --disk-img (default: 1 MB)\n");
printf(" --version, -v Show version information and exit\n");
printf(" --help, -h Show this help message\n\n");
printf("Examples:\n");
printf(" %s # Start REPL with INFO logging\n", program_name);
printf(" %s -s < script.forth # Run script from stdin (no prompts)\n", program_name);
printf(" %s --benchmark # Run benchmarks with 1000 iterations\n", program_name);
printf(" %s --disk-img=./disks/starship.img # Use disk image\n", program_name);
}
/**
* @brief Parse command-line arguments into CLIConfig
*/
CLIConfig cli_parse(int argc, char* argv[])
{
CLIConfig config = {
/* Test modes - all default to 0 */
.run_tests = 0,
.break_me = 0,
.fail_fast = 0,
.run_tests_flag_observed = 0,
/* Benchmark */
.benchmark = 0,
.benchmark_iterations = 1000,
/* Design of Experiments */
.doe_experiment = 0,
.heartbeat_log_mode = HEARTBEAT_LOG_OFF,
/* REPL mode */
.script_mode = 0,
/* Logging */
.log_level = LOG_INFO,
.log_level_explicitly_set = 0,
/* Block I/O */
.disk_img_path = NULL,
.ram_disk_mb = 1,
};
for (int i = 1; i < argc; i++)
{
if (strcmp(argv[i], "--run-tests") == 0)
{
config.run_tests_flag_observed = 1;
}
else if (strcmp(argv[i], "--break-me") == 0)
{
config.break_me = 1;
}
else if (strcmp(argv[i], "--benchmark") == 0)
{
config.benchmark = 1;
if (i + 1 < argc && atoi(argv[i + 1]) > 0)
{
config.benchmark_iterations = atoi(argv[i + 1]);
i++;
}
}
else if (strcmp(argv[i], "--log-error") == 0)
{
config.log_level = LOG_ERROR;
config.log_level_explicitly_set = 1;
}
else if (strcmp(argv[i], "--log-warn") == 0)
{
config.log_level = LOG_WARN;
config.log_level_explicitly_set = 1;
}
else if (strcmp(argv[i], "--log-info") == 0)
{
config.log_level = LOG_INFO;
config.log_level_explicitly_set = 1;
}
else if (strcmp(argv[i], "--log-test") == 0)
{
config.log_level = LOG_TEST;
config.log_level_explicitly_set = 1;
}
else if (strcmp(argv[i], "--log-debug") == 0)
{
config.log_level = LOG_DEBUG;
config.log_level_explicitly_set = 1;
}
else if (strcmp(argv[i], "--log-none") == 0)
{
config.log_level = LOG_NONE;
config.log_level_explicitly_set = 1;
}
else if (strcmp(argv[i], "--fail-fast") == 0)
{
config.fail_fast = 1;
}
else if (strcmp(argv[i], "--doe-experiment") == 0 || strcmp(argv[i], "--doe") == 0)
{
config.doe_experiment = 1;
}
else if (strncmp(argv[i], "--heartbeat-log=", 16) == 0)
{
const char* mode_str = argv[i] + 16;
if (strcmp(mode_str, "off") == 0) {
config.heartbeat_log_mode = HEARTBEAT_LOG_OFF;
} else if (strcmp(mode_str, "summary") == 0) {
config.heartbeat_log_mode = HEARTBEAT_LOG_SUMMARY;
} else if (strcmp(mode_str, "full") == 0) {
config.heartbeat_log_mode = HEARTBEAT_LOG_FULL;
} else {
fprintf(stderr, "Invalid --heartbeat-log value: %s (expected off|summary|full)\n", mode_str);
exit(1);
}
}
else if (strcmp(argv[i], "-s") == 0)
{
config.script_mode = 1;
}
else if (strncmp(argv[i], "--disk-img=", 11) == 0)
{
config.disk_img_path = argv[i] + 11;
}
else if (strncmp(argv[i], "--ram-disk=", 11) == 0)
{
uint32_t tmp = 0;
if (parse_u32(argv[i] + 11, &tmp) != 0 || tmp == 0)
{
fprintf(stderr, "Invalid --ram-disk value: %s (positive MB expected)\n", argv[i] + 11);
exit(1);
}
config.ram_disk_mb = tmp;
}
else if (strcmp(argv[i], "--version") == 0 || strcmp(argv[i], "-v") == 0)
{
printf("%s\n", STARFORTH_VERSION_FULL);
exit(0);
}
else if (strcmp(argv[i], "--help") == 0 || strcmp(argv[i], "-h") == 0)
{
cli_print_usage(argv[0]);
exit(0);
}
else
{
printf("Unknown option: %s\n", argv[i]);
cli_print_usage(argv[0]);
exit(1);
}
}
return config;
}
v3/src/compudynamics.c
+382
View File
@@ -0,0 +1,382 @@
/*
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.
*/
#include "compudynamics.h"
#include <string.h>
#include <stdlib.h>
/* ============================================================================
* Per-Level Tuning Accessors
* ============================================================================
*
* Returned by value, not exposed as addressable globals -- see the
* "Tuning knobs are returned by value" comment in compudynamics.h for why.
*/
/* Matches the constants ssm_jacquard.c/.h used before this module existed
* (SSM_SCORE_MAX, SSM_SCORE_DECAY_FACTOR_Q16, SSM_UCB_K, SSM_REWARD_GAIN,
* SSM_JOINT_WEIGHT_Q16, SSM_ANOVA_WEIGHT_Q16, SSM_ENTROPY/CV/TEMPORAL_DECAY
* thresholds) -- a lift, not a retune. id_window_depth=32 and
* locality_lookback=8 are new: they size the entity-ID history the
* deterministic locality signal replaces temporal_decay with. */
CDTuning cd_tuning_word(void)
{
CDTuning t;
/* classifier */
t.id_window_depth = 32u;
t.locality_lookback = 8u;
t.diversity_high_threshold_q16 = 49152u; /* 0.75 * 65536 */
t.volatility_high_threshold_q16 = 9830u; /* 0.15 * 65536 */
t.locality_high_threshold_q16 = 32768u; /* 0.5 * 65536 */
/* bandit */
t.num_configs = 128u; /* 7-bit L1-L7 */
t.num_regimes = 8u; /* 3-bit diversity/volatility/locality */
t.score_max = 65535u;
t.score_min = 0u;
t.score_decay_factor_q16 = 64881u; /* 0.99 * 65536 */
t.ucb_k = 6554u; /* 10% of score_max */
t.reward_gain = 16384u; /* 25% of score_max */
t.joint_weight_q16 = 49152u; /* 0.75 */
t.anova_weight_q16 = 16384u; /* 0.25 */
return t;
}
/* VM level: classifier-side parameters only, matching capsule_vm_physics.c's
* existing VM_FLEET_WINDOW_DEPTH so a future migration has a ready-made
* starting point. Bandit fields are zero and unused -- see compudynamics.h. */
CDTuning cd_tuning_vm(void)
{
CDTuning t;
/* classifier */
t.id_window_depth = 64u; /* matches VM_FLEET_WINDOW_DEPTH */
t.locality_lookback = 16u;
t.diversity_high_threshold_q16 = 49152u;
t.volatility_high_threshold_q16 = 9830u;
t.locality_high_threshold_q16 = 32768u;
/* bandit -- unused at VM level today */
t.num_configs = 0u;
t.num_regimes = 0u;
t.score_max = 0u;
t.score_min = 0u;
t.score_decay_factor_q16 = 0u;
t.ucb_k = 0u;
t.reward_gain = 0u;
t.joint_weight_q16 = 0u;
t.anova_weight_q16 = 0u;
return t;
}
/* ============================================================================
* Integer Helpers (isqrt, ln approximation)
* ============================================================================
*/
static uint32_t cd_isqrt32(uint32_t n)
{
uint32_t x, y;
if (n == 0u) return 0u;
x = n;
y = (x + 1u) / 2u;
while (y < x) {
x = y;
y = (x + n / x) / 2u;
}
return x;
}
static uint64_t cd_isqrt64(uint64_t n)
{
uint64_t x, y;
if (n == 0u) return 0u;
x = n;
y = (x + 1u) / 2u;
while (y < x) {
x = y;
y = (x + n / x) / 2u;
}
return x;
}
/* floor(log2(n)) * ln(2) * 65536, integer shifts only. See ssm_jacquard.c's
* former ln_approx_q16 -- identical algorithm, moved here so the generic
* bandit doesn't depend on ssm_jacquard.c. */
static uint32_t cd_ln_approx_q16(uint32_t n)
{
uint32_t bits, tmp;
if (n <= 1u) return 0u;
bits = 0u;
tmp = n >> 1u;
while (tmp > 0u) { tmp >>= 1u; bits++; }
return bits * 45426u;
}
/* ============================================================================
* Deterministic Regime Classification
* ============================================================================
*/
CDRegimeMetrics cd_classify_ids(const uint32_t *ids, uint32_t count,
uint32_t locality_lookback)
{
CDRegimeMetrics m;
uint32_t n, i, j, distinct, lookback;
uint8_t counted[CD_MAX_CLASSIFY_DEPTH];
uint32_t per_id_count[CD_MAX_CLASSIFY_DEPTH];
m.diversity_q16 = 0u;
m.volatility_q16 = 0u;
m.locality_q16 = 0u;
if (!ids || count == 0u) return m;
n = (count > CD_MAX_CLASSIFY_DEPTH) ? CD_MAX_CLASSIFY_DEPTH : count;
memset(counted, 0, n * sizeof(counted[0]));
/* --- Diversity: distinct IDs / n, and per-ID touch counts for the
* volatility pass below (single O(n^2) sweep, n <= 64) --- */
distinct = 0u;
for (i = 0u; i < n; i++) {
uint32_t c;
if (counted[i]) continue;
c = 1u;
counted[i] = 1u;
for (j = i + 1u; j < n; j++) {
if (ids[j] == ids[i]) { c++; counted[j] = 1u; }
}
per_id_count[distinct] = c;
distinct++;
}
m.diversity_q16 = (uint32_t)(((uint64_t)distinct * 65536u) / n);
/* --- Volatility: coefficient of variation of per-ID touch counts,
* computed in Q8 to avoid overflow, result in Q16 --- */
if (distinct > 0u) {
uint32_t mean_q8 = (n << 8u) / distinct;
uint64_t sum_var_q16 = 0u;
uint64_t stddev_q8, cv_q16;
for (i = 0u; i < distinct; i++) {
int64_t diff_q8 = (int64_t)(per_id_count[i] << 8u) - (int64_t)mean_q8;
uint64_t diff2_q16 = (uint64_t)(diff_q8 * diff_q8);
sum_var_q16 += diff2_q16;
}
stddev_q8 = cd_isqrt64(sum_var_q16 / distinct);
cv_q16 = (mean_q8 > 0u) ? ((stddev_q8 * 65536u) / mean_q8) : 0u;
m.volatility_q16 = (cv_q16 > 0xFFFFFFFFu) ? 0xFFFFFFFFu : (uint32_t)cv_q16;
}
/* --- Locality: fraction of touches (from lookback..n-1) that repeat
* an ID seen within the preceding lookback touches --- */
lookback = (locality_lookback > n) ? n : locality_lookback;
if (n > lookback && lookback > 0u) {
uint32_t matches = 0u;
uint32_t denom = n - lookback;
for (i = lookback; i < n; i++) {
for (j = i - lookback; j < i; j++) {
if (ids[j] == ids[i]) { matches++; break; }
}
}
m.locality_q16 = (uint32_t)(((uint64_t)matches * 65536u) / denom);
}
return m;
}
/* ============================================================================
* Generic UCB1 Config-Space Bandit
* ============================================================================
*/
int cd_config_table_init(CDConfigTable *table, const CDTuning *tuning)
{
if (!table || !tuning) return -1;
memset(table, 0, sizeof(*table));
if (tuning->num_configs == 0u || tuning->num_regimes == 0u) return -1;
table->entries = (CDConfigEntry *)malloc(tuning->num_configs * sizeof(CDConfigEntry));
table->regime_scores = (uint32_t *)malloc(
(size_t)tuning->num_regimes * tuning->num_configs * sizeof(uint32_t));
table->regime_ticks = (uint32_t *)malloc(
(size_t)tuning->num_regimes * tuning->num_configs * sizeof(uint32_t));
table->total_regime_ticks = (uint32_t *)malloc(tuning->num_regimes * sizeof(uint32_t));
if (!table->entries || !table->regime_scores || !table->regime_ticks ||
!table->total_regime_ticks) {
cd_config_table_free(table);
return -1;
}
table->num_configs = tuning->num_configs;
table->num_regimes = tuning->num_regimes;
return 0;
}
void cd_config_table_free(CDConfigTable *table)
{
if (!table) return;
free(table->entries);
free(table->regime_scores);
free(table->regime_ticks);
free(table->total_regime_ticks);
memset(table, 0, sizeof(*table));
}
void cd_config_table_seed(CDConfigTable *table, const CDTuning *tuning,
const uint32_t *initial_scores, uint8_t initial_config)
{
uint32_t c, r;
if (!table || !table->entries || !tuning || !initial_scores) return;
for (c = 0u; c < table->num_configs; c++) {
CDConfigEntry *e = &table->entries[c];
e->config_bits = (uint8_t)c;
e->has_prev = 0u;
e->_pad[0] = 0u;
e->_pad[1] = 0u;
e->benefit_score = initial_scores[c];
e->tick_count = 0u;
e->prev_window = 0u;
e->prev_locality_q16 = 0u;
for (r = 0u; r < table->num_regimes; r++) {
table->regime_scores[r * table->num_configs + c] = initial_scores[c];
table->regime_ticks[r * table->num_configs + c] = 0u;
}
}
table->current_config = initial_config;
table->current_regime = 0u;
for (r = 0u; r < table->num_regimes; r++) {
table->total_regime_ticks[r] = 0u;
}
(void)tuning;
}
uint8_t cd_config_table_tick(CDConfigTable *table, const CDTuning *tuning,
uint8_t regime, uint32_t anova_stability_q16,
int use_joint_convergence,
uint32_t current_window, uint32_t current_locality_q16)
{
uint32_t r, c;
CDConfigEntry *entry;
uint32_t combined_stability;
uint32_t *score_cell;
uint32_t old_score, decayed, new_score;
int64_t delta_score, new_s;
uint32_t total, ln_total, best_c, best_ucb, ci;
if (!table || !table->entries || !tuning) return 0u;
table->current_regime = regime;
r = (uint32_t)regime;
c = (uint32_t)table->current_config;
entry = &table->entries[c];
if (use_joint_convergence && entry->has_prev) {
uint32_t dw_raw = (current_window > entry->prev_window)
? (current_window - entry->prev_window)
: (entry->prev_window - current_window);
uint32_t dl_raw = (current_locality_q16 > entry->prev_locality_q16)
? (current_locality_q16 - entry->prev_locality_q16)
: (entry->prev_locality_q16 - current_locality_q16);
uint64_t dw_q16 = (entry->prev_window > 0u)
? (((uint64_t)dw_raw * 65536u) / entry->prev_window)
: 0u;
uint64_t dl_q16 = dl_raw; /* already Q16, bounded to [0,65536] */
uint64_t sum_sq, joint_err;
uint32_t stability;
if (dw_q16 > 65536u) dw_q16 = 65536u;
if (dl_q16 > 65536u) dl_q16 = 65536u;
/* joint_error = sqrt(dw^2 + dl^2) / sqrt(2), normalised to [0,65536] */
sum_sq = dw_q16 * dw_q16 + dl_q16 * dl_q16;
joint_err = (cd_isqrt64(sum_sq) * 65536u) / 92682u; /* sqrt(2)*65536 ~= 92682 */
if (joint_err > 65536u) joint_err = 65536u;
stability = (uint32_t)(65536u - (uint32_t)joint_err);
combined_stability = (uint32_t)(
((uint64_t)tuning->joint_weight_q16 * stability +
(uint64_t)tuning->anova_weight_q16 * anova_stability_q16) / 65536u
);
} else {
combined_stability = anova_stability_q16;
}
delta_score = ((int64_t)combined_stability - 32768) *
(int64_t)tuning->reward_gain / 32768;
score_cell = &table->regime_scores[r * table->num_configs + c];
old_score = *score_cell;
decayed = (uint32_t)(((uint64_t)old_score * tuning->score_decay_factor_q16) / 65536u);
new_s = (int64_t)decayed + delta_score;
if (new_s < (int64_t)tuning->score_min) new_score = tuning->score_min;
else if (new_s > (int64_t)tuning->score_max) new_score = tuning->score_max;
else new_score = (uint32_t)new_s;
*score_cell = new_score;
table->regime_ticks[r * table->num_configs + c]++;
if (table->total_regime_ticks[r] < 0xFFFFFFFFu) table->total_regime_ticks[r]++;
entry->tick_count++;
entry->prev_window = current_window;
entry->prev_locality_q16 = current_locality_q16;
entry->has_prev = 1u;
/* --- UCB1: select best config for the next tick --- */
total = table->total_regime_ticks[r];
ln_total = cd_ln_approx_q16(total > 0u ? total : 1u);
best_c = 0u;
best_ucb = 0u;
for (ci = 0u; ci < table->num_configs; ci++) {
uint32_t nc = table->regime_ticks[r * table->num_configs + ci];
uint32_t ucb;
if (nc == 0u) {
ucb = tuning->score_max;
} else {
uint32_t ratio = ln_total / nc;
uint32_t sqrt_r = cd_isqrt32(ratio);
uint32_t bonus = (uint32_t)(((uint64_t)tuning->ucb_k * sqrt_r) / 256u);
uint32_t sc = table->regime_scores[r * table->num_configs + ci];
ucb = sc + bonus;
if (ucb > tuning->score_max) ucb = tuning->score_max;
}
if (ucb > best_ucb) { best_ucb = ucb; best_c = ci; }
}
table->current_config = (uint8_t)best_c;
return table->entries[best_c].config_bits;
}
void cd_config_table_force(CDConfigTable *table, uint8_t config_idx)
{
if (!table || !table->entries) return;
if ((uint32_t)config_idx >= table->num_configs) return;
table->current_config = config_idx;
}
v3/src/dictionary_heat_optimization.c
+400
View File
@@ -0,0 +1,400 @@
/*
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 ***
dictionary_heat_optimization.c - Phase 2: Heat-Aware Dictionary Lookup Optimization
Implements inference-driven dictionary lookup optimizations based on execution
heat patterns. Uses rolling window to understand which words are hot and how they
co-execute, then reorganizes the dictionary to optimize lookup performance.
*/
#include <string.h>
#include <stdlib.h>
#include <stdio.h>
#include "vm.h"
#include "rolling_window_of_truth.h"
#include "dictionary_heat_optimization.h"
#include "log.h"
#include "platform_time.h"
/* sf_fc_list/sf_fc_count/sf_fc_cap are declared in dictionary_heat_optimization.h */
/* ============================================================================
* Heat Percentile Calculation
* ============================================================================
*/
/**
* @brief qsort comparator for @c cell_t execution-heat values in ascending order.
*
* Compares two @c cell_t values passed as @c const @c void* pointers (the
* signature required by @c qsort). Returns −1, 0, or +1 following C standard
* three-way comparison convention. Used exclusively by
* @c dict_update_heat_percentiles() to sort the scratch @c heats[] array
* before computing the 25th, 50th, and 75th percentile thresholds.
*
* @param a Pointer to the first @c cell_t value.
* @param b Pointer to the second @c cell_t value.
* @return −1 if @p *a < @p *b; +1 if @p *a > @p *b; 0 if equal.
*/
static int compare_heat_ascending(const void *a, const void *b) {
cell_t heat_a = *(const cell_t *)a;
cell_t heat_b = *(const cell_t *)b;
if (heat_a < heat_b) return -1;
if (heat_a > heat_b) return 1;
return 0;
}
/**
* @brief Collect dictionary execution heats and compute the 25th, 50th, and 75th percentiles.
*
* Traverses the full linked-list dictionary under @c vm->dict_lock to snapshot
* every word's @c execution_heat into a stack-allocated scratch array (up to
* @c DICTIONARY_SIZE entries). After releasing the lock it sorts the snapshot
* with @c qsort + @c compare_heat_ascending and computes percentile indices
* using integer arithmetic:
* @code
* vm->heat_threshold_25th = heats[(count * 25) / 100];
* vm->heat_threshold_50th = heats[(count * 50) / 100];
* vm->heat_threshold_75th = heats[(count * 75) / 100];
* @endcode
*
* If the dictionary contains no words all three thresholds are set to 0.
* The lock is held only during traversal; sorting is performed outside the
* critical section to minimise contention with the concurrent heartbeat decay
* sweep that also walks the word list.
*
* The resulting thresholds are consumed by @c dict_find_word_heat_aware()
* (which stratifies its search by heat tier) and by
* @c dict_adaptive_optimization_pass() (which calls this function as its
* first step every ~1 Hz).
*
* @param vm The VM whose dictionary is sampled and whose
* @c heat_threshold_25th / @c heat_threshold_50th /
* @c heat_threshold_75th fields are updated. No-op if NULL.
*/
void dict_update_heat_percentiles(VM *vm) {
if (!vm) return;
/* Collect all heats from dictionary */
cell_t heats[DICTIONARY_SIZE];
int count = 0;
/* Protect traversal against concurrent heartbeat decay sweeps */
sf_mutex_lock(&vm->dict_lock);
for (DictEntry *w = vm->latest; w && count < DICTIONARY_SIZE; w = w->link) {
heats[count++] = w->execution_heat;
}
sf_mutex_unlock(&vm->dict_lock);
if (count == 0) {
vm->heat_threshold_25th = 0;
vm->heat_threshold_50th = 0;
vm->heat_threshold_75th = 0;
return;
}
/* Sort heats in ascending order */
qsort(heats, count, sizeof(cell_t), compare_heat_ascending);
/* Calculate percentiles */
vm->heat_threshold_25th = heats[(count * 25) / 100];
vm->heat_threshold_50th = heats[(count * 50) / 100];
vm->heat_threshold_75th = heats[(count * 75) / 100];
log_message(LOG_DEBUG,
"Heat percentiles: 25th=%ld, 50th=%ld, 75th=%ld (from %d words)",
vm->heat_threshold_25th,
vm->heat_threshold_50th,
vm->heat_threshold_75th,
count);
}
/* ============================================================================
* Heat-Aware Lookup Strategy
* ============================================================================
*/
/**
* @brief Three-pass heat-stratified dictionary lookup, hottest tier first.
*
* Searches the first-character bucket @c sf_fc_list[(unsigned char)name[0]]
* for a word whose @c name and @c name_len match @p name / @p len, scanning
* in three priority tiers ordered by execution heat:
*
* -# **Hot pass** (heat ≥ @c heat_threshold_75th): words in the top 25%
* by execution frequency. Most FORTH programs spend the vast majority of
* ticks in a handful of hot primitives; checking this tier first yields a
* near-constant-time hit on steady-state workloads.
* -# **Medium pass** (heat in [threshold_25th, threshold_75th)): the middle
* 50% of words. These are occasionally-called words that still appear often
* enough to warrant a dedicated pass before touching the long tail.
* -# **Cold pass** (heat < @c heat_threshold_25th): the rarely-executed
* bottom quartile. Words that have never been called also live here.
*
* Within each pass, matching uses the same cheap-first filter chain as the
* standard lookup: @c name_len comparison → last-character byte check →
* full @c memcmp. The last-character pre-filter is skipped for single-character
* names.
*
* Returns @c NULL only if the word is absent from the bucket; all three passes
* exhausted without a hit. Also returns @c NULL immediately if @p vm, @p name,
* or @p len are invalid.
*
* Heat thresholds are updated lazily by @c dict_adaptive_optimization_pass()
* (≈1 Hz); stale thresholds degrade to a full three-pass scan without
* affecting correctness.
*
* @param vm The VM; provides @c heat_threshold_* fields and the bucket table.
* @param name Word name to search for (not NUL-terminated; length in @p len).
* @param len Length of @p name in bytes; must be ≥ 1.
* @return Pointer to the matching @c DictEntry, or @c NULL if not found.
*/
DictEntry *dict_find_word_heat_aware(VM *vm, const char *name, size_t len) {
if (!vm || !name || len == 0) return NULL;
const unsigned char first = (unsigned char)name[0];
DictEntry **bucket = sf_fc_list[first];
size_t n = sf_fc_count[first];
if (!bucket || n == 0) return NULL;
/* Resolution must be arbitrated: the heat-stratified three-pass scan
* returned the first name match in tier order, which resolves shadowed
* (redefined) names by execution heat instead of definition age — a
* FORTH-79 semantics violation that dict_reorganize_buckets_by_heat()
* turns into a live fault (see VM-COUNT primitive/constant collision,
* logs/20260704-155745). The strategy selection between naive and
* heat-aware lookup is preserved; both now resolve through the same
* age-honoring scan. A stratified fast path may be reintroduced on top
* of the resolver if lookup latency ever warrants it. */
return vm_dict_resolve_in_bucket(vm, bucket, n, name, len);
}
/* ============================================================================
* Bucket Reorganization by Heat Patterns
* ============================================================================
*/
/**
* @brief qsort comparator for @c DictEntry* pointers in descending execution-heat order.
*
* Dereferences two @c DictEntry** pointers and compares their
* @c execution_heat fields, returning −1 if the first entry is hotter,
* +1 if the second is hotter, or 0 on a tie. Used exclusively by
* @c dict_reorganize_buckets_by_heat() to sort each of the 256 first-character
* hash buckets so that hot words appear at lower array indices, reducing the
* average scan depth during the medium and cold passes of
* @c dict_find_word_heat_aware().
*
* @param a Pointer to a @c DictEntry* (first element).
* @param b Pointer to a @c DictEntry* (second element).
* @return −1 if @p a is hotter; +1 if @p b is hotter; 0 if equal.
*/
static int compare_dict_entry_heat_desc(const void *a, const void *b) {
DictEntry *entry_a = *(DictEntry * const *)a;
DictEntry *entry_b = *(DictEntry * const *)b;
if (entry_a->execution_heat > entry_b->execution_heat) return -1;
if (entry_a->execution_heat < entry_b->execution_heat) return 1;
return 0;
}
/**
* @brief Sort all 256 first-character hash buckets by descending execution heat.
*
* Holds @c vm->dict_lock for the entire operation to prevent concurrent
* @c DictEntry frees (from word redefinition or GC) from invalidating the
* pointer array while it is being sorted. For each non-empty bucket in
* @c sf_fc_list[0..255]:
*
* 1. Reads @c sf_fc_count[bucket_id] and @c sf_fc_cap[bucket_id]; skips the
* bucket if @c count > @c cap (indicates a TOCTOU race — logs a warning).
* 2. Allocates a temporary copy of the bucket pointer array.
* 3. Re-verifies @c count has not changed (TOCTOU double-check); if it has,
* frees the copy and skips.
* 4. Sorts the copy with @c qsort + @c compare_dict_entry_heat_desc so that
* the hottest @c DictEntry* comes first.
* 5. Copies the sorted array back over the original bucket.
* 6. Frees the temporary copy.
*
* After returning, @c vm->last_bucket_reorg_ns is updated to the completion
* timestamp so that @c dict_adaptive_optimization_pass() can enforce its 1 Hz
* throttle. The elapsed reorganization time is emitted at @c LOG_DEBUG.
*
* @param vm The VM whose first-character hash buckets are reorganized.
* No-op if NULL. @c dict_lock is held during the entire scan.
*/
void dict_reorganize_buckets_by_heat(VM *vm) {
if (!vm) return;
uint64_t reorg_start = sf_monotonic_ns();
/* Race fix: Hold dict_lock during entire reorganization (2025-12-09)
* Without this, main thread can free DictEntry objects while we're sorting pointers */
sf_mutex_lock(&vm->dict_lock);
/* Reorganize each bucket by heat (hottest words first) */
for (int bucket_id = 0; bucket_id < 256; bucket_id++) {
if (!sf_fc_list[bucket_id] || sf_fc_count[bucket_id] == 0) continue;
/* ASan fix: Verify count doesn't exceed capacity before accessing (2025-12-09)
* Race condition: Main thread may have changed count/capacity while we read it */
size_t count = sf_fc_count[bucket_id];
size_t cap = sf_fc_cap[bucket_id];
if (count > cap) {
log_message(LOG_WARN,
"dict_reorganize_buckets_by_heat: skipping bucket %d - count=%zu exceeds capacity=%zu (race condition)",
bucket_id, count, cap);
continue;
}
/* Make a copy of bucket pointers */
DictEntry **bucket_copy = malloc(count * sizeof(DictEntry *));
if (!bucket_copy) continue;
/* Re-verify count hasn't changed (TOCTOU protection) */
size_t count_recheck = sf_fc_count[bucket_id];
if (count_recheck != count || count_recheck > cap) {
log_message(LOG_WARN,
"dict_reorganize_buckets_by_heat: bucket %d count changed (%zu -> %zu), aborting",
bucket_id, count, count_recheck);
free(bucket_copy);
continue;
}
memcpy(bucket_copy, sf_fc_list[bucket_id], count * sizeof(DictEntry *));
/* Sort by descending heat (use cached count to avoid TOCTOU race) */
qsort(bucket_copy, count, sizeof(DictEntry *),
compare_dict_entry_heat_desc);
/* Copy back to original bucket (still use cached count) */
memcpy(sf_fc_list[bucket_id], bucket_copy, count * sizeof(DictEntry *));
free(bucket_copy);
}
sf_mutex_unlock(&vm->dict_lock);
uint64_t reorg_end = sf_monotonic_ns();
vm->last_bucket_reorg_ns = reorg_end;
log_message(LOG_DEBUG,
"Dictionary buckets reorganized by heat in %.1f μs",
(double)(reorg_end - reorg_start) / 1000.0);
}
/* ============================================================================
* Adaptive Optimization Pass
* ============================================================================
*/
/**
* @brief Throttled adaptive optimization pass — runs at most once per second.
*
* Called from the interpreter loop (or heartbeat) on every word dispatch; the
* 1 Hz gate (@c now_ns - @c vm->last_bucket_reorg_ns < 1,000,000,000) ensures
* the three expensive sub-steps run at a rate that is imperceptible to FORTH
* execution while still keeping the dictionary layout fresh:
*
* 1. **Update heat percentiles** — calls @c dict_update_heat_percentiles() to
* re-sample @c execution_heat across all words and compute the 25th / 50th /
* 75th thresholds used by the stratified lookup.
*
* 2. **Reorganize buckets** — calls @c dict_reorganize_buckets_by_heat() to
* sort each of the 256 first-character hash buckets so that the hottest
* words sit at the lowest array indices, shortening the average scan depth
* during the hot-tier pass.
*
* 3. **Select lookup strategy** — queries the rolling window for the current
* pattern-diversity score via @c rolling_window_measure_diversity():
* - Diversity > 70 (high churn in which words are called) → strategy 1
* (@c heat-aware lookup, @c dict_find_word_heat_aware()), where the heat
* stratification most pays off.
* - Diversity ≤ 70 (stable repetitive pattern) → strategy 0 (naive
* newest-first bucket scan), which is already nearly O(1) for programs
* that call the same small word set repeatedly.
* The chosen strategy is stored in @c vm->lookup_strategy and read by the
* interpreter's dictionary lookup dispatch.
*
* @param vm The VM to optimise. No-op if NULL or if less than 1 second has
* elapsed since the last pass (@c vm->last_bucket_reorg_ns).
*/
void dict_adaptive_optimization_pass(VM *vm) {
if (!vm) return;
uint64_t now_ns = sf_monotonic_ns();
/* Run optimization every 1 second */
if (now_ns - vm->last_bucket_reorg_ns < 1000000000ULL) {
return; /* Too soon, skip */
}
/* Step 1: Update heat percentiles based on current dictionary state */
dict_update_heat_percentiles(vm);
/* Step 2: Reorganize buckets by heat order (hot words first) */
dict_reorganize_buckets_by_heat(vm);
/* Step 3: Select lookup strategy based on pattern diversity */
uint64_t pattern_diversity = rolling_window_measure_diversity(&vm->rolling_window);
/* High diversity (0.7+): Use heat-aware lookup (patterns change frequently) */
if (pattern_diversity > 70) {
vm->lookup_strategy = 1; /* Heat-aware */
log_message(LOG_DEBUG,
"High pattern diversity (%.0f%%), using heat-aware lookup",
(double)pattern_diversity);
}
/* Medium diversity: Use naive newest-first (patterns reasonably stable) */
else {
vm->lookup_strategy = 0; /* Naive */
log_message(LOG_DEBUG,
"Stable patterns (%.0f%% diversity), using naive lookup",
(double)pattern_diversity);
}
}
v3/src/dictionary_management.c
+600
View File
@@ -0,0 +1,600 @@
/*
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 dictionary_management.c — FORTH-79 + ANSI C99
* Optimized: incremental FC index + capacity reuse + newest-first search
*/
#include "../include/vm.h"
#include "../include/io.h"
#include "../include/log.h"
#include "../include/physics_metadata.h"
#include "../include/physics_hotwords_cache.h"
#include "../include/physics_pipelining_metrics.h"
#include "../include/dictionary_heat_optimization.h"
#include "../include/platform_alloc.h"
#include <string.h>
#include <stddef.h>
#include <stdint.h>
#ifdef __STARKERNEL__
#include "starkernel/vm/stadium_words.h" /* item 4.1: FORGET coherence hook */
#include "starkernel/vm_uuid.h" /* vm_uuid_hera() */
#endif
/* LIKELY/UNLIKELY macros are defined in vm.h */
#ifndef SF_FC_BUCKETS
#define SF_FC_BUCKETS 256
#endif
/* Buckets of entry pointers, sizes, and capacities (we reuse memory). */
/* Note: sf_fc_list, sf_fc_count, and sf_fc_cap are not static to allow access from
* dictionary_heat_optimization.c for heat-aware bucket reorganization with proper
* capacity checks (ASan fix: 2025-12-09). */
DictEntry **sf_fc_list[SF_FC_BUCKETS];
size_t sf_fc_count[SF_FC_BUCKETS];
size_t sf_fc_cap[SF_FC_BUCKETS];
static DictEntry *sf_cached_latest = NULL; /* last head we indexed */
static uint32_t vm_dictionary_acquire_word_id(VM *vm) {
if (!vm) {
return WORD_ID_INVALID;
}
if (vm->recycled_word_id_count > 0) {
return vm->recycled_word_ids[--vm->recycled_word_id_count];
}
if (vm->next_word_id < DICTIONARY_SIZE) {
return vm->next_word_id++;
}
return WORD_ID_INVALID;
}
void vm_dictionary_track_entry(VM *vm, DictEntry *entry) {
if (!vm || !entry) {
return;
}
uint32_t word_id = vm_dictionary_acquire_word_id(vm);
entry->word_id = word_id;
if (word_id == WORD_ID_INVALID || word_id >= DICTIONARY_SIZE) {
log_message(LOG_WARN,
"vm_dictionary_track_entry: out of stable IDs, disabling metrics for '%.*s'",
(int)entry->name_len, entry->name);
return;
}
vm->word_id_map[word_id] = entry;
}
void vm_dictionary_untrack_entry(VM *vm, DictEntry *entry) {
if (!vm || !entry) {
return;
}
/* Cache coherence: the entry is about to be removed (FORGET frees it) —
* a stale pointer left in the hot-words ring would be a use-after-free,
* and an older same-named word may become visible again.
* §17.3 (item 4.1): retired under __STARKERNEL__ -- the kernel word
* layer stays inert to this mechanism entirely, so there is nothing to
* keep coherent here on the kernel side. Hosted is unaffected. */
#ifndef __STARKERNEL__
hotwords_cache_evict_entry(vm->hotwords_cache, entry);
#endif
uint32_t word_id = entry->word_id;
if (word_id == WORD_ID_INVALID || word_id >= DICTIONARY_SIZE) {
return;
}
#ifdef __STARKERNEL__
/* item 4.1 coherence hook: if this word_id is resident on the Stadium,
* reclaim its cell (crediting heat back to the reservoir) BEFORE the id
* is recycled below -- otherwise the next word assigned this same id
* would alias onto the forgotten word's stale cell (same failure class
* as the 2026-08-02 block_words.c aliasing bug). */
stadium_word_forget(vm->stadium_vm_id, word_id);
#endif
if (vm->word_id_map[word_id] == entry) {
vm->word_id_map[word_id] = NULL;
}
if (vm->recycled_word_id_count < DICTIONARY_SIZE) {
vm->recycled_word_ids[vm->recycled_word_id_count++] = word_id;
}
entry->word_id = WORD_ID_INVALID;
}
DictEntry *vm_dictionary_lookup_by_word_id(VM *vm, uint32_t word_id) {
if (!vm || word_id >= DICTIONARY_SIZE) {
return NULL;
}
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) {
void *r = sf_realloc(p, nbytes);
if (!r) {
sf_free(p);
return NULL;
}
return r;
}
static void sf_fc_clear_all(void) {
for (size_t i = 0; i < SF_FC_BUCKETS; ++i) {
sf_free(sf_fc_list[i]);
sf_fc_list[i] = NULL;
sf_fc_count[i] = 0;
sf_fc_cap[i] = 0;
}
}
/* Ensure bucket i has at least `need` capacity; grow geometrically. */
static int sf_fc_reserve(size_t i, size_t need) {
if (sf_fc_cap[i] >= need) return 1;
size_t newcap = sf_fc_cap[i] ? sf_fc_cap[i] : 8;
while (newcap < need) newcap <<= 1;
DictEntry **old = sf_fc_list[i];
DictEntry **newv = (DictEntry **) sf_xrealloc(old, newcap * sizeof(*newv));
if (!newv) return 0;
/* Kernel sf_realloc is a bump allocator that does not copy; patch that up.
* On hosted Linux, realloc already copied before freeing old — do NOT memcpy
* from freed memory (UB; glibc overwrites freed block with heap metadata). */
#ifdef __STARKERNEL__
{
size_t old_count = sf_fc_count[i];
if (newv != old && old && old_count > 0)
memcpy(newv, old, old_count * sizeof(*newv));
}
#endif
sf_fc_list[i] = newv;
sf_fc_cap[i] = newcap;
return 1;
}
/* Full rebuild: count → reserve → fill oldest→newest (so backward scan = newest-first). */
static void sf_rebuild_fc_index(VM *vm) {
/* Reset counts, keep capacity to avoid churn. */
for (size_t i = 0; i < SF_FC_BUCKETS; ++i) sf_fc_count[i] = 0;
/* Count first chars. */
for (DictEntry *e = vm->latest; e; e = e->link) {
unsigned fc = (unsigned char) e->name[0];
sf_fc_count[fc]++;
}
/* Reserve memory once per bucket. */
for (size_t i = 0; i < SF_FC_BUCKETS; ++i) {
if (sf_fc_count[i] && !sf_fc_reserve(i, sf_fc_count[i])) {
/* OOM for this bucket → treat as empty; we’ll just miss the fast path. */
sf_fc_count[i] = 0;
}
}
/* Back-fill so [0]=oldest, [count-1]=newest. */
size_t fill_at[SF_FC_BUCKETS];
for (size_t i = 0; i < SF_FC_BUCKETS; ++i) fill_at[i] = sf_fc_count[i];
for (DictEntry *e = vm->latest; e; e = e->link) {
unsigned fc = (unsigned char) e->name[0];
if (sf_fc_count[fc] == 0 || !sf_fc_list[fc]) continue;
sf_fc_list[fc][--fill_at[fc]] = e;
}
sf_cached_latest = vm->latest;
}
/* Fast path: if exactly one new word was pushed, append it without rebuilding. */
static void sf_try_fast_append(VM *vm) {
if (!vm || vm->latest == sf_cached_latest) return;
DictEntry *newest = vm->latest;
/* single push if the new head links to the previously cached head */
if (newest && newest->link == sf_cached_latest) {
unsigned fc = (unsigned char) newest->name[0];
size_t n = sf_fc_count[fc];
if (sf_fc_reserve(fc, n + 1)) {
/* Keep oldest→…→newest ordering: append at the end. */
sf_fc_list[fc][n] = newest;
sf_fc_count[fc] = n + 1;
sf_cached_latest = newest;
return;
}
}
/* Otherwise fall back to a full rebuild (multiple changes, deletes, etc.). */
sf_rebuild_fc_index(vm);
}
/* --- API ----------------------------------------------------------------- */
/**
* @brief Return whichever of two entries is the more recent definition.
*
* Walks the definition chain from @c vm->latest; the first of (@p a, @p b)
* encountered is the newer one. The link chain is the only reliable age
* order — word_id values are recycled and bucket positions are shuffled by
* @c dict_reorganize_buckets_by_heat(), so neither can arbitrate age.
* Only invoked when a bucket holds two visible entries with the same name
* (redefinition/shadowing), so the walk cost is off the common path.
*/
static DictEntry *dict_newer_of(VM *vm, DictEntry *a, DictEntry *b) {
for (DictEntry *e = vm->latest; e; e = e->link) {
if (e == a) return a;
if (e == b) return b;
}
return a;
}
DictEntry *vm_dict_resolve_in_bucket(VM *vm, DictEntry **bucket, size_t n,
const char *name, size_t len) {
if (!vm || !bucket || n == 0 || !name || len == 0) return NULL;
const unsigned char last = (len > 1) ? (unsigned char) name[len - 1] : 0;
DictEntry *best = NULL;
/* Full scan: bucket order is heat-shuffled, so no prefix of the bucket
* is authoritative — every same-named candidate must be considered and
* the newest visible definition wins (FORTH-79 shadowing). */
for (size_t i = n; i-- > 0;) {
DictEntry *e = bucket[i];
if (!e) continue;
if ((size_t) e->name_len != len) continue;
#ifdef WORD_HIDDEN
if (UNLIKELY(e->flags & WORD_HIDDEN)) continue;
#endif
#ifdef WORD_SMUDGED
if (UNLIKELY(e->flags & WORD_SMUDGED)) continue;
#endif
if (len > 1 && (unsigned char) e->name[len - 1] != last) continue;
if (memcmp(e->name, name, len) != 0) continue;
best = best ? dict_newer_of(vm, best, e) : e;
}
return best;
}
/* Find by name: newest-first within the first-character bucket. */
/**
* @brief Finds a word in the dictionary by name
*
* Searches for a word in the dictionary using an optimized first-character index.
* The search is performed newest-first within the matching first-character bucket.
*
* @param vm The virtual machine context
* @param name The name to search for
* @param len Length of the name string
* @return DictEntry* Pointer to found dictionary entry or NULL if not found
*/
DictEntry *vm_find_word(VM *vm, const char *name, size_t len) {
if (UNLIKELY(!vm || !name || len == 0)) return NULL;
/* DoE counter: dictionary lookups */
vm->heartbeat.dictionary_lookups++;
/* Thread safety: Acquire dict_lock for read access to dictionary */
sf_mutex_lock(&vm->dict_lock);
/* Keep the index in sync with dictionary head, cheaply if possible. */
if (UNLIKELY(sf_cached_latest != vm->latest)) sf_try_fast_append(vm);
const unsigned char first = (unsigned char) name[0];
DictEntry **bucket = sf_fc_list[first];
size_t n = sf_fc_count[first];
if (UNLIKELY(!bucket || n == 0)) {
sf_mutex_unlock(&vm->dict_lock);
return NULL;
}
/* Use hot-words cache for physics-driven frequency-based acceleration.
* The cache's bucket fallback resolves via vm_dict_resolve_in_bucket(),
* so a non-NULL result already honors newest-first shadowing.
* §17.3 (item 4.1): bypassed under __STARKERNEL__ -- the kernel side
* feeds the Stadium instead (vm_core.c's dispatch sites), and this
* lookup fast path is retired in favor of the ordinary bucket scan
* below. Hosted is unaffected. */
#ifndef __STARKERNEL__
DictEntry *found = hotwords_cache_lookup(vm, vm->hotwords_cache, bucket, n, name, len);
if (found) {
sf_mutex_unlock(&vm->dict_lock);
return found;
}
#endif
/* Phase 2: Choose lookup strategy based on pattern diversity */
if (vm->lookup_strategy == 1) {
/* Heat-aware lookup: search by heat percentiles (hot first) */
DictEntry *result = dict_find_word_heat_aware(vm, name, len);
sf_mutex_unlock(&vm->dict_lock);
return result;
}
/* Fallback/Default: arbitrated scan — buckets may be heat-reordered, so
* first-match-wins is unsound; the resolver picks the newest visible
* definition among all same-named candidates. */
DictEntry *e = vm_dict_resolve_in_bucket(vm, bucket, n, name, len);
sf_mutex_unlock(&vm->dict_lock);
return e;
}
/* Create a new word (unchanged layout); index append happens lazily on next lookup. */
/**
* @brief Creates a new word in the dictionary
*
* Allocates and initializes a new dictionary entry with the given name and function.
* The word is added to the dictionary but index update is deferred until next lookup.
*
* @param vm The virtual machine context
* @param name Name for the new word
* @param len Length of the name string
* @param func Function pointer for the word's behavior
* @return DictEntry* Pointer to new dictionary entry or NULL on failure
*/
DictEntry *vm_create_word(VM *vm, const char *name, size_t len, word_func_t func) {
if (!vm || !name || len == 0 || len > WORD_NAME_MAX) {
if (vm) {
vm->error = 1;
log_message(LOG_ERROR, "vm_create_word: invalid parameters (vm=%p, name=%p, len=%zu, max=%d)",
(void *) vm, (const void *) name, len, WORD_NAME_MAX);
}
return NULL;
}
DictEntry *entry = NULL;
int lock_held = 0;
sf_mutex_lock(&vm->dict_lock);
lock_held = 1;
/* Pin is permanent: no word may shadow a pinned entry — ever, by anyone */
for (DictEntry *scan = vm->latest; scan; scan = scan->link) {
if (scan->acl_pinned && scan->name_len == (uint8_t)len &&
memcmp(scan->name, name, len) == 0) {
vm->error = 1;
log_message(LOG_WARN, "vm_create_word: cannot shadow pinned word '%.*s'",
(int)len, name);
entry = NULL;
goto create_cleanup;
}
}
size_t base = offsetof(DictEntry, name);
size_t name_bytes = len + 1;
size_t align = sizeof(cell_t);
size_t df_off = (base + name_bytes + (align - 1)) & ~(align - 1);
size_t total = df_off + sizeof(cell_t);
entry = (DictEntry *) sf_malloc(total);
if (!entry) {
vm->error = 1;
log_message(LOG_ERROR, "vm_create_word: malloc failed for '%.*s' (%zu bytes)",
(int) len, name, total);
entry = NULL;
goto create_cleanup;
}
entry->link = vm->latest;
entry->func = func;
entry->flags = 0;
entry->name_len = (uint8_t) len;
entry->execution_heat = 0; /* Initialize execution heat counter */
entry->acl_default = ACL_USER_DEFAULT;
entry->acl_ttl = 0; /* first execution always rechecks */
entry->acl_allow = 1; /* permissive until ACL.4th loads */
entry->acl_mode = ACL_MODE_TTL;
entry->acl_pinned = 0;
entry->word_id = WORD_ID_INVALID;
uint32_t header_bytes = (total > UINT32_MAX) ? UINT32_MAX : (uint32_t) total;
physics_metadata_init(entry, header_bytes);
physics_metadata_apply_seed(entry);
/* Initialize word transition metrics for pipelining (Phase 1) */
entry->transition_metrics = (WordTransitionMetrics *)sf_malloc(sizeof(WordTransitionMetrics));
if (entry->transition_metrics) {
transition_metrics_init(entry->transition_metrics);
} else {
log_message(LOG_WARN, "vm_create_word: transition metrics malloc failed for '%.*s'", (int)len, name);
}
memcpy(entry->name, name, len);
entry->name[len] = '\0';
if (df_off > base + name_bytes) {
memset(((uint8_t *) entry) + base + name_bytes, 0, df_off - (base + name_bytes));
}
*(cell_t *) (((uint8_t *) entry) + df_off) = 0;
vm->latest = entry;
vm_dictionary_track_entry(vm, entry);
/* Cache coherence: this definition may shadow an older word of the same
* name that the hot-words cache is still serving. Evict the name so the
* next lookup re-resolves through the arbitrated bucket scan.
* §17.3 (item 4.1): retired under __STARKERNEL__, same as the other
* hotwords_cache_* call sites in this file. */
#ifndef __STARKERNEL__
hotwords_cache_evict_name(vm->hotwords_cache, name, len);
#endif
log_message(LOG_DEBUG, "vm_create_word: '%.*s' len=%zu total=%zu @%p",
(int) len, name, len, total, (void *) entry);
create_cleanup:
if (lock_held)
sf_mutex_unlock(&vm->dict_lock);
return entry;
}
/* Linear scan by func (left as-is; usually cold path). */
/**
* @brief Finds a word by its function pointer
*
* Performs a linear scan of the dictionary to find an entry with matching function.
*
* @param vm The virtual machine context
* @param func Function pointer to search for
* @return DictEntry* Pointer to found dictionary entry or NULL if not found
*/
DictEntry *vm_dictionary_find_by_func(VM *vm, word_func_t func) {
for (DictEntry *e = vm ? vm->latest : NULL; e; e = e->link) {
if (e->func == func) return e;
}
return NULL;
}
DictEntry *vm_dictionary_find_latest_by_func(VM *vm, word_func_t func) {
return vm_dictionary_find_by_func(vm, func);
}
/**
* @brief Gets pointer to a word's data field
*
* Calculates and returns pointer to the aligned data field following the name field.
*
* @param entry Dictionary entry to get data field from
* @return cell_t* Pointer to data field or NULL if entry is NULL
*/
cell_t *vm_dictionary_get_data_field(DictEntry *entry) {
if (!entry) return NULL;
size_t base = offsetof(DictEntry, name);
size_t name_bytes = (size_t) entry->name_len + 1;
size_t align = sizeof(cell_t);
size_t df_off = (base + name_bytes + (align - 1)) & ~(align - 1);
return (cell_t *) (((uint8_t *) entry) + df_off);
}
/**
* @brief Marks the latest word as hidden
*
* Sets the WORD_HIDDEN flag on the most recently defined word.
*
* @param vm The virtual machine context
*/
void vm_hide_word(VM *vm) {
if (vm && vm->latest) {
vm->latest->flags |= WORD_HIDDEN;
physics_metadata_refresh_state(vm->latest);
/* Visibility changed: this name may now resolve to an older entry.
* §17.3 (item 4.1): retired under __STARKERNEL__. */
#ifndef __STARKERNEL__
hotwords_cache_evict_name(vm->hotwords_cache,
vm->latest->name, vm->latest->name_len);
#endif
}
}
void vm_smudge_word(VM *vm) {
if (!vm || !vm->latest) {
if (vm) {
vm->error = 1;
log_message(LOG_ERROR, "vm_smudge_word: invalid vm or no latest word");
}
return;
}
vm->latest->flags ^= WORD_SMUDGED;
physics_metadata_refresh_state(vm->latest);
/* Visibility changed in either direction: force re-resolution.
* §17.3 (item 4.1): retired under __STARKERNEL__. */
#ifndef __STARKERNEL__
hotwords_cache_evict_name(vm->hotwords_cache,
vm->latest->name, vm->latest->name_len);
#endif
}
void vm_pin_execution_heat(VM *vm) {
if (!vm || !vm->latest) {
if (vm) {
vm->error = 1;
log_message(LOG_ERROR, "vm_pin_execution_heat: invalid vm or no latest word");
}
return;
}
vm->latest->flags |= WORD_PINNED;
physics_metadata_refresh_state(vm->latest);
}
void vm_unpin_execution_heat(VM *vm) {
if (!vm || !vm->latest) {
if (vm) {
vm->error = 1;
log_message(LOG_ERROR, "vm_unpin_execution_heat: invalid vm or no latest word");
}
return;
}
vm->latest->flags &= ~WORD_PINNED;
physics_metadata_refresh_state(vm->latest);
}
/* If you ever need to hard-reset (e.g., switching vocabularies wholesale) */
/**
* @brief Resets the dictionary index
*
* Clears all index data and cached state. Used when switching vocabularies.
*/
void vm_dictionary_index_reset(void) {
sf_cached_latest = NULL;
sf_fc_clear_all();
}
v3/src/doe_metrics.c
+639
View File
@@ -0,0 +1,639 @@
/*
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.
*/
/**
* @file doe_metrics.c
* @brief Design of Experiments metrics collection implementation
*/
#include "doe_metrics.h"
#include "physics_hotwords_cache.h"
#include "rolling_window_of_truth.h"
#include "rolling_window_knobs.h"
#include "inference_engine.h"
#include "platform_time.h"
#include <time.h>
#include <string.h>
#include <stdio.h>
#include <stdlib.h>
#ifdef __unix__
#include <unistd.h>
#endif
/* Forward declarations from physics system */
extern struct {
uint64_t total_lookups;
uint64_t cache_hits;
uint64_t bucket_hits;
} physics_global_stats;
/**
* Get current CPU temperature in Celsius
*/
int32_t metrics_get_cpu_temp_c(void) {
#ifdef __unix__
FILE *f = fopen("/sys/class/thermal/thermal_zone0/temp", "r");
if (!f) return 0;
int temp_millidegrees = 0;
if (fscanf(f, "%d", &temp_millidegrees) != 1) {
fclose(f);
return 0;
}
fclose(f);
return (int32_t)(temp_millidegrees / 1000);
#else
return 0;
#endif
}
/**
* Get current CPU frequency in MHz
*/
int32_t metrics_get_cpu_freq_mhz(void) {
#ifdef __unix__
/* Try scaling_cur_freq first */
FILE *f = fopen("/sys/devices/system/cpu/cpu0/cpufreq/scaling_cur_freq", "r");
if (f) {
int freq_khz = 0;
if (fscanf(f, "%d", &freq_khz) == 1) {
fclose(f);
return (int32_t)(freq_khz / 1000);
}
fclose(f);
}
/* Fallback to /proc/cpuinfo */
f = fopen("/proc/cpuinfo", "r");
if (f) {
char line[256];
while (fgets(line, sizeof(line), f)) {
if (strncmp(line, "cpu MHz", 7) == 0) {
float mhz = 0.0f;
if (sscanf(line, "cpu MHz : %f", &mhz) == 1) {
fclose(f);
return (int32_t)mhz;
}
}
}
fclose(f);
}
#endif
return 0;
}
/**
* Get current timestamp as ISO 8601 string
*/
void metrics_get_timestamp(char *buf, size_t bufsize) {
if (bufsize < 32) return;
time_t now = time(NULL);
struct tm *tm_info = localtime(&now);
strftime(buf, bufsize, "%Y-%m-%dT%H:%M:%S", tm_info);
}
/**
* Extract metrics from VM hotwords cache stats
*/
static void extract_cache_metrics(const HotwordsCache *cache, DoeMetrics *metrics) {
if (!cache) {
metrics->cache_hits = 0;
metrics->cache_hit_percent = 0.0;
metrics->bucket_hits = 0;
metrics->bucket_hit_percent = 0.0;
metrics->cache_hit_latency_ns = 0;
metrics->cache_hit_stddev_ns = 0;
metrics->bucket_search_latency_ns = 0;
metrics->bucket_search_stddev_ns = 0;
return;
}
const HotwordsStats *stats = &cache->stats;
/* Cache hits */
metrics->cache_hits = stats->cache_hits;
if (stats->total_lookups > 0) {
metrics->cache_hit_percent = 100.0 * (double)stats->cache_hits / (double)stats->total_lookups;
} else {
metrics->cache_hit_percent = 0.0;
}
/* Bucket hits */
metrics->bucket_hits = stats->bucket_hits;
if (stats->total_lookups > 0) {
metrics->bucket_hit_percent = 100.0 * (double)stats->bucket_hits / (double)stats->total_lookups;
} else {
metrics->bucket_hit_percent = 0.0;
}
/* Cache hit latency (convert from Q48.16 to ns) */
if (stats->cache_hit_samples > 0) {
int64_t avg_q48 = stats->cache_hit_total_ns_q48 / (int64_t)stats->cache_hit_samples;
metrics->cache_hit_latency_ns = avg_q48 >> 16; /* Convert from Q48.16 to nanoseconds */
/* StdDev calculation from variance sum */
if (stats->cache_hit_samples > 1) {
/* Simplified: use variance sum for estimation */
int64_t variance_q48 = stats->cache_hit_variance_sum_q48 / (int64_t)stats->cache_hit_samples;
metrics->cache_hit_stddev_ns = (int64_t)(variance_q48 >> 16);
} else {
metrics->cache_hit_stddev_ns = 0;
}
} else {
metrics->cache_hit_latency_ns = 0;
metrics->cache_hit_stddev_ns = 0;
}
/* Bucket search latency (convert from Q48.16 to ns) */
if (stats->bucket_search_samples > 0) {
int64_t avg_q48 = stats->bucket_search_total_ns_q48 / (int64_t)stats->bucket_search_samples;
metrics->bucket_search_latency_ns = avg_q48 >> 16; /* Convert from Q48.16 to nanoseconds */
/* StdDev calculation from variance sum */
if (stats->bucket_search_samples > 1) {
int64_t variance_q48 = stats->bucket_search_variance_sum_q48 / (int64_t)stats->bucket_search_samples;
metrics->bucket_search_stddev_ns = (int64_t)(variance_q48 >> 16);
} else {
metrics->bucket_search_stddev_ns = 0;
}
} else {
metrics->bucket_search_latency_ns = 0;
metrics->bucket_search_stddev_ns = 0;
}
}
/**
* Extract metrics from entire VM
*/
DoeMetrics metrics_from_vm(VM *vm, uint64_t workload_duration_ns,
int32_t cpu_temp_delta_c, int32_t cpu_freq_delta_mhz) {
DoeMetrics metrics = {0};
/* Lookups */
metrics.total_lookups = vm->hotwords_cache ? vm->hotwords_cache->stats.total_lookups : 0;
/* Cache metrics */
if (ENABLE_HOTWORDS_CACHE && vm->hotwords_cache) {
extract_cache_metrics(vm->hotwords_cache, &metrics);
metrics.enable_hotwords_cache = vm->hotwords_cache->enabled ? 1 : 0;
} else {
metrics.enable_hotwords_cache = 0;
}
/* Pipelining metrics - extract from global pipeline metrics (Loop #4) */
metrics.context_predictions_total = vm->pipeline_metrics.prefetch_attempts;
metrics.context_correct = vm->pipeline_metrics.prefetch_hits;
metrics.context_accuracy_percent = 0.0;
if (vm->pipeline_metrics.prefetch_attempts > 0) {
metrics.context_accuracy_percent = 100.0 * (double)vm->pipeline_metrics.prefetch_hits /
(double)vm->pipeline_metrics.prefetch_attempts;
}
/* === Rolling Window Metrics (Loop #2) === */
metrics.window_diversity_percent = 0.0;
metrics.window_final_size_bytes = 4096;
metrics.rolling_window_width = (uint32_t)vm->rolling_window.effective_window_size;
metrics.actual_window_size = (uint32_t)(vm->rolling_window.total_executions < ROLLING_WINDOW_SIZE
? vm->rolling_window.total_executions
: ROLLING_WINDOW_SIZE);
metrics.total_executions = vm->rolling_window.total_executions;
/* Protect access to last_inference_outputs against heartbeat thread race */
sf_mutex_lock(&vm->tuning_lock);
metrics.window_variance_q48 = vm->last_inference_outputs ?
vm->last_inference_outputs->window_variance_q48 : 0;
sf_mutex_unlock(&vm->tuning_lock);
/* === Heat Dynamics (Loop #1 & #3) === */
metrics.decay_slope = (double)vm->decay_slope_q48 / 65536.0;
/* Collect snapshot of current dictionary state */
{
uint64_t hot_word_count = 0;
uint64_t stale_word_count = 0;
uint64_t total_heat = 0;
uint32_t word_count = 0;
sf_mutex_lock(&vm->dict_lock);
for (DictEntry *e = vm->latest; e != NULL; e = e->link) {
if (e->execution_heat > HOTWORDS_EXECUTION_HEAT_THRESHOLD)
hot_word_count++;
else if (e->execution_heat > 0 && e->execution_heat < 10)
stale_word_count++;
total_heat += e->execution_heat;
word_count++;
}
sf_mutex_unlock(&vm->dict_lock);
metrics.total_heat = total_heat;
metrics.hot_word_count = hot_word_count;
metrics.stale_word_count = stale_word_count;
metrics.stale_word_ratio = (word_count > 0) ? (double)stale_word_count / (double)word_count : 0.0;
metrics.avg_word_heat = (word_count > 0) ? (double)total_heat / (double)word_count : 0.0;
}
/* === Heartbeat & Timing (Loop #7) === */
metrics.tick_count = vm->heartbeat.tick_count;
metrics.tick_target_ns = vm->heartbeat.tick_target_ns;
metrics.inference_run_count = vm->heartbeat.inference_run_count;
metrics.early_exit_count = vm->heartbeat.early_exit_count;
/* === Cache Promotions/Demotions (Loop #4) === */
if (vm->hotwords_cache) {
metrics.cache_promotions = vm->hotwords_cache->stats.promotions;
metrics.cache_demotions = vm->hotwords_cache->stats.evictions; /* evictions = demotions */
} else {
metrics.cache_promotions = 0;
metrics.cache_demotions = 0;
}
/* === Window & Decay Inference (Loop #5 & #6) === */
metrics.prefetch_accuracy_percent = 0.0;
metrics.prefetch_attempts = vm->pipeline_metrics.prefetch_attempts;
metrics.prefetch_hits = vm->pipeline_metrics.prefetch_hits;
metrics.window_tuning_checks = vm->pipeline_metrics.window_tuning_checks;
metrics.final_effective_window_size = (uint32_t)vm->rolling_window.effective_window_size;
if (vm->pipeline_metrics.prefetch_attempts > 0) {
metrics.prefetch_accuracy_percent = 100.0 * (double)vm->pipeline_metrics.prefetch_hits /
(double)vm->pipeline_metrics.prefetch_attempts;
}
/* === Performance counters === */
metrics.words_executed = vm->heartbeat.words_executed;
metrics.dictionary_lookups = vm->heartbeat.dictionary_lookups;
/* Performance - workload duration as Q48.16 */
metrics.vm_workload_duration_ns_q48 = (int64_t)workload_duration_ns << 16;
metrics.total_runtime_ms = 0;
metrics.memory_allocated_bytes = 0;
metrics.speedup_vs_baseline = 1.0;
/* Statistical (defaults) */
metrics.ci_lower_95 = 0.0;
metrics.ci_upper_95 = 0.0;
/* System state deltas - convert to Q48.16
* UBSan fix: Use multiplication instead of left-shift for signed values (2025-12-09)
* Left-shifting negative values is undefined behavior */
metrics.cpu_temp_delta_c_q48 = (int64_t)cpu_temp_delta_c * 65536;
metrics.cpu_freq_delta_mhz_q48 = (int64_t)cpu_freq_delta_mhz * 65536;
/* Tuning knobs */
metrics.decay_rate_q16 = DECAY_RATE_PER_US_Q16;
metrics.decay_min_interval_ns = DECAY_MIN_INTERVAL;
metrics.rolling_window_size = ROLLING_WINDOW_SIZE;
metrics.adaptive_shrink_rate = 75;
metrics.heat_cache_demotion_threshold = 10;
/* === Loop Enable Flags (2^7 factorial) === */
/* L8 FINAL INTEGRATION: All loops always-on, controlled by L8 policy */
metrics.enable_loop_1_heat_tracking = 1; /* Always-on (internal signal) */
metrics.enable_loop_2_rolling_window = 1; /* Always-on (L8-controlled) */
metrics.enable_loop_3_linear_decay = 1; /* Always-on */
metrics.enable_loop_4_pipelining = 1; /* Always-on (internal signal) */
metrics.enable_loop_5_window_inference = 1; /* Always-on */
metrics.enable_loop_6_decay_inference = 1; /* Always-on */
metrics.enable_loop_7_adaptive_heartrate = 1; /* Always-on */
/* Legacy configuration */
metrics.enable_hotwords_cache = ENABLE_HOTWORDS_CACHE;
metrics.enable_pipelining = ENABLE_PIPELINING;
return metrics;
}
/**
* Write CSV header
*/
void metrics_write_csv_header(FILE *out) {
fprintf(out,
/* Loop enable flags (2^7 factorial) - FIRST for easy filtering */
"L1_heat,L2_window,L3_decay,L4_pipeline,L5_win_inf,L6_decay_inf,L7_heartrate,"
/* Cache stats */
"total_lookups,cache_hits,cache_hit_pct,bucket_hits,bucket_hit_pct,"
"cache_lat_ns,cache_lat_std,bucket_lat_ns,bucket_lat_std,"
/* Pipelining (Loop #4) */
"ctx_pred_total,ctx_correct,ctx_acc_pct,cache_promos,cache_demos,"
/* Rolling window (Loop #2) */
"win_diversity_pct,win_final_bytes,win_width,actual_win_size,win_total_exec,win_var_q48,"
/* Heat dynamics (Loop #1 & #3) */
"decay_slope,total_heat,hot_words,stale_words,stale_ratio,avg_heat,"
/* Heartbeat & timing (Loop #7) */
"tick_count,tick_target_ns,infer_runs,early_exits,"
/* Window & decay inference (Loop #5 & #6) */
"prefetch_acc_pct,prefetch_attempts,prefetch_hits,win_tune_checks,final_win_size,"
/* Performance */
"workload_ns_q48,runtime_ms,words_exec,dict_lookups,mem_bytes,speedup,"
/* Statistical */
"ci_lower_95,ci_upper_95,"
/* System deltas */
"cpu_temp_delta_q48,cpu_freq_delta_q48,"
/* Tuning knobs */
"decay_rate_q16,decay_min_ns,roll_win_size,shrink_rate,demo_thresh,"
/* Legacy */
"hotwords_cache,pipelining\n");
}
/**
* Write CSV row - MUST match header column order exactly
*/
void metrics_write_csv_row(FILE *out, const DoeMetrics *metrics) {
fprintf(out,
/* Loop enable flags (2^7 factorial) - FIRST for easy filtering */
"%d,%d,%d,%d,%d,%d,%d,"
/* Cache stats */
"%u,%lu,%.2f,%lu,%.2f,"
"%ld,%ld,%ld,%ld,"
/* Pipelining (Loop #4) */
"%lu,%lu,%.2f,%lu,%lu,"
/* Rolling window (Loop #2) */
"%.2f,%u,%u,%u,%lu,%lu,"
/* Heat dynamics (Loop #1 & #3) */
"%.6f,%lu,%lu,%lu,%.6f,%.6f,"
/* Heartbeat & timing (Loop #7) */
"%lu,%lu,%lu,%lu,"
/* Window & decay inference (Loop #5 & #6) */
"%.2f,%lu,%lu,%lu,%u,"
/* Performance */
"%ld,%lu,%lu,%lu,%lu,%.4f,"
/* Statistical */
"%.6f,%.6f,"
/* System deltas */
"%ld,%ld,"
/* Tuning knobs */
"%u,%u,%u,%u,%u,"
/* Legacy */
"%d,%d\n",
/* Loop enable flags */
metrics->enable_loop_1_heat_tracking,
metrics->enable_loop_2_rolling_window,
metrics->enable_loop_3_linear_decay,
metrics->enable_loop_4_pipelining,
metrics->enable_loop_5_window_inference,
metrics->enable_loop_6_decay_inference,
metrics->enable_loop_7_adaptive_heartrate,
/* Cache stats */
metrics->total_lookups,
metrics->cache_hits,
metrics->cache_hit_percent,
metrics->bucket_hits,
metrics->bucket_hit_percent,
metrics->cache_hit_latency_ns,
metrics->cache_hit_stddev_ns,
metrics->bucket_search_latency_ns,
metrics->bucket_search_stddev_ns,
/* Pipelining (Loop #4) */
metrics->context_predictions_total,
metrics->context_correct,
metrics->context_accuracy_percent,
metrics->cache_promotions,
metrics->cache_demotions,
/* Rolling window (Loop #2) */
metrics->window_diversity_percent,
metrics->window_final_size_bytes,
metrics->rolling_window_width,
metrics->actual_window_size,
metrics->total_executions,
metrics->window_variance_q48,
/* Heat dynamics (Loop #1 & #3) */
metrics->decay_slope,
metrics->total_heat,
metrics->hot_word_count,
metrics->stale_word_count,
metrics->stale_word_ratio,
metrics->avg_word_heat,
/* Heartbeat & timing (Loop #7) */
metrics->tick_count,
metrics->tick_target_ns,
metrics->inference_run_count,
metrics->early_exit_count,
/* Window & decay inference (Loop #5 & #6) */
metrics->prefetch_accuracy_percent,
metrics->prefetch_attempts,
metrics->prefetch_hits,
metrics->window_tuning_checks,
metrics->final_effective_window_size,
/* Performance */
metrics->vm_workload_duration_ns_q48,
metrics->total_runtime_ms,
metrics->words_executed,
metrics->dictionary_lookups,
metrics->memory_allocated_bytes,
metrics->speedup_vs_baseline,
/* Statistical */
metrics->ci_lower_95,
metrics->ci_upper_95,
/* System deltas */
metrics->cpu_temp_delta_c_q48,
metrics->cpu_freq_delta_mhz_q48,
/* Tuning knobs */
metrics->decay_rate_q16,
metrics->decay_min_interval_ns,
metrics->rolling_window_size,
metrics->adaptive_shrink_rate,
metrics->heat_cache_demotion_threshold,
/* Legacy */
metrics->enable_hotwords_cache,
metrics->enable_pipelining);
}
/**
* Print metrics as human-readable text
*/
void metrics_print_text(FILE *out, const DoeMetrics *metrics) {
fprintf(out, "\n=== DoE Metrics ===\n");
fprintf(out, "Lookups: %u\n", metrics->total_lookups);
fprintf(out, "Cache Hits: %lu (%.2f%%)\n", metrics->cache_hits, metrics->cache_hit_percent);
fprintf(out, "Bucket Hits: %lu (%.2f%%)\n", metrics->bucket_hits, metrics->bucket_hit_percent);
fprintf(out, "Hit Latency: %ld ns (±%ld)\n", metrics->cache_hit_latency_ns, metrics->cache_hit_stddev_ns);
fprintf(out, "Search Latency: %ld ns (±%ld)\n", metrics->bucket_search_latency_ns, metrics->bucket_search_stddev_ns);
fprintf(out, "Predictions: %lu / %lu (%.2f%% accurate)\n",
metrics->context_correct, metrics->context_predictions_total, metrics->context_accuracy_percent);
fprintf(out, "Window Width: %u bytes\n", metrics->rolling_window_width);
fprintf(out, "Decay Slope: %.2f\n", metrics->decay_slope);
fprintf(out, "Workload Time: %ld ns (Q48.16)\n", metrics->vm_workload_duration_ns_q48);
fprintf(out, "CPU Temp Delta: %ld°C (Q48.16)\n", metrics->cpu_temp_delta_c_q48);
fprintf(out, "CPU Freq Delta: %ld MHz (Q48.16)\n", metrics->cpu_freq_delta_mhz_q48);
}
/**
* Integer square root using Newton's method (pure C99, no math.h)
*/
static uint64_t isqrt(uint64_t n) {
if (n == 0) return 0;
if (n < 4) return 1;
uint64_t x = n;
uint64_t y = (x + 1) / 2;
while (y < x) {
x = y;
y = (x + n / x) / 2;
}
return x;
}
/**
* Write reduced James Law CSV row (20 columns for window scaling experiment)
*
* This outputs only the subset of metrics needed for the James Law validation experiment.
* Format matches the header in run_window_sweep.sh (minus the 5 script-prepended columns).
*
* Expected columns (20):
* workload_duration_ns, l8_mode_final, lambda_effective, K_statistic, K_deviation,
* entropy, cv, temporal_decay, stability_score, ns_per_word, total_runtime_ms,
* window_final, hot_word_count, avg_heat, bucket_mean_K, bucket_cv_K,
* bucket_window_var, bucket_heat_var, bucket_mode_transitions, bucket_collapse_flag
*/
void metrics_write_james_law_csv_row(FILE *out, const DoeMetrics *metrics, VM *vm) {
/* Extract rolling window size for calculations */
uint32_t rolling_window_size = metrics->rolling_window_size;
if (rolling_window_size == 0) rolling_window_size = 1; /* Avoid division by zero */
/* Calculate James Law metrics */
uint32_t window_width = metrics->rolling_window_width;
double lambda_effective = (double)window_width;
double K_statistic = (window_width > 0) ? ((double)window_width / (double)rolling_window_size) : 1.0;
double K_deviation = K_statistic - 1.0;
/* Calculate derived metrics */
double entropy = metrics->window_diversity_percent / 100.0; /* Normalize to 0-1 */
/* Coefficient of variation: use cache hit latency stddev / mean as proxy */
double cv_metric = (metrics->cache_hit_latency_ns > 0)
? ((double)metrics->cache_hit_stddev_ns / (double)metrics->cache_hit_latency_ns)
: 1.0;
double temporal_decay = metrics->decay_slope;
/* Stability score: inverse of stale word ratio (higher = more stable) */
double stability_score = (metrics->stale_word_ratio < 1.0)
? (1.0 - metrics->stale_word_ratio) * 10000.0 /* Scale to match expected range */
: 0.0;
/* Performance: nanoseconds per word executed */
double ns_per_word = (metrics->words_executed > 0)
? ((double)metrics->vm_workload_duration_ns_q48 / (double)metrics->words_executed)
: 0.0;
/* Get L8 mode from VM heartbeat state */
uint8_t l8_mode_final = 1; /* Default to mode 1 if unavailable */
if (vm && vm->heartbeat.tick_buffer_write_index > 0) {
/* Get last tick's L8 mode */
uint32_t last_idx = (vm->heartbeat.tick_buffer_write_index - 1) % HEARTBEAT_TICK_BUFFER_SIZE;
l8_mode_final = vm->heartbeat.tick_buffer[last_idx].l8_mode;
}
/* Calculate bucket aggregates from heartbeat state */
double bucket_mean_K = 0.0;
double bucket_cv_K = 0.0;
double bucket_window_var = 0.0;
double bucket_heat_var = 0.0;
uint32_t bucket_mode_transitions = 0;
int bucket_collapse_flag = 0;
if (vm && vm->heartbeat.bucket_tick_count > 0) {
uint32_t n = vm->heartbeat.bucket_tick_count;
/* Mean K */
bucket_mean_K = vm->heartbeat.bucket_sum_K / (double)n;
/* CV of K: sqrt(variance) / mean using integer approximation */
double mean_K_squared = bucket_mean_K * bucket_mean_K;
double variance_K = (vm->heartbeat.bucket_sum_K_squared / (double)n) - mean_K_squared;
if (variance_K > 0.0 && bucket_mean_K > 0.0) {
/* Scale variance to avoid precision loss, compute integer sqrt, then scale back */
uint64_t variance_scaled = (uint64_t)(variance_K * 1000000.0);
uint64_t stddev_scaled = isqrt(variance_scaled);
double stddev_K = (double)stddev_scaled / 1000.0;
bucket_cv_K = (stddev_K / bucket_mean_K) * 100.0; /* As percentage */
}
/* Window and heat variance (using accumulated sums as proxy) */
bucket_window_var = vm->heartbeat.bucket_sum_window_variance;
bucket_heat_var = vm->heartbeat.bucket_sum_heat_variance;
bucket_mode_transitions = vm->heartbeat.bucket_mode_transitions;
bucket_collapse_flag = vm->heartbeat.bucket_collapse_flag;
}
/* Write CSV row: 20 columns */
fprintf(out,
"%ld,%u,%.6f,%.6f,%.6f," /* workload_duration_ns, l8_mode_final, lambda_effective, K_statistic, K_deviation */
"%.6f,%.6f,%.6f,%.6f,%.6f," /* entropy, cv, temporal_decay, stability_score, ns_per_word */
"%lu,%u,%lu,%.6f," /* total_runtime_ms, window_final, hot_word_count, avg_heat */
"%.6f,%.6f,%.6f,%.6f,%u,%d\n", /* bucket_mean_K, bucket_cv_K, bucket_window_var, bucket_heat_var, bucket_mode_transitions, bucket_collapse_flag */
/* Row 1-5 */
metrics->vm_workload_duration_ns_q48,
l8_mode_final,
lambda_effective,
K_statistic,
K_deviation,
/* Row 6-10 */
entropy,
cv_metric,
temporal_decay,
stability_score,
ns_per_word,
/* Row 11-14 */
metrics->total_runtime_ms,
metrics->final_effective_window_size,
metrics->hot_word_count,
metrics->avg_word_heat,
/* Row 15-20 */
bucket_mean_K,
bucket_cv_K,
bucket_window_var,
bucket_heat_var,
bucket_mode_transitions,
bucket_collapse_flag
);
}
v3/src/heartbeat_export.c
+196
View File
@@ -0,0 +1,196 @@
/*
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.
*/
#include "vm.h"
#include "log.h"
#include "platform_time.h"
#include <stdio.h>
#include <stdlib.h>
/**
* @brief Capture current VM metrics into a heartbeat tick snapshot
*
* Collects 11 metrics per tick for multivariate dynamics analysis.
* Called every heartbeat tick to record VM state.
*
* @param vm Pointer to the VM instance
* @param snapshot Pointer to snapshot structure to populate
*/
void heartbeat_capture_tick_snapshot(VM* vm, HeartbeatTickSnapshot* snapshot)
{
if (!vm || !snapshot)
return;
HeartbeatState* hb = &vm->heartbeat;
/* Monotonic tick counter — use the real heartbeat counter, not tick_count_total */
snapshot->tick_number = (uint32_t)hb->tick_count;
/* Timing: heartbeats ARE the clock ("we count heartbeats not timer ticks").
* sf_monotonic_ns() is unreliable in freestanding kernel (returns 0 on amd64,
* raw counter on riscv64). Use nominal tick period instead. */
snapshot->elapsed_ns = hb->tick_count * (uint64_t)HEARTBEAT_TICK_NS;
static uint64_t last_tick_count = 0;
uint64_t delta_ticks = hb->tick_count - last_tick_count;
snapshot->tick_interval_ns = delta_ticks * (uint64_t)HEARTBEAT_TICK_NS;
last_tick_count = hb->tick_count;
/* Delta metrics — computed from per-VM counters using static last-value tracking.
* On VM reset (current < last), treat current value as the full delta. */
/* Cache metrics from hotwords cache */
snapshot->cache_hits_delta = 0; /* TODO: wire hotwords cache hit counter */
snapshot->bucket_hits_delta = 0; /* TODO: wire bucket hit counter */
/* Word execution delta — words executed since the previous heartbeat tick.
* vm->heartbeat.words_executed is incremented by vm_core.c on every dispatch. */
{
static uint64_t last_words_executed = 0;
uint64_t cur = hb->words_executed;
snapshot->word_executions_delta = (uint32_t)(cur >= last_words_executed
? cur - last_words_executed
: cur);
last_words_executed = cur;
}
/* Hot word count - walk dictionary and count words above threshold */
snapshot->hot_word_count = 0;
uint64_t total_heat = 0;
uint32_t word_count = 0;
for (DictEntry* entry = vm->latest; entry; entry = entry->link)
{
if (entry->execution_heat > 0)
{
total_heat += entry->execution_heat;
word_count++;
/* Count as "hot" if above cache promotion threshold */
if (entry->execution_heat >= 10) /* HEAT_CACHE_DEMOTION_THRESHOLD */
{
snapshot->hot_word_count++;
}
}
}
/* Average word heat (convert Q48.16 to double) */
if (word_count > 0)
{
snapshot->avg_word_heat = (double)total_heat / (double)word_count / 65536.0;
}
else
{
snapshot->avg_word_heat = 0.0;
}
/* Rolling window size.
* window_width = L8's inferred effective size (the target).
* actual_window_size = min(total_executions, effective_window_size):
* how many entries are ACTUALLY being analysed right now — grows toward
* window_width as data accumulates, then tracks it as L8 narrows/widens. */
snapshot->window_width = vm->rolling_window.effective_window_size;
{
uint64_t fill = vm->rolling_window.total_executions;
uint32_t eff = vm->rolling_window.effective_window_size;
snapshot->actual_window_size = (uint32_t)(fill < (uint64_t)eff ? fill : eff);
}
/* predicted_label_hits: ANOVA early-exit confirmations per tick.
* Each early exit means the inference engine validated the current L8 config
* as stable — the selector's choice correlated with subsequent execution patterns.
* High rate = selector chose well and the system settled.
* Low rate = selector is still searching. */
{
static uint64_t last_early_exit_count = 0;
uint64_t cur = hb->early_exit_count;
snapshot->predicted_label_hits = (uint32_t)(cur >= last_early_exit_count
? cur - last_early_exit_count
: cur);
last_early_exit_count = cur;
}
/* Jitter: tick-based timing has no wall-clock deviation to measure.
* Encode delta_ticks as a deviation: 0 means exactly on schedule (1 tick/call). */
snapshot->estimated_jitter_ns = (delta_ticks > 1)
? (double)((delta_ticks - 1) * (uint64_t)HEARTBEAT_TICK_NS)
: 0.0;
}
/**
* @brief Emit a heartbeat tick snapshot as CSV row to stderr
*
* Outputs 11 comma-separated values (no header) for real-time streaming.
* Called every heartbeat tick to emit metrics immediately.
*
* Format: tick_number,elapsed_ns,tick_interval_ns,cache_hits_delta,
* bucket_hits_delta,word_executions_delta,hot_word_count,
* avg_word_heat,window_width,actual_window_size,predicted_label_hits,estimated_jitter_ns
*
* @param vm Pointer to the VM instance (unused, for API consistency)
* @param snapshot Pointer to the snapshot to emit
*/
void heartbeat_emit_tick_row(VM* vm, HeartbeatTickSnapshot* snapshot)
{
(void)vm; /* Unused parameter */
if (!snapshot)
return;
/* Emit CSV row to stderr - no header, just data */
fprintf(stderr, "%u,%lu,%lu,%u,%u,%u,%lu,%.6f,%u,%u,%u,%.2f\n",
snapshot->tick_number,
snapshot->elapsed_ns,
snapshot->tick_interval_ns,
snapshot->cache_hits_delta,
snapshot->bucket_hits_delta,
snapshot->word_executions_delta,
snapshot->hot_word_count,
snapshot->avg_word_heat,
snapshot->window_width,
snapshot->actual_window_size,
snapshot->predicted_label_hits,
snapshot->estimated_jitter_ns);
/* Ensure immediate output to stderr (unbuffered) */
fflush(stderr);
}
v3/src/inference_engine.c
+832
View File
@@ -0,0 +1,832 @@
/*
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.
*/
#include <stdlib.h>
#include <string.h>
#include <stdio.h>
#include <stdint.h>
#include <assert.h>
#include "inference_engine.h"
#include "q48_16.h"
#include "vm.h"
#include "rolling_window_of_truth.h"
#include "ssm_jacquard.h"
/* ============================================================================
* Phase 2A: ANOVA Early-Exit Check
* ============================================================================
*
* Purpose: Skip full inference if variance hasn't changed significantly
* Threshold: 5% variance change (VARIANCE_SIGNIFICANCE_THRESHOLD in vm.h)
* Cost if stable: ~100 CPU cycles
* Cost if unstable: Full inference run (~5-10k cycles)
*/
/**
* @brief ANOVA early-exit check: test whether variance has stabilised.
*
* Computes |current - last| / last. If the relative change is <= 5%
* (threshold = 3276 in Q48.16), the variance is considered stable and
* full inference can be skipped (~100 cycles vs ~5–10k for a full run).
* Always returns 0 (unstable) on the first call when @c last_variance == 0.
*
* @param current_variance Variance from the current snapshot (Q48.16)
* @param last_variance Variance from the previous inference run (Q48.16)
* @return 1 if variance is stable (skip inference), 0 if full run needed
*/
static int has_variance_stabilized(
q48_16_t current_variance,
q48_16_t last_variance
)
{
if (last_variance == 0) {
/* First run, always do full inference */
return 0;
}
/* Calculate variance delta as ratio */
q48_16_t delta = (current_variance > last_variance)
? (current_variance - last_variance)
: (last_variance - current_variance);
/* Compute delta / last_variance in Q48.16 */
q48_16_t ratio = q48_div(delta, last_variance);
/* Threshold: 5% = 0.05 in Q48.16 = 0.05 * 65536 = 3276 */
q48_16_t threshold = 3276;
if (ratio <= threshold) {
/* Variance is stable, skip full inference */
return 1;
}
/* Variance changed significantly, run full inference */
return 0;
}
/* ============================================================================
* Phase 2B: Heat Trajectory Extraction
* ============================================================================
*
* Purpose: Fresh snapshot of execution_heat from dictionary
* Strategy: Iterate vm->latest backwards, collect heat values
* Timing: O(dictionary_entries), called every HEARTBEAT_INFERENCE_FREQUENCY ticks
*/
/*
* Build a heat trajectory for inference using a consistent rolling window snapshot.
*
* We linearize the rolling window into a temporary ID buffer (via the public export API)
* and convert the most recent entries into execution_heat samples by consulting the
* stable word-id map protected by dict_lock. This keeps the inference engine fully
* thread-safe while still operating on real heat values instead of raw IDs.
*/
/**
* @brief Build a heat trajectory array from the rolling window of truth.
*
* Linearises the rolling window via @c rolling_window_export_execution_history(),
* then translates each word-id slot to its current @c execution_heat by
* looking up the entry under @c vm->dict_lock. The result is a freshly
* allocated array of @c *out_length uint64_t values in chronological order.
* The caller is responsible for freeing the returned pointer. Returns NULL
* (and sets @c *out_length = 0) on allocation failure or empty window.
*
* @param window Rolling window to export from
* @param vm VM whose dictionary is consulted for heat values
* @param out_length Output: number of elements in the returned array
* @return Heap-allocated trajectory array, or NULL on failure
*/
static uint64_t* extract_heat_trajectory(
RollingWindowOfTruth *window,
VM *vm,
uint64_t *out_length
)
{
if (!window || !vm || !out_length) {
return NULL;
}
uint32_t *word_ids = (uint32_t*)malloc(ROLLING_WINDOW_SIZE * sizeof(uint32_t));
if (!word_ids) {
*out_length = 0;
return NULL;
}
uint64_t exported = rolling_window_export_execution_history(window,
word_ids,
ROLLING_WINDOW_SIZE);
if (exported == 0) {
free(word_ids);
*out_length = 0;
return NULL;
}
uint64_t span = window->is_warm
? (uint64_t)window->effective_window_size
: exported;
if (span > exported) span = exported;
if (span == 0) {
free(word_ids);
*out_length = 0;
return NULL;
}
uint64_t *trajectory = (uint64_t*)malloc(span * sizeof(uint64_t));
if (!trajectory) {
free(word_ids);
*out_length = 0;
return NULL;
}
uint64_t start = exported - span;
sf_mutex_lock(&vm->dict_lock);
for (uint64_t i = 0; i < span; i++) {
uint32_t word_id = word_ids[start + i];
uint64_t heat = 0;
if (word_id < DICTIONARY_SIZE) {
DictEntry *entry = vm_dictionary_lookup_by_word_id(vm, word_id);
if (entry) {
heat = (uint64_t)entry->execution_heat;
}
}
trajectory[i] = heat;
}
sf_mutex_unlock(&vm->dict_lock);
free(word_ids);
*out_length = span;
return trajectory;
}
/* ============================================================================
* Phase 2C: Window Width Inference (Variance Inflection)
* ============================================================================
*
* Purpose: Find statistical point where adding more data stops refining understanding
*
* Algorithm:
* 1. For each sub-window size from MIN to full:
* - Compute variance_q48 of heat in that window
* 2. Detect inflection: where d(variance)/d(size) → 0
* - When |variance[i+1] - variance[i]| < 1% of current variance
* - Return that size as inferred_window_width
* 3. Clamp to [ADAPTIVE_MIN_WINDOW_SIZE, ROLLING_WINDOW_SIZE]
*/
/**
* @brief Compute the variance of a heat trajectory in Q48.16 fixed-point.
*
* Computes the population variance: Σ(heat[i] - mean)² / N.
* All intermediate calculations use Q48.16 arithmetic. Returns 0 for
* an empty array.
*
* @param heat_data Array of execution heat values (raw uint64_t counts)
* @param length Number of elements in @c heat_data
* @return Population variance in Q48.16 format
*/
q48_16_t compute_variance_q48(
const uint64_t *heat_data,
uint64_t length
)
{
if (length == 0) return 0;
/* Compute mean in Q48.16 */
uint64_t sum = 0;
for (uint64_t i = 0; i < length; i++) {
sum += heat_data[i];
}
q48_16_t mean = q48_div(q48_from_u64(sum), q48_from_u64(length));
/* Compute sum of squared deviations */
uint64_t sum_sq_diff = 0;
for (uint64_t i = 0; i < length; i++) {
q48_16_t heat_q48 = q48_from_u64(heat_data[i]);
q48_16_t diff = (heat_q48 > mean) ? (heat_q48 - mean) : (mean - heat_q48);
q48_16_t sq_diff = q48_mul(diff, diff);
sum_sq_diff += q48_to_u64(sq_diff);
}
/* Variance = sum_sq_diff / length */
q48_16_t variance = q48_div(q48_from_u64(sum_sq_diff), q48_from_u64(length));
return variance;
}
/* ============================================================================
* Helper: Compute Median (for Levene's Test)
* ============================================================================
*
* Purpose: Find median of array for robust central tendency
* Note: Uses simple selection algorithm (O(n) expected, O(n²) worst case)
*/
/**
* @brief Compute the median of a Q48.16 array.
*
* Makes a temporary copy, sorts it with bubble sort (acceptable for the
* small chunk counts used in Levene's test, typically K <= 16), and
* returns the middle element. Returns 0 for an empty array.
*
* @param data Array of Q48.16 values
* @param length Number of elements
* @return Median value in Q48.16 format
*/
static q48_16_t compute_median_q48(
const q48_16_t *data,
uint32_t length
)
{
if (length == 0) return 0;
if (length == 1) return data[0];
/* Make a copy and sort (bubble sort for small arrays) */
q48_16_t *sorted = (q48_16_t *)malloc(length * sizeof(q48_16_t));
if (!sorted) return 0;
memcpy(sorted, data, length * sizeof(q48_16_t));
/* Simple bubble sort */
for (uint32_t i = 0; i < length - 1; i++) {
for (uint32_t j = 0; j < length - i - 1; j++) {
if (sorted[j] > sorted[j + 1]) {
q48_16_t tmp = sorted[j];
sorted[j] = sorted[j + 1];
sorted[j + 1] = tmp;
}
}
}
q48_16_t median = sorted[length / 2];
free(sorted);
return median;
}
/* ============================================================================
* Helper: Compute Mean in Q48.16
* ============================================================================
*
* Purpose: Calculate arithmetic mean of Q48.16 values
*/
/**
* @brief Compute the arithmetic mean of a Q48.16 array.
*
* Sums the integer parts of each element (>> 16) and returns the result
* converted back to Q48.16. Returns 0 for an empty array.
*
* @param data Array of Q48.16 values
* @param length Number of elements
* @return Arithmetic mean in Q48.16 format
*/
static q48_16_t compute_mean_q48(
const q48_16_t *data,
uint32_t length
)
{
if (length == 0) return 0;
uint64_t sum = 0;
for (uint32_t i = 0; i < length; i++) {
sum += data[i] >> 16; /* Convert to integer part */
}
return q48_from_u64(sum / length);
}
/* ============================================================================
* Levene's Test for Equality of Variance (Statistically Valid)
* ============================================================================
*
* Purpose: Test if multiple samples have equal variance
* Reference: Levene, H. (1960). "Robust tests for equality of variances"
*
* Null Hypothesis H₀: All chunk variances are equal
* Test Statistic W: Ratio of variance of deviations to overall deviation
*
* If W > critical_value (≈6.5 for α=0.05): REJECT H₀ (variances differ)
* If W ≤ critical_value: FAIL TO REJECT H₀ (variances are similar)
*
* Input:
* - chunk_variances: Array of K variance values (one per chunk)
* - num_chunks: K (number of chunks)
* - chunk_size: N (size of each chunk, all equal)
*
* Output:
* - W statistic in Q48.16 format
* - Compare result to LEVENE_CRITICAL_VALUE_Q48
*/
/**
* @brief Compute Levene's W statistic for equality of variance.
*
* Tests the null hypothesis H₀: all chunk variances are equal.
* Uses the median-based variant for robustness: z_i = |var_i - median_var|,
* then W = (K-1)*N*Σ(z_i - z_bar)² / (K*N * var(z)).
* Returns 0 for fewer than 2 chunks. Compare result to
* @c LEVENE_CRITICAL_VALUE_Q48 (≈ 6.5 at α=0.05): W > critical means
* variances differ significantly.
*
* @param chunk_variances Array of K per-chunk variance values (Q48.16)
* @param num_chunks Number of chunks K (must be >= 2)
* @param chunk_size Number of samples N per chunk
* @return Levene's W statistic in Q48.16 format
*/
static q48_16_t compute_levene_statistic(
const q48_16_t *chunk_variances,
uint32_t num_chunks,
uint32_t chunk_size
)
{
if (num_chunks < 2) return 0;
/* Step 1: Compute median variance */
q48_16_t median_var = compute_median_q48(chunk_variances, num_chunks);
/* Step 2: Compute z_i = |variance_i - median_var| */
q48_16_t *z = (q48_16_t *)malloc(num_chunks * sizeof(q48_16_t));
if (!z) return 0;
for (uint32_t i = 0; i < num_chunks; i++) {
z[i] = (chunk_variances[i] > median_var)
? (chunk_variances[i] - median_var)
: (median_var - chunk_variances[i]);
}
/* Step 3: Compute z_bar = mean(z) */
q48_16_t z_bar = compute_mean_q48(z, num_chunks);
/* Step 4: Compute numerator = (K-1) * N * Σ(z_i - z_bar)² */
q48_16_t sum_sq_diff = 0;
for (uint32_t i = 0; i < num_chunks; i++) {
q48_16_t diff = (z[i] > z_bar) ? (z[i] - z_bar) : (z_bar - z[i]);
q48_16_t sq = q48_mul(diff, diff);
sum_sq_diff = q48_add(sum_sq_diff, sq);
}
q48_16_t numerator = q48_mul(
q48_from_u64(num_chunks - 1),
q48_mul(q48_from_u64(chunk_size), sum_sq_diff)
);
/* Step 5: Compute denominator = Σ_i Σ_j (z_ij - z_i_mean)² */
/* Approximation: Use variance of z values */
q48_16_t z_variance = compute_variance_q48((const uint64_t *)z, num_chunks);
q48_16_t denominator = q48_mul(q48_from_u64(num_chunks), z_variance);
/* Step 6: W = numerator / denominator */
q48_16_t W = (denominator > 0) ? q48_div(numerator, denominator) : 0;
free(z);
return W;
}
/**
* @brief Find the minimum window size where heat variance is statistically stable.
*
* Implements Loop #5 (window width inference). Scans candidate window sizes from
* @c ADAPTIVE_MIN_WINDOW_SIZE to the full trajectory in steps of 64, divides the
* trajectory into disjoint chunks of that size, and applies Levene's test. Returns
* the first size where W <= 6.5 (α=0.05 critical value). Falls back to the full
* trajectory length if no size passes. @c full_variance is unused (retained for
* API compatibility with callers that pre-compute it).
*
* @param heat_data Heat trajectory array
* @param trajectory_length Number of elements in @c heat_data
* @param full_variance Unused; retained for API compatibility
* @return Minimum sufficient window width in [ADAPTIVE_MIN_WINDOW_SIZE, ROLLING_WINDOW_SIZE]
*/
uint32_t find_variance_inflection(
const uint64_t *heat_data,
uint64_t trajectory_length,
q48_16_t full_variance /* Unused in new algorithm */
)
{
(void)full_variance;
/* ========================================================================
* REDESIGNED: Levene's Test for Statistical Validity (2025-11-19)
* ========================================================================
*
* OLD ALGORITHM (FLAWED):
* - Computed prefix variance: var[0..N], var[0..2N], var[0..3N], ...
* - Violated statistical independence
* - Confounded "enough data" with "variance decay"
* - Used magic 1% threshold with no statistical justification
*
* NEW ALGORITHM (VALID):
* - Divides trajectory into K disjoint chunks of size N
* - Computes variance of each chunk independently
* - Uses Levene's test for equality of variance
* - Statistically sound hypothesis test (α=0.05)
* - Finds MINIMUM window size where variance is stable
*
* Reference: Levene, H. (1960). "Robust tests for equality of variances"
* In: Contributions to Probability and Statistics
*/
/* Use constants from vm.h (defined as macros) */
#ifndef ADAPTIVE_MIN_WINDOW_SIZE
#define ADAPTIVE_MIN_WINDOW_SIZE 256
#endif
#ifndef ROLLING_WINDOW_SIZE
#define ROLLING_WINDOW_SIZE 4096
#endif
if (trajectory_length == 0) {
return ROLLING_WINDOW_SIZE / 2; /* Default */
}
uint32_t min_size = ADAPTIVE_MIN_WINDOW_SIZE;
uint32_t max_size = (trajectory_length < ROLLING_WINDOW_SIZE)
? (uint32_t)trajectory_length
: ROLLING_WINDOW_SIZE;
/* Levene's critical value for α=0.05 with K≥3 degrees of freedom */
/* Theoretical value ≈ 5.88, conservative estimate ≈ 6.5 */
q48_16_t levene_critical = q48_from_double(6.5);
/* Scan for minimum window size where variance is statistically stable */
for (uint32_t size = min_size; size <= max_size; size += 64) {
uint32_t num_chunks = (uint32_t)(trajectory_length / size);
/* Need at least 3 chunks for reliable statistical test */
if (num_chunks < 3) {
continue; /* Too few chunks, try larger size */
}
/* Allocate and compute variance for each disjoint chunk */
q48_16_t *chunk_vars = (q48_16_t *)malloc(num_chunks * sizeof(q48_16_t));
if (!chunk_vars) {
continue; /* Allocation failed, skip this size */
}
for (uint32_t i = 0; i < num_chunks; i++) {
uint64_t chunk_start = (uint64_t)i * (uint64_t)size;
chunk_vars[i] = compute_variance_q48(
&heat_data[chunk_start],
size
);
}
/* Apply Levene's test for equality of variance */
q48_16_t W = compute_levene_statistic(chunk_vars, num_chunks, size);
free(chunk_vars);
/* If test passes: variances are statistically similar */
/* This window size is SUFFICIENT for capturing the pattern */
if (W <= levene_critical) {
return size; /* Found minimum sufficient window */
}
}
/* If no size passed test, use maximum available */
return max_size;
}
/* ============================================================================
* Phase 2D: Decay Slope Inference (Closed-Form Linear Regression)
* ============================================================================
*
* Purpose: Extract decay_slope from heat trajectory via exponential fitting
*
* Model: ln(heat[t]) = ln(h0) - slope*t
* (Exponential decay: heat(t) = h0 * e^(-slope*t))
*
* Algorithm (Integer-only, Q48.16):
* 1. Transform trajectory to log space
* 2. Linear regression on log_heat = a - slope*t
* 3. Extract slope coefficient
*
* Closed-form solution:
* numerator = n * Σ(t*ln(heat)) - Σt * Σln(heat)
* denominator = n * Σ(t²) - (Σt)²
* slope = numerator / denominator
*/
/**
* @brief Infer the decay slope from a heat trajectory via log-linear regression.
*
* Implements Loop #6 (decay slope inference). Fits the model
* ln(heat[t]) = ln(h₀) - slope*t using the closed-form OLS solution:
* slope = (n*Σ(t·ln(h)) - Σt·Σln(h)) / (n·Σt² - (Σt)²).
* The sign of the numerator is taken as absolute value since decay rate
* is always positive. Zero heat values are skipped. Returns 0 if fewer
* than 2 samples are available.
*
* @param heat_data Array of execution heat values (raw counts)
* @param length Number of elements in @c heat_data
* @return Inferred decay slope in Q48.16 format (0 = insufficient data)
*/
uint64_t infer_decay_slope_q48(
const uint64_t *heat_data,
uint64_t length
)
{
if (length < 2) {
return 0;
}
/* Compute sums for linear regression */
uint64_t n = length;
uint64_t sum_t = (n * (n - 1)) / 2; /* 0+1+2+...+(n-1) */
uint64_t sum_t_sq = (n * (n - 1) * (2 * n - 1)) / 6; /* 0²+1²+...+(n-1)² */
q48_16_t sum_log_heat = 0;
q48_16_t sum_t_log_heat = 0;
for (uint64_t t = 0; t < length; t++) {
if (heat_data[t] == 0) continue; /* Skip zero heat values */
/* Compute ln(heat[t]) in Q48.16 */
q48_16_t log_heat = q48_log_approx(heat_data[t]);
sum_log_heat = q48_add(sum_log_heat, log_heat);
/* Compute t * ln(heat[t]) */
q48_16_t t_log = q48_mul(q48_from_u64(t), log_heat);
sum_t_log_heat = q48_add(sum_t_log_heat, t_log);
}
/* Compute slope = (n*Σ(t*ln) - Σt*Σln) / (n*Σ(t²) - (Σt)²) */
/* Note: For decay, numerator may be negative, so use signed arithmetic */
int64_t n_times_sum_t_log = (int64_t)q48_mul(q48_from_u64(n), sum_t_log_heat);
int64_t sum_t_times_sum_log = (int64_t)q48_mul(q48_from_u64(sum_t), sum_log_heat);
int64_t numerator_signed = n_times_sum_t_log - sum_t_times_sum_log;
/* Take absolute value (decay rate is always positive) */
uint64_t numerator = (numerator_signed < 0) ? (uint64_t)(-numerator_signed) : (uint64_t)numerator_signed;
uint64_t denominator_raw = (n * sum_t_sq) - (sum_t * sum_t);
if (denominator_raw == 0) {
denominator_raw = 1; /* Avoid division by zero */
}
/* Divide: numerator is Q48.16, denominator is raw */
/* slope = numerator_Q48 / denominator_raw preserves Q48.16 scaling */
uint64_t slope = numerator / denominator_raw;
return slope;
}
/* ============================================================================
* Phase 2E: Fit Quality Assessment
* ============================================================================
*
* Purpose: Compute R² or residual metric for diagnostics
* Simplified: Use residual sum of squares / total sum of squares
*/
/**
* @brief Compute R²-style fit quality for the inferred decay slope.
*
* Currently returns a fixed placeholder of 0.8 in Q48.16 (52429). A full
* residual-sum-of-squares implementation is planned but deferred — the
* placeholder is sufficient for the DoE convergence signal.
*
* @param heat_data Array of heat values (unused in current implementation)
* @param length Array length (unused in current implementation)
* @param slope_q48 Inferred slope in Q48.16 (unused in current implementation)
* @return Fit quality in Q48.16; currently always 0.8 (52429)
*/
static uint64_t compute_fit_quality(
const uint64_t *heat_data,
uint64_t length,
uint64_t slope_q48
)
{
(void)heat_data;
(void)slope_q48;
if (length < 2) {
return q48_from_u64(1); /* Perfect fit if no data */
}
/* Simplified: Return ratio of predicted-to-actual variance */
/* For now: return 0.8 in Q48.16 as placeholder */
return (q48_16_t)52429ULL; /* 0.8 * 65536 ≈ 52429 in Q48.16 */
}
/* ============================================================================
* Main API: inference_engine_run()
* ============================================================================
*
* High-level orchestrator that coordinates all inference phases
*/
/*
* @brief Run the full inference engine pipeline.
*
* High-level orchestrator for Loops #5 and #6. In order:
* 1. Extract the heat trajectory from the rolling window (Phase 2B).
* 2. ANOVA early-exit check — if variance is stable, skip and set
* @c outputs->early_exited = 1 (Phase 2A).
* 3. Window width inference via Levene's test — gated by L5 flag in
* @c vm->ssm_config (Phase 2C).
* 4. Decay slope inference via log-linear regression — gated by L6 flag
* (Phase 2D).
* 5. Fit quality assessment (Phase 2E).
* Writes all results into @c outputs and frees the trajectory. No-op if
* any required pointer is NULL.
*
* @param inputs Input pointers: rolling window and VM reference
* @param outputs Output struct updated with window, slope, variance, fit quality
*/
void inference_engine_run(InferenceInputs *inputs, InferenceOutputs *outputs)
{
if (!inputs || !outputs || !inputs->window || !inputs->vm) {
return;
}
/* === PHASE 2B: Extract Fresh Heat Trajectory === */
uint64_t traj_len = 0;
uint64_t *trajectory = extract_heat_trajectory(inputs->window, inputs->vm, &traj_len);
if (!trajectory || traj_len < 2) {
outputs->early_exited = 1;
if (trajectory) free(trajectory);
return;
}
/* === PHASE 2A: ANOVA Early-Exit Check (using actual heat samples) === */
q48_16_t current_variance = compute_variance_q48(trajectory, traj_len);
if (has_variance_stabilized(current_variance, outputs->window_variance_q48)) {
outputs->early_exited = 1;
free(trajectory);
return;
}
/* === PHASE 2C: Window Width Inference === */
/* L8 FINAL INTEGRATION: Loop #5 runtime-gated by Jacquard mode selector */
uint32_t inferred_width = outputs->adaptive_window_width; /* Keep previous value as default */
if (inputs->vm && inputs->vm->ssm_config) {
ssm_config_t *config = (ssm_config_t*)inputs->vm->ssm_config;
if (config->L5_window_inference) {
/* L5 enabled - run inference */
inferred_width = find_variance_inflection(
trajectory,
traj_len,
current_variance
);
}
/* else: L5 disabled, keep previous adaptive_window_width */
} else {
/* No L8 config available - run inference (legacy mode) */
inferred_width = find_variance_inflection(
trajectory,
traj_len,
current_variance
);
}
/* === PHASE 2D: Decay Slope Inference === */
/* L8 FINAL INTEGRATION: Loop #6 runtime-gated by Jacquard mode selector */
uint64_t inferred_slope = outputs->adaptive_decay_slope; /* Keep previous value as default */
if (inputs->vm && inputs->vm->ssm_config) {
ssm_config_t *config = (ssm_config_t*)inputs->vm->ssm_config;
if (config->L6_decay_inference) {
/* L6 enabled - run inference */
inferred_slope = infer_decay_slope_q48(trajectory, traj_len);
}
/* else: L6 disabled, keep previous adaptive_decay_slope */
} else {
/* No L8 config available - run inference (legacy mode) */
inferred_slope = infer_decay_slope_q48(trajectory, traj_len);
}
/* === PHASE 2E: Diagnostics === */
uint64_t fit_quality = compute_fit_quality(trajectory, traj_len, inferred_slope);
/* === Update Outputs === */
outputs->adaptive_window_width = inferred_width;
outputs->adaptive_decay_slope = inferred_slope;
outputs->window_variance_q48 = current_variance;
outputs->slope_fit_quality_q48 = fit_quality;
outputs->early_exited = 0;
/* === Cleanup === */
free(trajectory);
}
/* ============================================================================
* Helper Functions: Logging & Validation
* ============================================================================
*/
/**
* @brief Format inference outputs as a human-readable string.
*
* Writes into a static 256-byte buffer — not thread-safe, for diagnostics only.
* Format: @c "window=N var=F slope=F quality=F (cached|full)".
*
* @param outputs Inference outputs to format (NULL produces @c "(null)")
* @return Pointer to a static string buffer
*/
const char* inference_outputs_to_string(const InferenceOutputs *outputs)
{
static char buf[256];
if (!outputs) {
snprintf(buf, sizeof(buf), "(null)");
return buf;
}
double var_dbl = q48_to_double(outputs->window_variance_q48);
double slope_dbl = q48_to_double(outputs->adaptive_decay_slope);
double quality_dbl = q48_to_double(outputs->slope_fit_quality_q48);
snprintf(buf, sizeof(buf),
"window=%u var=%.6f slope=%.6f quality=%.6f %s",
outputs->adaptive_window_width,
var_dbl,
slope_dbl,
quality_dbl,
outputs->early_exited ? "(cached)" : "(full)");
return buf;
}
/**
* @brief Validate inference outputs for sanity.
*
* Checks that @c adaptive_window_width is in
* [@c ADAPTIVE_MIN_WINDOW_SIZE, @c ROLLING_WINDOW_SIZE], that
* @c adaptive_decay_slope is non-zero and <= 100.0 in Q48.16, and that
* @c slope_fit_quality_q48 is in [0.0, 1.0].
*
* @param outputs Inference outputs to validate (NULL returns 0)
* @return 1 if all fields are within acceptable ranges, 0 otherwise
*/
int inference_outputs_validate(const InferenceOutputs *outputs)
{
if (!outputs) {
return 0;
}
/* Check window width is reasonable */
#ifndef ADAPTIVE_MIN_WINDOW_SIZE
#define ADAPTIVE_MIN_WINDOW_SIZE 256
#endif
#ifndef ROLLING_WINDOW_SIZE
#define ROLLING_WINDOW_SIZE 4096
#endif
if (outputs->adaptive_window_width < ADAPTIVE_MIN_WINDOW_SIZE ||
outputs->adaptive_window_width > ROLLING_WINDOW_SIZE) {
return 0;
}
/* Check slope is positive and reasonable */
/* Typical range: 0.001 to 100.0 in Q48.16 */
if (outputs->adaptive_decay_slope == 0 ||
outputs->adaptive_decay_slope > q48_from_u64(100)) {
return 0;
}
/* Check fit quality is between 0.0 and 1.0 */
if (outputs->slope_fit_quality_q48 > q48_from_u64(1)) {
return 0;
}
return 1;
}
v3/src/io.c
+104
View File
@@ -0,0 +1,104 @@
/*
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.
*/
#include "io.h"
#include "log.h"
#include <string.h>
/** @} */
/**
* @brief Initialize the IO subsystem
* @param vm Pointer to VM instance
*
* Initializes the block device view over the unified VM memory.
* Zeros out the entire VM memory space.
*/
void io_init(VM *vm) {
if (!vm || !vm->memory) {
log_message(LOG_ERROR, "io_init: VM or VM memory not initialized");
return;
}
/* Zero the entire VM address space so blocks start clean. */
memset(vm->memory, 0, VM_MEMORY_SIZE);
log_message(LOG_INFO,
"IO subsystem initialized with %d blocks of %d bytes",
(int) MAX_BLOCKS, (int) BLOCK_SIZE);
}
/*
* @brief Write a block to VM memory
* @param vm Pointer to VM instance
* @param block_num Block number to write (0 to MAX_BLOCKS-1)
* @param buffer Source buffer containing block data
* @return 0 on success, -1 on error
*/
/**
* @brief Write a block to VM memory
* @param vm Pointer to VM instance
* @param block_num Block number to write (0 to MAX_BLOCKS-1)
* @param buffer Source buffer containing block data
* @return 0 on success, -1 on error
*
* Writes a BLOCK_SIZE chunk of data from the provided buffer into the VM's memory
* at the specified block number offset. The block number must be within valid range.
* The entire block is written atomically.
*
* @note The buffer must contain at least BLOCK_SIZE bytes of valid data
*/
int io_write_block(VM *vm, int block_num, const unsigned char *buffer) {
if (!vm || !vm->memory || !buffer) {
log_message(LOG_ERROR, "io_write_block: bad args");
return -1;
}
if (block_num < 0 || block_num >= (int) MAX_BLOCKS) {
log_message(LOG_ERROR, "io_write_block: invalid block number %d", block_num);
return -1;
}
size_t off = (size_t) block_num * (size_t) BLOCK_SIZE;
memcpy(&vm->memory[off], buffer, BLOCK_SIZE);
log_message(LOG_DEBUG, "io_write_block: wrote block %d", block_num);
return 0;
}
v3/src/log.c
+198
View File
@@ -0,0 +1,198 @@
/*
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.
*/
#include "../include/log.h"
#include "../include/platform_time.h"
#include <stdio.h>
#include <stdarg.h>
#include <time.h>
/* Current log level (default to LOG_INFO) */
static LogLevel current_level = LOG_INFO;
/* Log level names */
static const char *level_names[] = {
"ERROR",
"WARN",
"INFO",
"TEST",
"DEBUG"
};
/* ANSI color codes for each log level - only used outside minimal mode;
* MINIMAL builds never read these (both use sites are #ifndef-guarded
* below), so no empty-string fallback definitions are needed. */
#ifndef STARFORTH_MINIMAL
static const char *level_colors[] = {
"\x1b[31m", // ERROR - Red
"\x1b[33m", // WARN - Yellow
"\x1b[32m", // INFO - Green
"\x1b[35m", // TEST - Magenta
"\x1b[34m" // DEBUG - Blue
};
/* Test result colors */
static const char *test_pass_color = "\x1b[32m"; // Green
static const char *test_fail_color = "\x1b[31m"; // Red
static const char *test_skip_color = "\x1b[33m"; // Yellow
/* Reset color */
static const char *color_reset = "\x1b[0m";
#endif
/* Set global log level */
/*
* @brief Sets the global logging level
*
* @param level The LogLevel to set as current logging level
*/
void log_set_level(LogLevel level) {
current_level = level;
}
/* Get current log level */
/**
* @brief Gets the current global logging level
*
* @return LogLevel Current logging level
*/
LogLevel log_get_level(void) {
return current_level;
}
/* Timestamp helper */
/**
* @brief Helper function to generate timestamp string
*
* @param buffer Output buffer for the timestamp string
* @param size Size of the output buffer
*/
static void get_timestamp(char *buffer, size_t size) {
/* Use platform abstraction for timestamps */
sf_time_ns_t now = sf_realtime_ns();
sf_format_timestamp(now, buffer, 1); /* 24-hour format */
}
/* Generic logger */
/*
* @brief Logs a message with the specified level and format
*
* @param level The LogLevel for this message
* @param fmt Printf-style format string
* @param ... Variable arguments for format string
*/
void log_message(LogLevel level, const char *fmt, ...) {
/* LOG_NONE (-1) disables ALL logging */
if (current_level == LOG_NONE || level > current_level)
return;
char timestamp[16];
get_timestamp(timestamp, sizeof(timestamp));
#ifndef STARFORTH_MINIMAL
fprintf(stderr, "%s[%s] %s: %s", level_colors[level], timestamp, level_names[level], color_reset);
#else
fprintf(stderr, "[%s] %s: ", timestamp, level_names[level]);
#endif
va_list args;
va_start(args, fmt);
vfprintf(stderr, fmt, args);
va_end(args);
fprintf(stderr, "\n");
}
/* Dedicated test result logger (only shown for LOG_TEST or higher) */
/*
* @brief Logs test results_run_01_2025_12_08 with appropriate formatting and colors
*
* @param word_name Name of the word being tested
* @param result Test result (PASS/FAIL/SKIP)
*/
void log_test_result(const char *word_name, TestResult result) {
if (current_level == LOG_NONE || current_level < LOG_TEST)
return;
char timestamp[16];
get_timestamp(timestamp, sizeof(timestamp));
#ifndef STARFORTH_MINIMAL
const char *color;
#endif
const char *status;
switch (result) {
case TEST_PASS:
#ifndef STARFORTH_MINIMAL
color = test_pass_color;
#endif
status = "PASS";
break;
case TEST_FAIL:
#ifndef STARFORTH_MINIMAL
color = test_fail_color;
#endif
status = "FAIL";
break;
case TEST_SKIP:
#ifndef STARFORTH_MINIMAL
color = test_skip_color;
#endif
status = "SKIP";
break;
default:
#ifndef STARFORTH_MINIMAL
color = color_reset;
#endif
status = "????";
break;
}
#ifndef STARFORTH_MINIMAL
fprintf(stderr, "\x1b[35m[%s] TEST: %sTesting %-12s ... %s%s%s\n",
timestamp, color_reset, word_name, color, status, color_reset);
#else
fprintf(stderr, "[%s] TEST: Testing %-12s ... %s\n",
timestamp, word_name, status);
#endif
}
v3/src/main.c
+563
View File
@@ -0,0 +1,563 @@
/*
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.
*/
#include "vm.h"
#include "vm_debug.h"
#include "log.h"
#include "profiler.h"
#include "physics_runtime.h"
#include "platform_time.h"
#include "version.h"
#include "cli.h"
#include "block_subsystem.h"
#include "test_runner/include/test_runner.h"
#include "test_runner/include/test_common.h" /* brings in extern int fail_fast; */
#include "doe_metrics.h"
#include "blkio.h"
#include "blkio_factory.h"
#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#include <signal.h>
#include <ctype.h>
#include <stdint.h>
#ifdef __unix__
#include <sys/mman.h>
#include <unistd.h>
#ifndef MAP_ANONYMOUS
#define MAP_ANONYMOUS MAP_ANON
#endif
#endif
#ifndef BLKIO_FORTH_BLOCK_SIZE
#define BLKIO_FORTH_BLOCK_SIZE 1024u
#endif
#ifndef STARFORTH_STATE_BYTES
#define STARFORTH_STATE_BYTES 8192u
#endif
/* Optional hook (weak): if your block layer exposes an attach function, we call it. */
#if defined(__GNUC__) || defined(__clang__)
__attribute__ ((weak))
#endif
void blk_layer_attach_device(blkio_dev_t * dev);
/* Global VM pointer for cleanup */
static VM* global_vm = NULL;
/* Global blkio device + RAM backing (for cleanup) */
static blkio_dev_t g_blkio = {0};
static int g_blkio_opened = 0;
static uint8_t* g_ram_base = NULL;
static size_t g_ram_bytes = 0;
static int g_ram_is_mmap = 0;
/* Cleanup function for atexit() and signal handlers */
static void cleanup_blkio(void)
{
if (g_blkio_opened)
{
blkio_flush(&g_blkio);
blkio_close(&g_blkio);
g_blkio_opened = 0;
}
#ifdef __unix__
if (g_ram_base)
{
if (g_ram_is_mmap) munmap(g_ram_base, g_ram_bytes);
else free(g_ram_base);
g_ram_base = NULL;
g_ram_bytes = 0;
g_ram_is_mmap = 0;
}
#else
if (g_ram_base)
{
free(g_ram_base);
g_ram_base = NULL;
g_ram_bytes = 0;
}
#endif
}
/**
* @brief Performs cleanup operations before program termination
*/
void cleanup_and_exit(void)
{
/* close blkio & free RAM before VM */
cleanup_blkio();
physics_runtime_shutdown();
if (global_vm != NULL)
{
vm_cleanup(global_vm);
global_vm = NULL;
}
}
/* Signal handler for CTRL-C (SIGINT) and SIGTERM */
void signal_handler(int sig)
{
switch (sig)
{
case SIGINT: printf("\nInterrupted! Cleaning up...\n");
break;
case SIGTERM: printf("\nTerminating! Cleaning up...\n");
break;
default: break;
}
cleanup_and_exit();
exit(0);
}
/**
* @brief Prints program usage information
* @param program_name Name of the executable
*/
void print_usage(const char* program_name)
{
printf("Usage: %s [OPTIONS]\n", program_name);
printf("StarForth - A lightweight Forth virtual machine\n\n");
printf("Options:\n");
printf(" --stress-tests Run stress tests (deep nesting, stack exhaustion, large definitions)\n");
printf(" --integration Run integration tests (complete Forth programs)\n");
printf(" --break-me 🔥 ULTRA-COMPREHENSIVE diagnostic mode - tests EVERYTHING,\n");
printf(" generates detailed markdown report, includes easter egg surprise!\n");
printf(" --benchmark [N] Run performance benchmarks (default: 1000 iterations)\n");
printf(" (exits after benchmarking, does not start REPL)\n");
printf(" --log-error Set logging level to ERROR (only errors)\n");
printf(" --log-warn Set logging level to WARN (warnings and errors)\n");
printf(" --log-info Set logging level to INFO (default)\n");
printf(" --log-test Set logging level to TEST (test results only)\n");
printf(" --log-debug Set logging level to DEBUG (all messages)\n");
printf(" --log-none Disable all logging (maximum performance)\n");
printf(" --fail-fast Stop test suite immediately on first failure\n");
printf(" --profile [0-3] Enable profiler: 1=basic, 2=detailed, 3=full\n");
printf(" --profile-report Emit profiler report on exit\n");
printf(" --disk-img=<path> Use raw disk image file at <path>\n");
printf(" --disk-ro Open disk image read-only\n");
printf(" --ram-disk=<MB> RAM fallback size if no --disk-img (default: 1 MB)\n");
printf(" --fbs=<bytes> Forth block size (default: 1024)\n");
printf(" --version, -v Show version information and exit\n");
printf(" --help, -h Show this help message\n\n");
printf("Tests are executed automatically before the REPL starts.\n\n");
printf("Examples:\n");
printf(" %s # Start REPL with INFO logging\n", program_name);
printf(" %s --benchmark # Run benchmarks with 1000 iterations\n", program_name);
printf(" %s --benchmark 5000 # Run benchmarks with 5000 iterations\n", program_name);
printf(" %s --disk-img=./disks/starship.img # Use disk image\n", program_name);
printf(" %s --ram-disk=64 --fbs=1024 # 64 MB RAM fallback\n", program_name);
}
/* ============================================================================
* STATIC HELPER FUNCTIONS
* ============================================================================ */
/**
* @brief Initialize block I/O from CLI configuration
*/
static int init_blkio(const CLIConfig* config)
{
const int requested_file = (config->disk_img_path && *config->disk_img_path) ? 1 : 0;
int using_file = requested_file;
/* Verify file accessibility if requested */
if (requested_file)
{
FILE* chk = fopen(config->disk_img_path, "rb");
if (!chk)
{
log_message(LOG_WARN,
"Disk image '%s' not found or not accessible; falling back to RAM disk",
config->disk_img_path);
using_file = 0;
}
else
{
fclose(chk);
}
}
/* Compute RAM geometry (FBS fixed at 1024 bytes) */
uint64_t ram_bytes_u64 = (uint64_t)config->ram_disk_mb * 1024ull * 1024ull;
uint32_t fbs = BLKIO_FORTH_BLOCK_SIZE;
uint32_t ram_blocks = (uint32_t)(ram_bytes_u64 / (uint64_t)fbs);
g_ram_bytes = (size_t)ram_blocks * (size_t)fbs;
/* Allocate RAM backing if not using file */
if (!using_file)
{
if (g_ram_bytes == 0)
{
g_ram_bytes = (size_t)fbs;
}
#ifdef __unix__
void* p = mmap(NULL, g_ram_bytes, PROT_READ | PROT_WRITE,
MAP_PRIVATE | MAP_ANONYMOUS
#ifdef MAP_NORESERVE
| MAP_NORESERVE
#endif
, -1, 0);
if (p != MAP_FAILED)
{
g_ram_is_mmap = 1;
g_ram_base = (uint8_t*)p;
}
#endif
if (!g_ram_base)
{
g_ram_base = (uint8_t*)malloc(g_ram_bytes);
if (!g_ram_base)
{
fprintf(stderr, "Failed to allocate RAM-disk (%zu bytes)\n", g_ram_bytes);
return 1;
}
}
}
/* Open block device */
static uint8_t state_buf[STARFORTH_STATE_BYTES];
uint8_t used_file = 0;
const uint32_t total_blocks_hint = 0;
int rc = blkio_factory_open(&g_blkio,
using_file ? config->disk_img_path : NULL,
0, /* disk_read_only: always false */
total_blocks_hint,
fbs,
state_buf, sizeof(state_buf),
g_ram_base,
(uint32_t)(g_ram_bytes / (size_t)fbs),
&used_file);
if (rc != BLKIO_OK)
{
if (using_file)
fprintf(stderr, "Failed to open disk image '%s' (rc=%d)\n", config->disk_img_path, rc);
else
fprintf(stderr, "Failed to initialize RAM backend (rc=%d)\n", rc);
return 1;
}
g_blkio_opened = 1;
/* Log geometry */
blkio_info_t info = {0};
if (blkio_info(&g_blkio, &info) == BLKIO_OK)
{
log_message(LOG_INFO,
"blkio: backend=%s fbs=%u blocks=%u size=%lluB ro=%u",
used_file ? "FILE" : "RAM",
(unsigned)info.forth_block_size,
(unsigned)info.total_blocks,
(unsigned long long)info.phys_size_bytes,
(unsigned)info.read_only);
}
return 0;
}
/**
* @brief Initialize VM core and block subsystem
*/
static int init_vm_and_subsystem(VM* vm)
{
/* Initialize VM */
vm_init(vm);
setvbuf(stdout, NULL, _IOFBF, 1 << 16);
if (vm->error)
{
fprintf(stderr, "Failed to initialize VM\n");
return 1;
}
/* Initialize block subsystem */
extern int blk_subsys_init(VM* vm, uint8_t* ram_base, size_t ram_size);
static uint8_t blk_ram[BLK_RAM_BLOCKS * BLK_FORTH_SIZE];
int rc = blk_subsys_init(vm, blk_ram, sizeof(blk_ram));
if (rc != 0)
{
fprintf(stderr, "Failed to initialize block subsystem (rc=%d)\n", rc);
return 1;
}
/* Attach blkio device */
if (g_blkio_opened && blk_layer_attach_device)
{
blk_layer_attach_device(&g_blkio);
}
return 0;
}
/**
* @brief Run benchmark mode and exit
*/
static void run_benchmark_mode(VM* vm, const CLIConfig* config)
{
log_message(LOG_INFO, "==============================================");
log_message(LOG_INFO, " StarForth Performance Benchmark Suite");
log_message(LOG_INFO, "==============================================\n");
/* run_compute_benchmarks(vm); */
log_message(LOG_INFO, "\n==============================================");
log_message(LOG_INFO, " Full Test Suite Benchmark");
log_message(LOG_INFO, " (Running %d iterations per module)", config->benchmark_iterations);
log_message(LOG_INFO, "==============================================\n");
enable_benchmark_mode(config->benchmark_iterations);
run_all_tests(vm);
}
/**
* @brief Run optional test modes after system initialization
*/
static void run_optional_tests(VM* vm, const CLIConfig* config)
{
if (config->break_me)
{
run_break_me_tests(vm);
}
}
/**
* @brief Run Design of Experiments experiment
*
* Executes the full test harness N times, collecting metrics after each run.
* Writes results to CSV file for statistical analysis.
*/
static void run_doe_experiment(VM* vm)
{
/* Reset statistics for clean start */
vm_interpret(vm, "PHYSICS-RESET-STATS");
/* Capture CPU state before run */
/* HISTORICAL: this TODO asked about l4re/POSIX separation of concern
* for these metrics -- moot now that L4Re has been removed as an
* active target; POSIX is the only path. */
int32_t cpu_temp_before = metrics_get_cpu_temp_c();
int32_t cpu_freq_before = metrics_get_cpu_freq_mhz();
/* Capture monotonic time before workload */
sf_time_ns_t workload_start_ns = sf_monotonic_ns();
/* Run test harness once (all 936+ tests) */
run_all_tests(vm);
/* Capture monotonic time after workload */
sf_time_ns_t workload_end_ns = sf_monotonic_ns();
/* Calculate actual VM workload execution time in nanoseconds */
uint64_t workload_duration_ns = workload_end_ns - workload_start_ns;
/* Capture CPU state after run */
int32_t cpu_temp_after = metrics_get_cpu_temp_c();
int32_t cpu_freq_after = metrics_get_cpu_freq_mhz();
/* Calculate deltas and convert to Q48.16 */
int32_t cpu_temp_delta = cpu_temp_after - cpu_temp_before;
int32_t cpu_freq_delta = cpu_freq_after - cpu_freq_before;
/* DEBUG: Log final rolling window state before metrics extraction */
log_message(LOG_INFO, "DoE FINAL STATE: rolling_window.total_executions=%lu, is_warm=%d, effective_window_size=%u",
vm->rolling_window.total_executions,
vm->rolling_window.is_warm,
vm->rolling_window.effective_window_size);
/* Extract metrics from VM with deltas */
DoeMetrics metrics = metrics_from_vm(vm, workload_duration_ns,
cpu_temp_delta, cpu_freq_delta);
/* CSV output suppressed - metrics collected but not printed to stdout.
* Rationale: DoE experiments now rely on internal VM metrics and test output only.
* The CSV row is redundant and interferes with clean test harness output.
* If CSV export is needed in the future, consider writing to a file instead
* of stdout, or add a --csv-export flag. */
/* metrics_write_csv_row(stdout, &metrics); */
(void)metrics; /* Suppress unused variable warning */
}
/* ============================================================================
* MAIN ENTRY POINT
* ============================================================================ */
/**
* @brief Main entry point for StarForth
*/
int main(int argc, char* argv[])
{
/* Parse command line arguments */
CLIConfig config = cli_parse(argc, argv);
/* Initialize platform time subsystem FIRST */
sf_time_init();
/* Register cleanup function and signal handlers */
atexit(cleanup_and_exit);
signal(SIGINT, signal_handler); /* CTRL-C */
signal(SIGTERM, signal_handler); /* Termination */
/* DoE mode: force LOG_NONE immediately to suppress all output except CSV */
if (config.doe_experiment)
{
config.log_level = LOG_NONE;
}
/* Initialize logging and profiling */
if (config.run_tests_flag_observed && !config.log_level_explicitly_set && !config.benchmark && !config.doe_experiment)
{
config.log_level = LOG_TEST;
}
log_set_level(config.log_level);
if (physics_runtime_init(0) != 0)
{
log_message(LOG_WARN, "Physics runtime failed to allocate analytics heap; proceeding degraded");
}
if (config.run_tests_flag_observed)
{
log_message(LOG_WARN, "--run-tests flag is obsolete; tests now run automatically.");
if (!config.log_level_explicitly_set && !config.benchmark)
{
log_message(LOG_INFO, "Test mode enabled - using LOG_TEST level for diagnostics");
}
}
/* Initialize block I/O device */
if (init_blkio(&config) != 0)
{
cleanup_and_exit();
return 1;
}
/* Initialize VM and block subsystem */
VM vm = {0};
global_vm = &vm;
if (init_vm_and_subsystem(&vm) != 0)
{
cleanup_and_exit();
return 1;
}
/* Register VM lifecycle words (BIRTH KILL PAUSE RESUME USE) */
extern void register_lifecycle_words(VM *vm);
register_lifecycle_words(&vm);
/* Install VM debug hooks */
vm_debug_set_current_vm(&vm);
vm_debug_install_signal_handlers();
/* Handle DoE experiment mode (exits after) */
if (config.doe_experiment)
{
/* Force LOG_NONE so only CSV goes to stdout */
log_set_level(LOG_NONE);
/* Run DoE experiment - returns non-zero on runtime failure */
run_doe_experiment(&vm);
/* Check for VM errors (runtime instability) */
if (vm.error)
{
cleanup_and_exit();
return 2; /* Runtime failure */
}
cleanup_and_exit();
return 0; /* Success */
}
/* Handle benchmark mode (exits after) */
if (config.benchmark)
{
run_benchmark_mode(&vm, &config);
cleanup_and_exit();
return 0;
}
/* Apply global fail-fast flag to test framework */
if (config.fail_fast)
{
fail_fast = 1;
}
/* Protect foundational words from FORGET */
vm.dict_fence_latest = vm.latest;
vm.dict_fence_here = vm.here;
log_message(LOG_INFO, "Dictionary fence set - init words protected from FORGET");
/* Run optional test modes */
run_optional_tests(&vm, &config);
/* Start REPL unless --break-me was specified */
if (!config.break_me)
{
/* Always run the full test suite immediately prior to REPL */
log_message(LOG_INFO, "Running comprehensive test suite...");
run_all_tests(&vm);
log_message(LOG_INFO, "Test run complete.");
/* Run system initialization AFTER POST completes */
log_message(LOG_INFO, "Running system initialization (INIT)...");
vm_interpret(&vm, "INIT");
if (vm.error)
{
log_message(LOG_ERROR, "System initialization failed - cannot continue");
cleanup_and_exit();
return 1;
}
log_message(LOG_INFO, "System initialization complete.");
vm_repl(&vm, config.script_mode);
}
cleanup_and_exit();
return 0;
}
v3/src/math_portable.c
+263
View File
@@ -0,0 +1,263 @@
/*
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.
*/
/*
* math_portable.c
*
* Pure 64-bit fixed-point Q48.16 math functions.
* Suitable for embedded environments with no libm or floating-point
* (HISTORICAL: also L4Re, through mid-2026; removed as an active target).
* All arithmetic is integer-only for maximum production performance.
*
* Q48.16 Format:
* - 48-bit signed integer + 16-bit fractional part
* - 1.0 = 65536 (2^16)
* - Precision: 2^-16 ≈ 0.0000153
* - Range: ±140 trillion
*/
#include <stdint.h>
#include "math_portable.h"
/**
* @brief Compute exp(@p x) via Taylor series in Q48.16 fixed-point.
*
* Evaluates the classic Taylor expansion:
* @code
* exp(x) = 1 + x + x²/2! + x³/3! + … (up to 40 terms)
* @endcode
* entirely in 64-bit integer arithmetic using the Q48.16 representation
* (1.0 = 65536 = 2^16).
*
* The function is intentionally scoped to the range the physics engine
* actually uses — the argument to @c erf_q48() is @c -x² times a ratio
* near 1, yielding values in roughly the @c [-20, 0] interval. Outside
* this range the implementation provides coarse-grained clamping:
* - @p x == 0 → returns @c Q48 (1.0 exactly)
* - @p x > 20.0 → saturates at @c Q48 << 8 (approx e^20, avoids overflow)
* - @p x < -100.0 → underflows to 0 (result is negligible)
*
* The term loop exits early on the first term smaller than 1 ULP (the
* series has converged) and guards against intermediate overflow by
* clamping @c result at @c INT64_MAX-1.
*
* @note This is a file-local (@c static) helper; callers are
* @c erf_q48() only.
*
* @param x Input value in Q48.16 format (1.0 = 65536). Intended range:
* approximately [-100×65536, +20×65536].
* @return exp(@p x) in Q48.16 format; 0 on underflow; saturated at
* @c INT64_MAX-1 on overflow.
*/
static int64_t exp_q48(int64_t x) {
const int64_t Q48 = 65536LL; /* 2^16 */
/* Handle extremes */
if (x == 0) return Q48;
if (x > (20LL << 16)) return Q48 << 8; /* Approximate e^20 */
if (x < -(100LL << 16)) return 0; /* Underflow to zero */
/* Taylor series: exp(x) = Σ x^n / n! (in fixed-point) */
int64_t result = Q48; /* Start with 1 */
int64_t term = Q48;
int64_t x_power = x; /* x^1 */
for (int i = 1; i < 40; i++) {
/* term = x^i / i! */
term = (x_power / (int64_t)i) / Q48; /* Scale down to avoid overflow */
if (term > -1 && term < 1) break; /* Negligible */
result += term;
x_power = (x_power * x) / Q48; /* Keep x^n scaled */
/* Guard against overflow */
if (result < 0 && result < (1LL << 62)) break;
if (result > 0 && result > (1LL << 62)) {
result = 9223372036854775806LL; /* Saturate at INT64_MAX-1 */
break;
}
}
return result;
}
/**
* @brief Compute sqrt(@p x) via Newton-Raphson in Q48.16 fixed-point.
*
* Applies the Newton-Raphson recurrence:
* @code
* r_{n+1} = (r_n² + x) / (2 × r_n)
* @endcode
* for up to 20 iterations, with all arithmetic scaled to the Q48.16
* representation (1.0 = 65536). Intermediate products use 8-bit right
* shifts on both operands before squaring to prevent 64-bit overflow:
* @code
* guess_squared = (guess >> 8) * (guess >> 8)
* @endcode
* This sacrifices 16 bits of precision in the squared term, which is
* acceptable because the division by @c 2*guess restores the correct
* order of magnitude. Convergence is declared when successive iterates
* differ by at most 1 in Q48.16 units (sub-nanosecond for timing uses).
*
* Special cases handled without iteration:
* - @p x ≤ 0 → returns 0 (no imaginary results)
* - @p x == 65536 (1.0) → returns 65536 exactly
*
* Initial guess: @c x/2 for @p x > 1.0, else @c 1.0. Values above 1.0
* converge from above; values in (0, 1.0) converge from the 1.0 initial
* guess.
*
* @param x Non-negative value in Q48.16 format (1.0 = 65536).
* Negative values are treated as zero.
* @return sqrt(@p x) in Q48.16 format; 0 for @p x ≤ 0.
*/
int64_t sqrt_q48(int64_t x) {
const int64_t Q48 = 65536LL;
/* Handle special cases */
if (x < 0) return 0;
if (x == 0) return 0;
if (x == Q48) return Q48; /* sqrt(1.0) = 1.0 */
/* Initial guess: average of x and 1 */
int64_t guess = (x > Q48) ? (x >> 1) : Q48;
/* Newton-Raphson iterations */
for (int i = 0; i < 20; i++) {
/* next = (guess^2 + x) / (2 * guess)
* In Q48.16: (guess^2) >> 16 + x, then divide by 2*guess
*/
int64_t guess_squared = (guess >> 8) * (guess >> 8); /* Avoid overflow */
int64_t next = (guess_squared + (x >> 16)) / (2 * guess);
/* Check convergence */
int64_t diff = next - guess;
if (diff > -2 && diff < 2) return next;
guess = next;
}
return guess;
}
/**
* @brief Compute erf(@p x) via Abramowitz & Stegun 7.1.26 in Q48.16 fixed-point.
*
* Implements the rational approximation from Abramowitz & Stegun, formula 7.1.26:
* @code
* erf(x) ≈ sign(x) × sqrt(1 − exp(−x² × (4/π + a·x²) / (1 + a·x²)))
* @endcode
* where @c a ≈ 0.147 (in Q48.16: 9633). The maximum error of the true
* mathematical approximation is @c |ε| < 1.5×10⁻⁷; the fixed-point
* encoding introduces additional rounding of approximately 1 ULP in Q48.16.
*
* All arithmetic is performed in 64-bit integer Q48.16 format — no
* floating-point operations. The computation sequence:
* 1. Extract sign; work with @c |x|.
* 2. Compute @c x² with 8-bit prescaling to prevent overflow:
* @c x_sq = (x >> 8) * (x >> 8).
* 3. Evaluate the A&S numerator @c (4/π + a·x²) and denominator @c (1 + a·x²).
* 4. Compute @c ratio = numerator / denominator (shift to preserve Q48.16 scale).
* 5. Compute @c exp_arg = −x² × ratio and evaluate @c exp_q48(exp_arg).
* 6. Compute @c base = 1 − exp_val, clamp to [0, 1].
* 7. Return @c sign × sqrt_q48(base).
*
* Q48.16 constants used:
* - @c a_q48 = 9633 (0.147 × 65536)
* - @c four_over_pi_q48 = 83328 (4/π × 65536 ≈ 1.2732 × 65536)
*
* Consumed by @c hotwords_speedup_estimate() to compute P(speedup > 1.1×)
* and P(speedup > 2.0×) via the normal CDF identity:
* @code
* P(Z ≤ z) = 0.5 × (1 + erf(z / √2))
* @endcode
* where @c √2 in Q48.16 = 92681.
*
* @param x Input value in Q48.16 format (dimensionless Z-score;
* 1.0 = 65536). May be negative; sign determines the sign
* of the result.
* @return erf(@p x) in Q48.16 format, in the range [−65536, +65536]
* corresponding to (−1.0, +1.0).
*/
int64_t erf_q48(int64_t x) {
const int64_t Q48 = 65536LL;
if (x == 0) return 0;
/* Compute sign and work with absolute value */
int sign = (x < 0) ? -1 : 1;
if (x < 0) x = -x;
/* Abramowitz & Stegun coefficient a ≈ 0.147 (in Q48.16) */
const int64_t a_q48 = 9633LL; /* 0.147 * 65536 */
const int64_t four_over_pi_q48 = 83328LL; /* 4/π * 65536 */
/* Compute x^2 in Q48.16 */
int64_t x_sq = (x >> 8) * (x >> 8); /* Scaled to avoid overflow */
/* Compute denominator: 1 + a*x^2 */
int64_t denom = Q48 + ((a_q48 * x_sq) >> 16);
if (denom == 0) denom = 1; /* Guard divide-by-zero */
/* Compute numerator: 4/π + a*x^2 */
int64_t numer = four_over_pi_q48 + ((a_q48 * x_sq) >> 16);
/* Compute ratio = numerator / denominator */
int64_t ratio = (numer << 16) / denom;
/* Compute exp argument: -x^2 * ratio */
int64_t exp_arg = -(x_sq * ratio / Q48);
/* Compute exp(-x^2 * ratio) */
int64_t exp_val = exp_q48(exp_arg);
/* Compute base: 1 - exp(exp_arg) */
int64_t base = Q48 - exp_val;
if (base < 0) base = 0;
if (base > Q48) base = Q48;
/* Compute sqrt(base) */
int64_t sqrt_base = sqrt_q48(base);
/* Apply sign and return */
return sign * sqrt_base;
}
v3/src/memory_management.c
+140
View File
@@ -0,0 +1,140 @@
/*
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.
*/
#include "../include/vm.h"
#include "../include/log.h"
/**
* @brief Allocates memory from the VM's dictionary space
* @param vm Pointer to the VM instance
* @param bytes Number of bytes to allocate
* @return Pointer to the allocated memory or NULL if allocation fails
* @note The allocation is done from the VM's dictionary space which is limited to DICTIONARY_MEMORY_SIZE
*/
void *vm_allot(VM *vm, size_t bytes) {
if (!vm || !vm->memory) {
log_message(LOG_ERROR, "vm_allot: VM or memory is NULL");
return NULL;
}
/* 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);
if (vm->here + bytes >= DICTIONARY_MEMORY_SIZE) {
log_message(LOG_ERROR, "Dictionary space full (here=%zu, bytes=%zu, dict_limit=%d)",
vm->here, bytes, DICTIONARY_MEMORY_SIZE);
vm->error = 1;
return NULL;
}
void *ptr = vm->memory + vm->here;
vm->here += bytes;
/* Log which block we're using */
int current_block = vm->here / BLOCK_SIZE;
log_message(LOG_DEBUG, "ALLOT: Allocated %zu bytes at offset %zu (block %d)",
bytes, vm->here - bytes, current_block);
return ptr;
}
/**
* @brief Aligns the VM's dictionary pointer (here) to the cell boundary
* @param vm Pointer to the VM instance
* @note Adds padding bytes if necessary to ensure proper alignment for cell_t type
*/
void vm_align(VM *vm) {
size_t align = sizeof(cell_t);
size_t misalignment = vm->here % align;
if (misalignment != 0) {
size_t padding = align - misalignment;
void *pad = vm_allot(vm, padding);
if (pad == NULL) {
log_message(LOG_ERROR, "vm_align: Out of memory while aligning");
vm->error = 1;
return;
}
/* Optional: zero out the padding */
unsigned char *bytes = (unsigned char *) pad;
for (size_t i = 0; i < padding; ++i) {
bytes[i] = 0;
}
log_message(LOG_DEBUG, "vm_align: Added %zu byte(s) of padding", padding);
}
}
/**
* @brief Gets the memory address for a specified block number
* @param vm Pointer to the VM instance
* @param block_num Block number to get the address for
* @return Pointer to the start of the block or NULL if block number is invalid
* @note Blocks are fixed-size memory regions of BLOCK_SIZE bytes
*/
void *vm_get_block_addr(VM *vm, int block_num) {
if (block_num < 0 || block_num >= MAX_BLOCKS) {
log_message(LOG_ERROR, "vm_get_block_addr: Invalid block number %d", block_num);
return NULL;
}
return vm->memory + (block_num * BLOCK_SIZE);
}
/* Convert address to block number */
/**
* @brief Converts a memory address to its corresponding block number
* @param vm Pointer to the VM instance
* @param addr Memory address to convert
* @return Block number (0 to MAX_BLOCKS-1) or -1 if address is outside VM memory
* @note Used for determining which block a memory address belongs to
*/
int vm_addr_to_block(VM *vm, void *addr) {
if (addr < (void *) vm->memory ||
addr >= (void *) (vm->memory + VM_MEMORY_SIZE)) {
return -1; /* Outside VM memory */
}
uintptr_t offset = (uintptr_t) addr - (uintptr_t) vm->memory;
return (int) (offset / BLOCK_SIZE);
}
v3/src/physics_execution_hooks.c
+223
View File
@@ -0,0 +1,223 @@
/*
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.
*/
/*
* physics_execution_hooks.c - All physics machinery in one place
*
* This file absorbs ALL the physics-related code that was scattered
* throughout execute_colon_word and vm_interpret_word.
*
* The VM execution loop is now clean; this file is where physics lives.
*/
#include "../include/physics_execution_hooks.h"
#include "../include/platform_time.h"
#include "../include/profiler.h"
#include "../include/physics_metadata.h"
#include "../include/physics_hotwords_cache.h"
#include "../include/physics_pipelining_metrics.h"
#include "../include/rolling_window_of_truth.h"
#include "../include/ssm_jacquard.h"
/**
* @brief Pre-execution physics hook — called before every word dispatch.
*
* Consolidates all physics work that must happen before a word runs:
* - Loop #3: applies linear decay based on elapsed time since last execution
* - Loop #1: increments @c execution_heat for the word
* - Loop #2: records the word-id into the rolling window of truth
* - Loop #4: detects a pipelining prefetch hit (if @c prev's speculation
* matched @c word), records the transition from @c prev to @c word,
* updates the probability cache, and issues a speculative hotwords
* cache promotion for the most likely next word
*
* @param vm Pointer to the VM structure
* @param word DictEntry being executed
* @param prev DictEntry executed immediately before @c word (may be NULL)
*/
void physics_pre_execute(VM* vm, DictEntry* word, DictEntry* prev)
{
if (!vm || !word) return;
uint64_t now_ns = sf_monotonic_ns();
/* Loop #3: Apply linear decay before accumulating new heat.
* Tick-based, not wall-clock -- see physics_metadata_apply_linear_decay(). */
uint64_t elapsed_ticks = vm->heartbeat.tick_count - word->physics.last_decay_tick;
physics_metadata_apply_linear_decay(word, elapsed_ticks, vm);
word->physics.last_decay_tick = vm->heartbeat.tick_count;
word->physics.last_active_ns = now_ns;
word->physics.last_decay_ns = now_ns;
/* Loop #1: Heat accumulation */
physics_execution_heat_increment(word);
uint32_t word_id = word->word_id;
if (word_id >= DICTIONARY_SIZE) return;
/* Loop #2: Rolling Window of Truth */
rolling_window_record_execution(&vm->rolling_window, word_id);
/* Loop #4: Pipelining Transition Metrics. ENABLE_PIPELINING is the
* compile-time ceiling; ssm_config's L4_pipelining is L8's live
* runtime toggle within that ceiling (see ssm_jacquard.h). */
{
ssm_config_t *ssm_cfg = (ssm_config_t*)vm->ssm_config;
if (!prev || !prev->transition_metrics || !ENABLE_PIPELINING ||
!ssm_cfg || !ssm_cfg->L4_pipelining) return;
}
/* Check if current word was speculatively promoted by previous word */
uint32_t prev_speculation_target = prev->transition_metrics->most_likely_next_word_id;
if (prev_speculation_target == word_id && prev->transition_metrics->prefetch_attempts > 0)
{
/* PREFETCH HIT: Current word matches previous word's speculation! */
transition_metrics_record_prefetch_hit(prev->transition_metrics, 0);
vm->pipeline_metrics.prefetch_hits++;
}
/* Record transition from previous word to current word */
transition_metrics_record(prev->transition_metrics, word_id, DICTIONARY_SIZE);
/* Update probability cache to find most likely next word */
transition_metrics_update_cache(prev->transition_metrics, DICTIONARY_SIZE);
uint32_t speculated_word_id = prev->transition_metrics->most_likely_next_word_id;
/* Speculative prefetch of most likely next word */
if (speculated_word_id < DICTIONARY_SIZE &&
transition_metrics_should_speculate(prev->transition_metrics, speculated_word_id))
{
DictEntry* spec_entry = vm_dictionary_lookup_by_word_id(vm, speculated_word_id);
/* ENABLE_HOTWORDS_CACHE is the compile-time ceiling; cache->enabled
* is L8's live runtime toggle within that ceiling, kept in sync
* with ssm_config's L1_heat_tracking wherever L8 applies a config
* (see vm_time.c / vm_runtime.c). */
if (spec_entry && vm->hotwords_cache && ENABLE_HOTWORDS_CACHE &&
vm->hotwords_cache->enabled)
{
spec_entry->execution_heat = HOTWORDS_EXECUTION_HEAT_THRESHOLD + 1;
hotwords_cache_promote(vm->hotwords_cache, spec_entry);
prev->transition_metrics->prefetch_attempts++;
vm->pipeline_metrics.prefetch_attempts++;
}
}
}
/**
* @brief Post-execution physics hook — called after every word dispatch.
*
* Consolidates all physics work that must happen after a word completes:
* - Updates physics metadata (@c temperature_q8, @c last_active_ns) via
* @c physics_metadata_touch()
* - Notifies the profiler (@c profiler_word_exit())
* - Increments @c vm->heartbeat.words_executed
* - When running without a background heartbeat thread, checks whether
* enough words have been executed to trigger a heartbeat cycle
* (@c vm_heartbeat_run_cycle())
*
* @param vm Pointer to the VM structure
* @param word DictEntry that just finished executing
*/
void physics_post_execute(VM* vm, DictEntry* word)
{
if (!vm || !word) return;
physics_metadata_touch(word, word->execution_heat, sf_monotonic_ns());
profiler_word_exit(word);
vm->heartbeat.words_executed++;
/* Heartbeat: Periodic time-driven tuning (Loop #3 & #5) */
if (!vm->heartbeat.worker && ++vm->heartbeat.check_counter >= HEARTBEAT_CHECK_FREQUENCY)
{
extern void vm_heartbeat_run_cycle(VM* vm);
vm_heartbeat_run_cycle(vm);
vm->heartbeat.check_counter = 0;
}
}
/**
* @brief Physics hook for the outer interpreter word-lookup path.
*
* Called when the outer interpreter successfully finds a word by name,
* before executing it. Applies linear decay and increments heat on both
* the found entry and the canonical entry (if different), and updates
* @c last_active_ns / @c last_decay_ns on both. Acquires @c vm->dict_lock
* for the entire operation to ensure thread safety.
*
* @param vm Pointer to the VM structure
* @param entry DictEntry found by name search
* @param canon Canonical DictEntry (may equal @c entry or be the smudge target)
*/
void physics_on_lookup(VM* vm, DictEntry* entry, DictEntry* canon)
{
if (!vm || !entry) return;
uint64_t lookup_ns = sf_monotonic_ns();
sf_mutex_lock(&vm->dict_lock);
/* Apply decay and heat to found entry. Tick-based, not wall-clock --
* see physics_metadata_apply_linear_decay(). */
uint64_t elapsed_entry_ticks = vm->heartbeat.tick_count - entry->physics.last_decay_tick;
physics_metadata_apply_linear_decay(entry, elapsed_entry_ticks, vm);
entry->physics.last_decay_tick = vm->heartbeat.tick_count;
entry->physics.last_active_ns = lookup_ns;
entry->physics.last_decay_ns = lookup_ns;
physics_execution_heat_increment(entry);
/* Also handle canonical entry if different */
if (canon && canon != entry)
{
uint64_t elapsed_canon_ticks = vm->heartbeat.tick_count - canon->physics.last_decay_tick;
physics_metadata_apply_linear_decay(canon, elapsed_canon_ticks, vm);
canon->physics.last_decay_tick = vm->heartbeat.tick_count;
canon->physics.last_active_ns = lookup_ns;
canon->physics.last_decay_ns = lookup_ns;
physics_execution_heat_increment(canon);
physics_metadata_touch(canon, canon->execution_heat, lookup_ns);
}
sf_mutex_unlock(&vm->dict_lock);
}
v3/src/physics_hotwords_cache.c
+991
View File
@@ -0,0 +1,991 @@
/*
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.
*/
/*
* physics_hotwords_cache.c
*
* Hot-words cache implementation
* Provides frequency-driven dictionary acceleration via LRU cache
*/
#include <stdio.h>
#include <string.h>
#include <stdlib.h>
#include "physics_hotwords_cache.h"
/* In kernel builds, suppress platform_time.h inline wrappers to avoid
* GOTPCREL relocations in PE binaries (no GOT in PE format). shim.c
* provides the concrete sf_monotonic_ns() symbol in that case.
* PLATFORM_TIME_NO_INLINE is also set globally via COMMON_CFLAGS in
* Makefile.starkernel; the #ifndef guard prevents -Wall -Werror redefinition. */
#ifdef __STARKERNEL__
#ifndef PLATFORM_TIME_NO_INLINE
#define PLATFORM_TIME_NO_INLINE
#endif
#endif /* __STARKERNEL__ */
#include "platform_time.h"
#include "math_portable.h"
/* ============================================================================
* Global Cache Instance
* ============================================================================
*/
/* Global hot-words cache for the VM (used by benchmark and diagnostic words) */
HotwordsCache g_hotwords_cache = {0};
/* Forward declarations for helper functions */
static inline double q48_to_ns_double(int64_t q48);
/* ============================================================================
* Cache Initialization
* ============================================================================
*/
/**
* @brief Initialise a @c HotwordsCache to its empty, enabled state.
*
* Zeroes all fields via @c memset then explicitly sets:
* - @c cache->enabled = @c ENABLE_HOTWORDS_CACHE (build-time compile flag;
* 0 disables the cache globally without a code change).
* - @c cache->cache_count = 0, @c cache->lru_index = 0 — empty round-robin
* eviction ring.
* - All counter fields in @c cache->stats to 0.
* - @c stats.min_cache_hit_ns = @c INT64_MAX, @c stats.max_cache_hit_ns =
* @c INT64_MIN (sentinel values; updated to real observations on the first
* cache hit).
* - @c stats.min_bucket_search_ns = @c INT64_MAX, @c stats.max_bucket_search_ns
* = @c INT64_MIN (same sentinel convention for bucket searches).
* - All Q48.16 variance accumulators to 0.
*
* Safe to call multiple times (idempotent via @c memset). Must be called
* before the first @c hotwords_cache_lookup() invocation; failure to do so
* leaves the sentinel min/max fields uninitialised, producing nonsense in the
* Bayesian posterior report.
*
* @param cache Cache to initialise; no-op if NULL.
*/
void hotwords_cache_init(HotwordsCache *cache) {
if (!cache) return;
memset(cache, 0, sizeof(*cache));
cache->enabled = ENABLE_HOTWORDS_CACHE;
cache->cache_count = 0;
cache->lru_index = 0;
/* Initialize statistics with proper sentinel values */
cache->stats.total_lookups = 0;
cache->stats.cache_hits = 0;
cache->stats.bucket_hits = 0;
cache->stats.misses = 0;
cache->stats.evictions = 0;
cache->stats.promotions = 0;
cache->stats.bucket_reorders = 0;
/* Fixed-point statistics (Q48.16 format) */
cache->stats.cache_hit_total_ns_q48 = 0;
cache->stats.bucket_search_total_ns_q48 = 0;
cache->stats.cache_hit_samples = 0;
cache->stats.bucket_search_samples = 0;
/* Min/max latencies */
cache->stats.min_cache_hit_ns = INT64_MAX;
cache->stats.max_cache_hit_ns = INT64_MIN;
cache->stats.min_bucket_search_ns = INT64_MAX;
cache->stats.max_bucket_search_ns = INT64_MIN;
/* Variance accumulators (Q48.16) */
cache->stats.cache_hit_variance_sum_q48 = 0;
cache->stats.bucket_search_variance_sum_q48 = 0;
}
/**
* @brief Zero all fields in a @c HotwordsCache, releasing no heap memory.
*
* Calls @c memset(cache, 0, sizeof(*cache)) to scrub every field including
* the inline @c cache[] pointer array and all statistics. The cache holds no
* separately allocated memory (the @c DictEntry pointers inside @c cache[]
* are owned by the dictionary, not the cache), so no @c free() calls are
* needed.
*
* Intended for use at VM teardown or when the caller wants to reset the cache
* to a known-zero state between benchmark runs. After this call the cache
* is in an unusable state (@c enabled = 0); call @c hotwords_cache_init()
* to reinitialise it.
*
* @param cache Cache to zero; no-op if NULL.
*/
void hotwords_cache_cleanup(HotwordsCache *cache) {
if (!cache) return;
memset(cache, 0, sizeof(*cache));
}
/* ============================================================================
* Main Lookup: Cache + Bucket Search
* ============================================================================
*/
/**
* @brief Look up a FORTH word using the hot-words cache, falling back to the bucket.
*
* The primary dictionary fast-path. Records a start timestamp via
* @c sf_monotonic_ns() and then executes a two-stage search:
*
* **Stage 1 — Cache check (O(HOTWORDS_CACHE_SIZE)):**
* Scans the @c cache->cache[] ring for an entry whose @c name_len and name
* match @p name/@p len, using the cheap-first filter (@c name_len →
* last-character → @c memcmp). On a hit the elapsed nanoseconds are
* converted to Q48.16 and accumulated into @c stats.cache_hit_total_ns_q48;
* the squared value is accumulated into @c stats.cache_hit_variance_sum_q48
* for Bayesian posterior computation by @c calculate_posterior(). Min/max
* latency sentinels are also updated.
*
* **Stage 2 — Bucket fallback (O(bucket_count)):**
* Scans @p bucket[] in reverse-insertion order (newest definition wins).
* On a hit the elapsed time is recorded in the @c bucket_search_* accumulators
* with the same Q48.16 and variance treatment as Stage 1. If the found
* word's @c execution_heat exceeds @c HOTWORDS_EXECUTION_HEAT_THRESHOLD it
* is promoted into the cache via @c hotwords_cache_promote().
*
* **Disabled path:** If @c cache is NULL or @c cache->enabled is 0, the
* function skips Stage 1 and performs a bare reverse-linear scan of @p bucket[]
* returning the result immediately (no statistics are recorded).
*
* A miss increments @c stats.misses and returns NULL.
*
* @param cache Hot-words cache; may be NULL or disabled (falls back
* to bucket scan without statistics).
* @param bucket First-character hash bucket — array of @c DictEntry*
* pointers, searched in reverse order.
* @param bucket_count Number of valid pointers in @p bucket.
* @param name Word name to find (not NUL-terminated).
* @param len Length of @p name in bytes.
* @return Matching @c DictEntry*, or NULL if not found.
*/
DictEntry *hotwords_cache_lookup(VM *vm,
HotwordsCache *cache,
DictEntry **bucket,
size_t bucket_count,
const char *name,
size_t len) {
uint64_t start_ns = sf_monotonic_ns();
// Disabled? Go straight to the arbitrated bucket resolver
if (!cache || !cache->enabled) {
return vm_dict_resolve_in_bucket(vm, bucket, bucket_count, name, len);
}
cache->stats.total_lookups++;
// --- STEP 1: Check hot-words cache ---
for (uint32_t i = 0; i < cache->cache_count; i++) {
DictEntry *e = cache->cache[i];
if (!e) continue;
if ((size_t)e->name_len != len) continue;
#ifdef WORD_HIDDEN
if (e->flags & WORD_HIDDEN) continue;
#endif
#ifdef WORD_SMUDGED
if (e->flags & WORD_SMUDGED) continue;
#endif
if (len > 1 && (unsigned char)e->name[len - 1] != (unsigned char)name[len - 1]) continue;
if (memcmp(e->name, name, len) == 0) {
// Cache hit! Record latency with 64-bit fixed-point precision
cache->stats.cache_hits++;
int64_t elapsed_ns = (int64_t)(sf_monotonic_ns() - start_ns);
/* Store in Q48.16 fixed-point format (shift left by 16 bits for fractional precision) */
cache->stats.cache_hit_total_ns_q48 += (elapsed_ns << 16);
cache->stats.cache_hit_samples++;
/* Track min/max */
if (elapsed_ns < cache->stats.min_cache_hit_ns) {
cache->stats.min_cache_hit_ns = elapsed_ns;
}
if (elapsed_ns > cache->stats.max_cache_hit_ns) {
cache->stats.max_cache_hit_ns = elapsed_ns;
}
/* Accumulate squared values for variance calculation (Bayesian posteriors) */
int64_t elapsed_sq_q48 = (elapsed_ns * elapsed_ns) << 16;
cache->stats.cache_hit_variance_sum_q48 += elapsed_sq_q48;
return e;
}
}
// --- STEP 2: Fall back to bucket search (arbitrated: newest visible
// same-named definition wins regardless of heat ordering) ---
{
DictEntry *e = vm_dict_resolve_in_bucket(vm, bucket, bucket_count, name, len);
if (e) {
// Bucket hit! Record latency with 64-bit fixed-point precision
cache->stats.bucket_hits++;
int64_t elapsed_ns = (int64_t)(sf_monotonic_ns() - start_ns);
/* Store in Q48.16 fixed-point format (shift left by 16 bits for fractional precision) */
cache->stats.bucket_search_total_ns_q48 += (elapsed_ns << 16);
cache->stats.bucket_search_samples++;
/* Track min/max */
if (elapsed_ns < cache->stats.min_bucket_search_ns) {
cache->stats.min_bucket_search_ns = elapsed_ns;
}
if (elapsed_ns > cache->stats.max_bucket_search_ns) {
cache->stats.max_bucket_search_ns = elapsed_ns;
}
/* Accumulate squared values for variance calculation (Bayesian posteriors) */
int64_t elapsed_sq_q48 = (elapsed_ns * elapsed_ns) << 16;
cache->stats.bucket_search_variance_sum_q48 += elapsed_sq_q48;
// If hot enough, promote to cache
if (e->execution_heat > HOTWORDS_EXECUTION_HEAT_THRESHOLD) {
hotwords_cache_promote(cache, e);
}
return e;
}
}
// Miss
cache->stats.misses++;
return NULL;
}
/* ============================================================================
* Cache Eviction (coherence with dictionary mutations)
* ============================================================================
*/
/* Remove ring slot i, compacting the tail down one position. */
static void hotwords_cache_remove_at(HotwordsCache *cache, uint32_t i) {
for (uint32_t j = i; j + 1 < cache->cache_count; j++) {
cache->cache[j] = cache->cache[j + 1];
}
cache->cache_count--;
cache->cache[cache->cache_count] = NULL;
if (cache->lru_index >= cache->cache_count) {
cache->lru_index = 0;
}
}
void hotwords_cache_evict_entry(HotwordsCache *cache, const DictEntry *word) {
if (!cache || !word || cache->cache_count == 0) return;
for (uint32_t i = cache->cache_count; i-- > 0;) {
if (cache->cache[i] == word) {
hotwords_cache_remove_at(cache, i);
}
}
}
void hotwords_cache_evict_name(HotwordsCache *cache, const char *name, size_t len) {
if (!cache || !name || len == 0 || cache->cache_count == 0) return;
for (uint32_t i = cache->cache_count; i-- > 0;) {
DictEntry *e = cache->cache[i];
if (!e) continue;
if ((size_t)e->name_len != len) continue;
if (memcmp(e->name, name, len) != 0) continue;
hotwords_cache_remove_at(cache, i);
}
}
/* ============================================================================
* Cache Promotion (LRU eviction)
* ============================================================================
*/
/**
* @brief Promote a @c DictEntry into the hot-words cache, evicting the oldest entry if full.
*
* Two paths depending on whether the cache has a free slot:
*
* - **Slot available** (@c cache->cache_count < @c HOTWORDS_CACHE_SIZE):
* Appends @p word at @c cache->cache[cache_count++] after verifying it is
* not already present (linear scan). Increments @c stats.promotions.
*
* - **Cache full** (@c cache->cache_count >= @c HOTWORDS_CACHE_SIZE):
* Overwrites @c cache->cache[cache->lru_index] with @p word (round-robin
* least-recently-used eviction) and advances @c lru_index modulo
* @c HOTWORDS_CACHE_SIZE. Increments @c stats.evictions. The evicted entry
* is not freed — it remains alive in the dictionary; only its slot in the
* cache ring is surrendered.
*
* Called from @c hotwords_cache_lookup() whenever a bucket search finds a
* word hot enough to warrant caching (heat > @c HOTWORDS_EXECUTION_HEAT_THRESHOLD).
*
* @param cache The cache to promote into; no-op if NULL.
* @param word The @c DictEntry to promote; no-op if NULL. Ownership is not
* transferred — the cache holds a borrowed pointer into the
* dictionary, which owns the entry.
*/
void hotwords_cache_promote(HotwordsCache *cache, DictEntry *word) {
if (!cache || !word || cache->cache_count >= HOTWORDS_CACHE_SIZE) {
if (cache && cache->cache_count >= HOTWORDS_CACHE_SIZE) {
// LRU eviction: remove oldest entry (round-robin)
cache->cache[cache->lru_index] = word;
cache->lru_index = (cache->lru_index + 1) % HOTWORDS_CACHE_SIZE;
cache->stats.evictions++;
}
return;
}
// Check if already in cache
for (uint32_t i = 0; i < cache->cache_count; i++) {
if (cache->cache[i] == word) {
return; // Already cached
}
}
// Add to cache
cache->cache[cache->cache_count++] = word;
cache->stats.promotions++;
}
/* ============================================================================
* Bucket Reordering (move hot words forward)
* ============================================================================
*/
/**
* @brief Sort a hash bucket in-place by descending execution heat (bubble sort).
*
* Performs a classic in-place bubble sort over the @p bucket array so that
* words with higher @c execution_heat appear at lower array indices. The
* hot-words cache and heat-stratified lookup both benefit from having the
* hottest words at the front of each bucket: the first-character hash buckets
* are linear arrays, and placing hot words up front reduces the scan depth on
* Stage 1 cache misses that fall through to Stage 2 bucket search.
*
* Bubble sort is chosen deliberately: buckets are small (typically single
* digits to low dozens of words per first-character class), already nearly
* sorted after the previous reorganization pass, and the cost of a O(n²)
* inner loop on n ≤ 30 is negligible compared to the outer @c qsort on
* all 256 buckets in @c dict_reorganize_buckets_by_heat(). For the individual
* per-bucket call path (e.g. after a single promotion), bubble sort avoids
* the @c malloc overhead that @c qsort's temporary storage would require.
*
* No-op for @p count < 2.
*
* @param bucket Array of @c DictEntry* pointers to sort in-place.
* NULL-check is the caller's responsibility.
* @param count Number of valid entries in @p bucket.
*/
void hotwords_bucket_reorder(DictEntry **bucket, size_t count) {
if (!bucket || count < 2) return;
// Simple bubble sort: move high-execution-heat words forward
for (size_t i = 0; i < count - 1; i++) {
for (size_t j = 0; j < count - i - 1; j++) {
if (bucket[j]->execution_heat < bucket[j + 1]->execution_heat) {
// Swap
DictEntry *tmp = bucket[j];
bucket[j] = bucket[j + 1];
bucket[j + 1] = tmp;
}
}
}
}
/* ============================================================================
* Statistics
* ============================================================================
*/
/**
* @brief Zero all fields in a @c HotwordsStats structure.
*
* Resets every counter (@c total_lookups, @c cache_hits, @c bucket_hits,
* @c misses, @c evictions, @c promotions, @c bucket_reorders) to zero,
* resets all Q48.16 accumulator fields (@c cache_hit_total_ns_q48,
* @c bucket_search_total_ns_q48, @c cache_hit_variance_sum_q48,
* @c bucket_search_variance_sum_q48) to zero, resets sample counts to zero,
* and restores the min/max latency sentinels:
* - @c min_*_ns = @c INT64_MAX
* - @c max_*_ns = @c INT64_MIN
*
* Intended for DoE benchmark runs that need a clean statistical baseline
* between treatment cells. The parent @c HotwordsCache also holds the
* @c cache[] pointer array and LRU state; those are not touched — only the
* @c HotwordsStats sub-struct is cleared.
*
* @param stats Statistics structure to reset; no-op if NULL.
*/
void hotwords_stats_reset(HotwordsStats *stats) {
if (!stats) return;
/* Reset counters */
stats->total_lookups = 0;
stats->cache_hits = 0;
stats->bucket_hits = 0;
stats->misses = 0;
stats->evictions = 0;
stats->promotions = 0;
stats->bucket_reorders = 0;
/* Reset fixed-point accumulators */
stats->cache_hit_total_ns_q48 = 0;
stats->bucket_search_total_ns_q48 = 0;
stats->cache_hit_samples = 0;
stats->bucket_search_samples = 0;
/* Reset min/max latencies */
stats->min_cache_hit_ns = INT64_MAX;
stats->max_cache_hit_ns = INT64_MIN;
stats->min_bucket_search_ns = INT64_MAX;
stats->max_bucket_search_ns = INT64_MIN;
/* Reset variance accumulators */
stats->cache_hit_variance_sum_q48 = 0;
stats->bucket_search_variance_sum_q48 = 0;
}
/**
* @brief Print a formatted hot-words cache statistics report to @c stdout.
*
* Emits a Unicode box-drawing table covering three sections:
*
* **LOOKUPS** — total, cache hits, bucket hits, misses with percentages.
*
* **LATENCY STATISTICS** — for each of cache-hits and bucket-searches
* (when their sample counts are non-zero):
* - Min / avg / max in nanoseconds, derived from the Q48.16 accumulators
* by right-shifting 16 bits: @c avg_ns = @c total_ns_q48 / samples >> 16.
* - Standard deviation computed from the Welford-style variance accumulator:
* @c var = E[X²] − E[X]², then @c stddev = sqrt_q48(var), converted to
* nanoseconds via @c q48_to_ns_double() for display only.
* - Speedup ratio (bucket avg / cache avg) when both sample sets are present.
*
* **CACHE MANAGEMENT** — promotions, evictions, and bucket reorder counts.
*
* If @p stats is NULL or the total lookup count is zero, prints a brief
* "No lookups performed." notice instead of the full table. All floating-point
* usage in this function is display-only (via @c q48_to_ns_double()); the
* underlying accumulators remain in Q48.16 integer format.
*
* @param stats Statistics to report; no-op if NULL.
*/
void hotwords_stats_print(const HotwordsStats *stats) {
if (!stats) return;
printf("\n╔════════════════════════════════════════════════════════════════╗\n");
printf("║ Hot-Words Cache Statistics (64-bit Fixed-Point Q48.16) ║\n");
printf("╚════════════════════════════════════════════════════════════════╝\n\n");
uint64_t total = stats->cache_hits + stats->bucket_hits + stats->misses;
if (total == 0) {
printf("No lookups performed.\n");
return;
}
double cache_hit_pct = 100.0 * stats->cache_hits / total;
double bucket_hit_pct = 100.0 * stats->bucket_hits / total;
double miss_pct = 100.0 * stats->misses / total;
printf("LOOKUPS (Statistically Valid Sample Size):\n");
printf(" Total: %lu\n", total);
printf(" Cache hits: %lu (%.2f%%)\n", stats->cache_hits, cache_hit_pct);
printf(" Bucket hits: %lu (%.2f%%)\n", stats->bucket_hits, bucket_hit_pct);
printf(" Misses: %lu (%.2f%%)\n", stats->misses, miss_pct);
printf("\nLATENCY STATISTICS (64-bit Fixed-Point Precision):\n");
/* Cache hit latency (Q48.16 format: shift right by 16 bits to get nanoseconds) */
if (stats->cache_hit_samples > 0) {
int64_t avg_cache_ns_q48 = stats->cache_hit_total_ns_q48 / (int64_t)stats->cache_hit_samples;
double avg_cache_ns = (double)avg_cache_ns_q48 / 65536.0; /* Q48.16 to double */
double min_cache_ns = (double)stats->min_cache_hit_ns;
double max_cache_ns = (double)stats->max_cache_hit_ns;
printf(" Cache Hits (%lu samples):\n", stats->cache_hit_samples);
printf(" Min: %.3f ns\n", min_cache_ns);
printf(" Avg: %.3f ns\n", avg_cache_ns);
printf(" Max: %.3f ns\n", max_cache_ns);
/* Calculate variance and standard deviation */
int64_t variance_sum_q48 = stats->cache_hit_variance_sum_q48 / (int64_t)stats->cache_hit_samples;
int64_t mean_sq_q48 = (avg_cache_ns_q48 * avg_cache_ns_q48) / (1LL << 16);
int64_t var_q48 = variance_sum_q48 - mean_sq_q48;
int64_t stddev_q48 = (var_q48 >= 0) ? sqrt_q48(var_q48) : 0;
double stddev = q48_to_ns_double(stddev_q48);
printf(" StdDev: %.3f ns\n", stddev);
}
if (stats->bucket_search_samples > 0) {
int64_t avg_bucket_ns_q48 = stats->bucket_search_total_ns_q48 / (int64_t)stats->bucket_search_samples;
double avg_bucket_ns = (double)avg_bucket_ns_q48 / 65536.0; /* Q48.16 to double */
double min_bucket_ns = (double)stats->min_bucket_search_ns;
double max_bucket_ns = (double)stats->max_bucket_search_ns;
printf(" Bucket Searches (%lu samples):\n", stats->bucket_search_samples);
printf(" Min: %.3f ns\n", min_bucket_ns);
printf(" Avg: %.3f ns\n", avg_bucket_ns);
printf(" Max: %.3f ns\n", max_bucket_ns);
/* Calculate variance and standard deviation */
int64_t variance_sum_q48 = stats->bucket_search_variance_sum_q48 / (int64_t)stats->bucket_search_samples;
int64_t mean_sq_q48 = (avg_bucket_ns_q48 * avg_bucket_ns_q48) / (1LL << 16);
int64_t var_q48 = variance_sum_q48 - mean_sq_q48;
int64_t stddev_q48 = (var_q48 >= 0) ? sqrt_q48(var_q48) : 0;
double stddev = q48_to_ns_double(stddev_q48);
printf(" StdDev: %.3f ns\n", stddev);
/* Speedup calculation */
if (stats->cache_hit_samples > 0) {
int64_t avg_cache_ns_q48 = stats->cache_hit_total_ns_q48 / (int64_t)stats->cache_hit_samples;
double avg_bucket_ns_dbl = (double)avg_bucket_ns_q48 / 65536.0;
double speedup = avg_bucket_ns_dbl / ((double)avg_cache_ns_q48 / 65536.0);
printf(" Speedup: %.2f× (bucket vs cache)\n", speedup);
}
}
printf("\nCACHE MANAGEMENT:\n");
printf(" Promotions: %lu\n", stats->promotions);
printf(" Evictions: %lu\n", stats->evictions);
printf(" Reorders: %lu\n", stats->bucket_reorders);
printf("\n════════════════════════════════════════════════════════════════\n\n");
}
/**
* @brief Enable or disable the hot-words cache at runtime.
*
* Sets @c cache->enabled to @p enabled (non-zero = active, 0 = bypassed).
* When disabled, @c hotwords_cache_lookup() skips Stage 1 entirely and
* falls through directly to a bare bucket scan, recording no statistics.
* This allows benchmark harnesses to compare cache-on vs. cache-off behaviour
* without rebuilding the binary.
*
* @param cache Cache to configure; no-op if NULL.
* @param enabled Non-zero to enable the cache; 0 to disable.
*/
void hotwords_cache_set_enabled(HotwordsCache *cache, int enabled) {
if (!cache) return;
cache->enabled = enabled;
}
/* ============================================================================
* Bayesian Inference Implementation
* ============================================================================
*/
/**
* @brief Convert a Q48.16 fixed-point value to a @c double nanosecond count.
*
* Divides @p q48 by 65536.0 to recover the real-valued nanosecond count.
* This is the only floating-point operation in the module and is intentionally
* confined to display paths — @c hotwords_stats_print() and
* @c hotwords_bayesian_report() — so that all internal accumulation and
* statistical computation remains in Q48.16 integer arithmetic.
*
* @param q48 Value in Q48.16 format (1.0 ns = 65536).
* @return The same quantity as a @c double in nanoseconds.
*/
static inline double q48_to_ns_double(int64_t q48) {
return (double)q48 / 65536.0;
}
/**
* @brief Compute a Bayesian latency posterior for one measurement distribution.
*
* Given the accumulated Q48.16 statistics for a set of @p sample_count
* timing observations (either cache-hit or bucket-search latencies), computes
* the following posterior quantities entirely in Q48.16 integer arithmetic:
*
* - **Mean** (@c mean_ns_q48): @c total_ns_q48 / sample_count.
* - **Variance** (@c stddev_ns_q48): @c E[X²] − @c E[X]² where @c E[X²] is
* the per-sample average of @p variance_sum_q48 and @c E[X]² =
* @c mean² scaled to Q48.16 via @c >> 16. Variance is clamped to 0 to
* guard numerical rounding.
* - **Standard deviation** (@c stddev_ns_q48): @c sqrt_q48(variance).
* - **Median** (@c median_ns_q48): @c (min_ns + max_ns) / 2 — a quick
* midpoint estimate rather than a true median, consistent across all
* call sites.
* - **Standard error** (@c se_q48): @c stddev / √N, computed by converting
* @p sample_count to Q48.16 (@c sample_count << 16) and calling
* @c sqrt_q48(), then dividing @c stddev << 16 by the result.
* - **95% credible interval**: @c mean ± Z₉₅ × SE where
* @c Z₉₅ = 128431 (1.96 × 65536).
* - **99% credible interval**: @c mean ± Z₉₉ × SE where
* @c Z₉₉ = 168888 (2.576 × 65536).
* Lower credible bounds are clamped at 0 (latency is non-negative).
*
* Returns a zeroed @c BayesianLatencyPosterior if @p sample_count is 0.
*
* @param total_ns_q48 Sum of all latency observations in Q48.16.
* @param variance_sum_q48 Sum of squared latency observations in Q48.16
* (i.e., @c Σ(xᵢ² << 16)).
* @param min_ns Minimum observed latency in integer nanoseconds.
* @param max_ns Maximum observed latency in integer nanoseconds.
* @param sample_count Number of observations; 0 → returns zeroed struct.
* @return @c BayesianLatencyPosterior with all fields in Q48.16.
*/
static BayesianLatencyPosterior calculate_posterior(
int64_t total_ns_q48,
int64_t variance_sum_q48,
int64_t min_ns,
int64_t max_ns,
uint64_t sample_count) {
const int64_t Z95 = 128431LL; /* 1.96 * 65536 */
const int64_t Z99 = 168888LL; /* 2.576 * 65536 */
BayesianLatencyPosterior posterior = {0};
posterior.sample_count = sample_count;
if (sample_count == 0) {
return posterior;
}
/* Calculate mean from accumulated Q48.16 values (pure integer division) */
int64_t mean_q48 = total_ns_q48 / (int64_t)sample_count;
posterior.mean_ns_q48 = mean_q48;
/* Calculate variance: E[X^2] - E[X]^2, all in Q48.16 */
int64_t mean_sq_q48 = (mean_q48 * mean_q48) >> 16;
int64_t variance_sum_corrected = variance_sum_q48 / (int64_t)sample_count;
int64_t variance_q48 = variance_sum_corrected - mean_sq_q48;
if (variance_q48 < 0) variance_q48 = 0; /* Guard numerical errors */
/* Calculate standard deviation using Q48.16 sqrt */
int64_t stddev_q48 = sqrt_q48(variance_q48);
posterior.stddev_ns_q48 = stddev_q48;
/* Median: average of min/max */
posterior.median_ns_q48 = (min_ns + max_ns) / 2;
/* Standard error: stddev / sqrt(N) in Q48.16 */
/* sqrt(sample_count) approximation for Q48.16 arithmetic */
int64_t sqrt_n_q48 = sqrt_q48((int64_t)sample_count << 16); /* Convert N to Q48.16 */
int64_t se_q48 = (stddev_q48 << 16) / (sqrt_n_q48 >> 16); /* Careful division */
/* 95% credible interval: mean ± Z95 * SE (Z95 = 1.96 << 16) */
int64_t margin_95 = (Z95 * se_q48) >> 16;
posterior.credible_lower_95 = mean_q48 - margin_95;
posterior.credible_upper_95 = mean_q48 + margin_95;
/* 99% credible interval: mean ± Z99 * SE (Z99 = 2.576 << 16) */
int64_t margin_99 = (Z99 * se_q48) >> 16;
posterior.credible_lower_99 = mean_q48 - margin_99;
posterior.credible_upper_99 = mean_q48 + margin_99;
/* Clamp lower bounds to >= 0 */
if (posterior.credible_lower_95 < 0) posterior.credible_lower_95 = 0;
if (posterior.credible_lower_99 < 0) posterior.credible_lower_99 = 0;
return posterior;
}
/**
* @brief Return the Bayesian latency posterior for cache-hit observations.
*
* Forwards the cache-hit accumulators from @p stats to @c calculate_posterior():
* @c cache_hit_total_ns_q48, @c cache_hit_variance_sum_q48, @c min_cache_hit_ns,
* @c max_cache_hit_ns, and @c cache_hit_samples. Returns a zeroed
* @c BayesianLatencyPosterior if @p stats is NULL or no cache-hit samples have
* been recorded yet.
*
* The returned posterior's @c mean_ns_q48, @c stddev_ns_q48, and 95%/99%
* credible-interval fields are consumed by @c hotwords_speedup_estimate() and
* @c hotwords_bayesian_report() to compare cache-hit latency against bucket-search
* latency.
*
* @param stats @c HotwordsStats containing cache-hit timing accumulators.
* @return Posterior in Q48.16; all fields zero if no samples exist.
*/
BayesianLatencyPosterior hotwords_posterior_cache_hits(const HotwordsStats *stats) {
if (!stats || stats->cache_hit_samples == 0) {
BayesianLatencyPosterior empty = {0};
return empty;
}
return calculate_posterior(
stats->cache_hit_total_ns_q48,
stats->cache_hit_variance_sum_q48,
stats->min_cache_hit_ns,
stats->max_cache_hit_ns,
stats->cache_hit_samples
);
}
/**
* @brief Return the Bayesian latency posterior for bucket-search observations.
*
* Forwards the bucket-search accumulators from @p stats to @c calculate_posterior():
* @c bucket_search_total_ns_q48, @c bucket_search_variance_sum_q48,
* @c min_bucket_search_ns, @c max_bucket_search_ns, and @c bucket_search_samples.
* Returns a zeroed @c BayesianLatencyPosterior if @p stats is NULL or no
* bucket-search samples have been recorded.
*
* The returned posterior's mean and credible-interval fields feed
* @c hotwords_speedup_estimate() (as the slower distribution) and the
* baseline section of @c hotwords_bayesian_report().
*
* @param stats @c HotwordsStats containing bucket-search timing accumulators.
* @return Posterior in Q48.16; all fields zero if no samples exist.
*/
BayesianLatencyPosterior hotwords_posterior_bucket_searches(const HotwordsStats *stats) {
if (!stats || stats->bucket_search_samples == 0) {
BayesianLatencyPosterior empty = {0};
return empty;
}
return calculate_posterior(
stats->bucket_search_total_ns_q48,
stats->bucket_search_variance_sum_q48,
stats->min_bucket_search_ns,
stats->max_bucket_search_ns,
stats->bucket_search_samples
);
}
/**
* @brief Compute a speedup estimate with credible intervals using the delta method.
*
* Derives a dimensionless speedup ratio @c S = bucket_mean / cache_mean in
* Q48.16 fixed-point and propagates uncertainty via the delta method for ratios:
* @code
* SE(S) ≈ S × sqrt( (SE_bucket / bucket_mean)² + (SE_cache / cache_mean)² )
* @endcode
* All arithmetic is Q48.16 integer throughout; the only deviation is the
* intermediate @c sqrt() call which also runs in Q48.16 via @c sqrt_q48().
*
* Computed fields in the returned @c SpeedupEstimate (all Q48.16):
* - @c speedup_factor_q48 — point estimate of @c S.
* - @c credible_lower_95_q48 / @c credible_upper_95_q48 — 95% credible
* interval: @c S ± 1.96 × SE(S) (Z₉₅ = 128431 in Q48.16). Lower bound
* clamped at 0.
* - @c probability_gt_10pct_q48 — P(speedup > 1.1×), computed as
* @c 0.5 × (1 + erf(z / √2)) where @c z = (1.1 − S) / SE(S) is negated
* to give the right-tail probability and @c √2 = 92681 in Q48.16.
* - @c probability_gt_double_q48 — P(speedup > 2.0×), same formula with
* target = 2.0 × 65536 = 131072.
*
* Returns a default @c SpeedupEstimate with @c speedup_factor_q48 = 65536
* (1.0×) if either distribution has zero samples or if @p stats is NULL.
*
* @param stats @c HotwordsStats with both cache-hit and bucket-search samples.
* @return @c SpeedupEstimate with all fields in Q48.16 fixed-point.
*/
struct SpeedupEstimate hotwords_speedup_estimate(const HotwordsStats *stats) {
const int64_t Q48 = 65536LL;
const int64_t SQRT2 = 92681LL; /* sqrt(2) * 65536 ≈ 1.414 * 65536 */
struct SpeedupEstimate est = {0};
if (!stats || stats->cache_hit_samples == 0 || stats->bucket_search_samples == 0) {
est.speedup_factor_q48 = Q48; /* Default: 1.0x speedup */
return est;
}
BayesianLatencyPosterior cache_post = hotwords_posterior_cache_hits(stats);
BayesianLatencyPosterior bucket_post = hotwords_posterior_bucket_searches(stats);
/* Guard divide-by-zero */
if (cache_post.mean_ns_q48 < 1) cache_post.mean_ns_q48 = 1;
/* Point estimate: speedup = bucket_time / cache_time (dimensionless, in Q48.16) */
int64_t speedup_q48 = (bucket_post.mean_ns_q48 << 16) / cache_post.mean_ns_q48;
est.speedup_factor_q48 = speedup_q48;
/* Delta-method SE for ratio: SE(speedup) ≈ speedup * sqrt((SE_bucket/bucket)^2 + (SE_cache/cache)^2) */
int64_t se_cache_q48 = (cache_post.stddev_ns_q48 << 16) / (int64_t)stats->cache_hit_samples;
int64_t se_bucket_q48 = (bucket_post.stddev_ns_q48 << 16) / (int64_t)stats->bucket_search_samples;
/* Relative standard errors: SE/mean */
int64_t rel_se_cache_q48 = (se_cache_q48 << 16) / cache_post.mean_ns_q48;
int64_t rel_se_bucket_q48 = (se_bucket_q48 << 16) / bucket_post.mean_ns_q48;
/* Combine: sqrt((rel_se_cache)^2 + (rel_se_bucket)^2) */
int64_t sum_sq = ((rel_se_cache_q48 * rel_se_cache_q48) >> 16) +
((rel_se_bucket_q48 * rel_se_bucket_q48) >> 16);
int64_t rel_se_ratio_q48 = sqrt_q48(sum_sq);
/* SE(speedup) = speedup * rel_se_ratio */
int64_t se_speedup_q48 = (speedup_q48 * rel_se_ratio_q48) >> 16;
/* 95% credible interval for speedup (Z1.96 = 128431 in Q48.16) */
int64_t margin_95_q48 = (128431LL * se_speedup_q48) >> 16;
est.credible_lower_95_q48 = speedup_q48 - margin_95_q48;
est.credible_upper_95_q48 = speedup_q48 + margin_95_q48;
if (est.credible_lower_95_q48 < 0) est.credible_lower_95_q48 = 0;
/* Probability of speedup > 1.1× using erf_q48 (pure fixed-point) */
/* Z-score: (1.1 - speedup) / SE_speedup, computed in Q48.16 */
/* Result: erf returns Q48.16 in [-65536, 65536], convert to probability [0, 65536] */
int64_t target_110_q48 = 72090LL; /* 1.1 * 65536 */
int64_t z_10pct_q48 = ((target_110_q48 - speedup_q48) << 16) / se_speedup_q48;
int64_t erf_val_10pct = erf_q48((-z_10pct_q48) / SQRT2);
/* Convert erf result to probability: P = 0.5 * (1 + erf) in Q48.16 */
est.probability_gt_10pct_q48 = (Q48 + erf_val_10pct) >> 1;
/* Probability of speedup > 2.0× */
int64_t target_200_q48 = 131072LL; /* 2.0 * 65536 */
int64_t z_2x_q48 = ((target_200_q48 - speedup_q48) << 16) / se_speedup_q48;
int64_t erf_val_2x = erf_q48((-z_2x_q48) / SQRT2);
est.probability_gt_double_q48 = (Q48 + erf_val_2x) >> 1;
return est;
}
/**
* @brief Print a full Bayesian cache performance report comparing two experimental conditions.
*
* Emits a structured Unicode report to @c stdout comparing the latency
* distributions of two measurement sets — one collected with the hot-words
* cache enabled, the other collected without (baseline). The report is divided
* into five sections:
*
* 1. **WITH CACHE ENABLED** — posterior mean, stddev, and 95%/99% credible
* intervals for cache-hits and bucket-searches separately, via
* @c hotwords_posterior_cache_hits() and @c hotwords_posterior_bucket_searches().
*
* 2. **WITHOUT CACHE (Baseline)** — posterior mean, stddev, and 95% credible
* interval for all lookups (treated as bucket searches). If no bucket data
* is available in @p stats_without_cache, the bucket-search mean from the
* with-cache run is used as an approximation.
*
* 3. **SPEEDUP ESTIMATE (Bucket vs Cache)** — @c hotwords_speedup_estimate()
* point estimate, 95% credible interval, P(>1.1×), and P(>2.0×).
*
* 4. **CACHE EFFECTIVENESS** — total lookups, cache-hit rate, bucket-hit rate,
* and miss rate as percentages of total.
*
* 5. **OVERALL PERFORMANCE** — weighted-average latency with cache vs. baseline
* all-bucket latency, overall speedup, and absolute time saved per lookup.
* The weighted average is: @c (N_cache×avg_cache + N_bucket×avg_bucket) /
* @c (N_cache + N_bucket).
*
* All latency values are displayed in nanoseconds (floating-point via
* @c q48_to_ns_double()) for readability; underlying accumulators are Q48.16
* integer throughout.
*
* No-op if either @p stats_with_cache or @p stats_without_cache is NULL.
*
* @param stats_with_cache Statistics from a run with cache enabled.
* @param stats_without_cache Statistics from a baseline run without cache.
*/
void hotwords_bayesian_report(const HotwordsStats *stats_with_cache,
const HotwordsStats *stats_without_cache) {
if (!stats_with_cache || !stats_without_cache) return;
printf("\n╔════════════════════════════════════════════════════════════════╗\n");
printf("║ Bayesian Performance Analysis: Cache Impact ║\n");
printf("╚════════════════════════════════════════════════════════════════╝\n\n");
/* WITH CACHE statistics */
BayesianLatencyPosterior cache_with = hotwords_posterior_cache_hits(stats_with_cache);
BayesianLatencyPosterior bucket_with = hotwords_posterior_bucket_searches(stats_with_cache);
printf("WITH CACHE ENABLED:\n");
printf("─────────────────────────────────────────────────────────────────\n");
printf("Cache Hits (N=%lu):\n", cache_with.sample_count);
printf(" Mean: %.2f ns\n", q48_to_ns_double(cache_with.mean_ns_q48));
printf(" Std Dev: %.2f ns\n", q48_to_ns_double(cache_with.stddev_ns_q48));
printf(" 95%% Credible: [%.2f, %.2f] ns\n", q48_to_ns_double(cache_with.credible_lower_95), q48_to_ns_double(cache_with.credible_upper_95));
printf(" 99%% Credible: [%.2f, %.2f] ns\n\n", q48_to_ns_double(cache_with.credible_lower_99), q48_to_ns_double(cache_with.credible_upper_99));
printf("Bucket Searches (N=%lu):\n", bucket_with.sample_count);
printf(" Mean: %.2f ns\n", q48_to_ns_double(bucket_with.mean_ns_q48));
printf(" Std Dev: %.2f ns\n", q48_to_ns_double(bucket_with.stddev_ns_q48));
printf(" 95%% Credible: [%.2f, %.2f] ns\n", q48_to_ns_double(bucket_with.credible_lower_95), q48_to_ns_double(bucket_with.credible_upper_95));
printf(" 99%% Credible: [%.2f, %.2f] ns\n\n", q48_to_ns_double(bucket_with.credible_lower_99), q48_to_ns_double(bucket_with.credible_upper_99));
/* WITHOUT CACHE statistics */
printf("WITHOUT CACHE (Baseline):\n");
printf("─────────────────────────────────────────────────────────────────\n");
printf("All Lookups (N=%lu):\n", stats_without_cache->cache_hits + stats_without_cache->bucket_hits);
/* Estimate average latency without cache (all go to bucket) */
BayesianLatencyPosterior all_lookups_baseline = hotwords_posterior_bucket_searches(stats_without_cache);
if (all_lookups_baseline.sample_count == 0) {
/* Fallback if bucket data not available */
all_lookups_baseline.mean_ns_q48 = bucket_with.mean_ns_q48;
}
printf(" Mean: %.2f ns\n", q48_to_ns_double(all_lookups_baseline.mean_ns_q48));
printf(" Std Dev: %.2f ns\n", q48_to_ns_double(all_lookups_baseline.stddev_ns_q48));
printf(" 95%% Credible: [%.2f, %.2f] ns\n\n", q48_to_ns_double(all_lookups_baseline.credible_lower_95), q48_to_ns_double(all_lookups_baseline.credible_upper_95));
/* Speedup Analysis */
struct SpeedupEstimate speedup = hotwords_speedup_estimate(stats_with_cache);
printf("SPEEDUP ESTIMATE (Bucket vs Cache):\n");
printf("─────────────────────────────────────────────────────────────────\n");
printf(" Point Estimate: %.2f×\n", q48_to_ns_double(speedup.speedup_factor_q48));
printf(" 95%% Credible Interval: [%.2f×, %.2f×]\n", q48_to_ns_double(speedup.credible_lower_95_q48), q48_to_ns_double(speedup.credible_upper_95_q48));
printf(" P(Speedup > 1.1×): %.1f%% (credible improvement exists)\n", q48_to_ns_double(speedup.probability_gt_10pct_q48) * 100.0);
printf(" P(Speedup > 2.0×): %.1f%% (significant speedup)\n\n", q48_to_ns_double(speedup.probability_gt_double_q48) * 100.0);
/* Hit Rate Analysis */
uint64_t total_lookups_with = stats_with_cache->cache_hits + stats_with_cache->bucket_hits + stats_with_cache->misses;
double cache_hit_rate = (total_lookups_with > 0) ? (100.0 * stats_with_cache->cache_hits / total_lookups_with) : 0.0;
printf("CACHE EFFECTIVENESS:\n");
printf("─────────────────────────────────────────────────────────────────\n");
printf(" Total Lookups: %lu\n", total_lookups_with);
printf(" Cache Hits: %lu (%.1f%%)\n", stats_with_cache->cache_hits, cache_hit_rate);
printf(" Bucket Hits: %lu (%.1f%%)\n", stats_with_cache->bucket_hits,
100.0 * stats_with_cache->bucket_hits / total_lookups_with);
printf(" Misses: %lu (%.1f%%)\n\n", stats_with_cache->misses,
100.0 * stats_with_cache->misses / total_lookups_with);
/* Overall Performance */
double mixed_avg_latency = ((double)stats_with_cache->cache_hits * q48_to_ns_double(cache_with.mean_ns_q48) +
(double)stats_with_cache->bucket_hits * q48_to_ns_double(bucket_with.mean_ns_q48)) /
(stats_with_cache->cache_hits + stats_with_cache->bucket_hits);
double baseline_avg_latency = q48_to_ns_double(all_lookups_baseline.mean_ns_q48);
double overall_speedup = baseline_avg_latency / mixed_avg_latency;
printf("OVERALL PERFORMANCE (WITH vs WITHOUT CACHE):\n");
printf("─────────────────────────────────────────────────────────────────\n");
printf(" Baseline (all bucket): %.2f ns/lookup\n", baseline_avg_latency);
printf(" With cache: %.2f ns/lookup\n", mixed_avg_latency);
printf(" Overall Speedup: %.2f×\n", overall_speedup);
printf(" Time Saved per Lookup: %.2f ns (%.1f%%)\n\n", baseline_avg_latency - mixed_avg_latency,
100.0 * (baseline_avg_latency - mixed_avg_latency) / baseline_avg_latency);
printf("╚════════════════════════════════════════════════════════════════╝\n\n");
}
v3/src/physics_metadata.c
+387
View File
@@ -0,0 +1,387 @@
/*
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 ***
physics_metadata.c - Phase 1 physics metadata helpers
Captures thermodynamic-style signals for dictionary entries without
introducing heavy runtime cost. Future phases can build on these helpers
to drive physics-aware scheduling and storage placement.
*/
#include "../include/physics_metadata.h"
#include "../include/ssm_jacquard.h"
#include <stddef.h>
#include <stdint.h>
#include <string.h>
/* L8 FINAL INTEGRATION: L1 heat tracking is always-on (internal physics signal) */
/**
* @brief Clamp a uint64_t value to the uint32_t range.
*
* @param value Input value to clamp
* @return @c UINT32_MAX if @c value > UINT32_MAX, else @c (uint32_t)value
*/
static uint32_t clamp_u32(uint64_t value) {
return (value > UINT32_MAX) ? UINT32_MAX : (uint32_t) value;
}
/**
* @brief Derive a smoothed Q8 temperature from raw execution heat.
*
* Converts @c execution_heat to Q8 by left-shifting 8 bits, clamps to
* UINT16_MAX, then applies a 1/4 EMA blend with @c prior_q8 to suppress
* jitter: result = (3*prior + target) / 4. Returns 0 for non-positive heat.
*
* @param execution_heat Raw execution heat counter for the word
* @param prior_q8 Previous smoothed temperature in Q8 format
* @return Updated smoothed temperature in Q8 format
*/
static uint16_t temperature_from_execution_heat(cell_t execution_heat, uint16_t prior_q8) {
if (execution_heat <= 0) return 0;
uint64_t scaled = ((uint64_t) execution_heat) << 8; /* convert to Q8 */
uint16_t target = (scaled > UINT16_MAX) ? UINT16_MAX : (uint16_t) scaled;
/* Smooth with a simple EMA to avoid jitter */
return (uint16_t)((3u * prior_q8 + target) / 4u);
}
/**
* @brief Derive the physics state flags bitmask from a DictEntry's word flags.
*
* Maps @c WORD_IMMEDIATE → @c PHYSICS_STATE_IMMEDIATE,
* @c WORD_PINNED → @c PHYSICS_STATE_PINNED,
* @c WORD_HIDDEN → @c PHYSICS_STATE_HIDDEN, and
* @c WORD_COMPILED → @c PHYSICS_STATE_COMPILED.
*
* @param entry DictEntry to inspect (NULL returns 0)
* @return Bitmask of @c PHYSICS_STATE_* flags
*/
static uint8_t derive_state_flags(const DictEntry *entry) {
if (!entry) return 0;
uint8_t flags = 0;
if (entry->flags & WORD_IMMEDIATE) flags |= PHYSICS_STATE_IMMEDIATE;
if (entry->flags & WORD_PINNED) flags |= PHYSICS_STATE_PINNED;
if (entry->flags & WORD_HIDDEN) flags |= PHYSICS_STATE_HIDDEN;
if (entry->flags & WORD_COMPILED) flags |= PHYSICS_STATE_COMPILED;
return flags;
}
/**
* @brief Initialise physics metadata for a newly registered DictEntry.
*
* Zeroes all @c DictPhysics fields, sets @c mass_bytes to @c header_bytes
* (the byte size of the entry header), and derives initial @c state_flags
* from the entry's word flags. Called from @c register_word() immediately
* after the entry is linked into the dictionary.
*
* @param entry DictEntry to initialise
* @param header_bytes Byte size of the entry's header region (for mass)
*/
void physics_metadata_init(DictEntry *entry, uint32_t header_bytes) {
if (!entry) return;
entry->physics.temperature_q8 = 0;
entry->physics.last_active_ns = 0;
entry->physics.last_decay_ns = 0;
entry->physics.last_decay_tick = 0;
entry->physics.mass_bytes = header_bytes;
entry->physics.avg_latency_ns = 0;
entry->physics.state_flags = derive_state_flags(entry);
entry->physics.acl_hint = 0;
entry->physics.pubsub_mask = 0;
}
/**
* @brief Update the mass (byte footprint) of a DictEntry's physics metadata.
*
* Called after a colon definition or CREATE body is fully compiled so the
* mass reflects the total compiled size, not just the header.
*
* @param entry DictEntry to update
* @param total_bytes Total compiled byte size (header + body)
*/
void physics_metadata_set_mass(DictEntry *entry, uint32_t total_bytes) {
if (!entry) return;
entry->physics.mass_bytes = total_bytes;
}
/* ============================================================================
* INTENT: Update word's physics metadata after execution
* FL1: Heat accumulation feedback loop - converts raw execution_heat counter
* to smoothed temperature_q8 metric and updates activity timestamps
* WHY: Atomic heat increment (FL1) happens in execution loop; this function
* derives secondary metrics (temperature, timestamps) for observability
* ============================================================================ */
/**
* @brief Update physics metadata after a word execution completes.
*
* Derives and stores a new smoothed @c temperature_q8 from @c execution_heat,
* and updates both @c last_active_ns and @c last_decay_ns to @c now_ns.
* Called by @c physics_post_execute() on the post-execution path.
*
* @param entry DictEntry that was just executed
* @param execution_heat Current raw execution heat counter
* @param now_ns Current monotonic timestamp in nanoseconds
*/
void physics_metadata_touch(DictEntry *entry, cell_t execution_heat, uint64_t now_ns) {
if (!entry) return;
entry->physics.temperature_q8 = temperature_from_execution_heat(execution_heat, entry->physics.temperature_q8);
entry->physics.last_active_ns = now_ns;
entry->physics.last_decay_ns = now_ns;
}
/**
* @brief Re-derive and update @c state_flags for a DictEntry.
*
* Called after word flags change (e.g. IMMEDIATE is set during compilation)
* to keep the physics state flags in sync with the word flags.
*
* @param entry DictEntry whose state flags are to be refreshed
*/
void physics_metadata_refresh_state(DictEntry *entry) {
if (!entry) return;
entry->physics.state_flags = derive_state_flags(entry);
}
/**
* @brief Record an execution latency sample into the per-word EMA.
*
* Clamps @c sample_ns to uint32_t, then blends it into @c avg_latency_ns
* with a 1/4 EMA: new = (3*prior + sample) / 4. Seeds @c avg_latency_ns
* directly from the first sample.
*
* @param entry DictEntry whose latency EMA is updated
* @param sample_ns Measured execution duration in nanoseconds
*/
void physics_metadata_record_latency(DictEntry *entry, uint64_t sample_ns) {
if (!entry) return;
uint32_t sample = clamp_u32(sample_ns);
uint32_t prior = entry->physics.avg_latency_ns;
if (prior == 0) {
entry->physics.avg_latency_ns = sample;
} else {
entry->physics.avg_latency_ns = (uint32_t)((3ull * prior + sample) / 4ull);
}
}
typedef struct physics_seed_definition {
const char *name;
uint16_t temperature_q8;
uint32_t avg_latency_ns;
uint8_t acl_hint;
uint8_t pubsub_mask;
} physics_seed_definition_t;
static const physics_seed_definition_t physics_seed_table[] = {
{"IF", 0x0100u, 400u, 0, 0},
{"ELSE", 0x0100u, 400u, 0, 0},
{"THEN", 0x0100u, 350u, 0, 0},
{"BEGIN", 0x0120u, 450u, 0, 0},
{"WHILE", 0x0120u, 450u, 0, 0},
{"REPEAT", 0x0120u, 450u, 0, 0},
{"DO", 0x0180u, 500u, 0, 0},
{"LOOP", 0x0180u, 500u, 0, 0},
{"+LOOP", 0x0200u, 520u, 0, 0},
{"LEAVE", 0x0200u, 520u, 0, 0},
{".", 0x0080u, 300u, 0, 0},
{"EMIT", 0x0180u, 800u, 0, 0x02u},
{"TYPE", 0x0180u, 900u, 0, 0x02u},
{"BLOCK", 0x0200u, 950u, 0, 0x04u},
{"BUFFER", 0x01C0u, 900u, 0, 0x04u},
{"SAVE-BUFFERS", 0x0260u, 1400u, 0, 0x04u},
{"FLUSH", 0x0240u, 1200u, 0, 0x04u},
{"LOAD", 0x0220u, 1100u, 0, 0x04u},
{"LIST", 0x0200u, 1000u, 0, 0x04u},
{"SAVE-SYSTEM", 0x0280u, 2000u, 0x80u, 0x08u},
{NULL, 0, 0, 0, 0}
};
/**
* @brief Apply DoE-derived prior physics values to a named DictEntry.
*
* Searches the static @c physics_seed_table for an entry matching
* @c entry->name. If found, seeds @c temperature_q8, @c avg_latency_ns,
* @c acl_hint, and @c pubsub_mask with values derived from the 2^7
* factorial DoE analysis. Only non-zero seed fields overwrite the current
* value. Called from @c register_word() for built-in primitives.
*
* @param entry DictEntry to seed (no-op if NULL or no matching table entry)
*/
void physics_metadata_apply_seed(DictEntry *entry) {
if (!entry || !entry->name_len) return;
for (const physics_seed_definition_t *seed = physics_seed_table; seed->name; ++seed) {
if ((int) strlen(seed->name) != entry->name_len) continue;
if (strncmp(seed->name, entry->name, entry->name_len) != 0) continue;
if (seed->temperature_q8) entry->physics.temperature_q8 = seed->temperature_q8;
if (seed->avg_latency_ns) entry->physics.avg_latency_ns = seed->avg_latency_ns;
if (seed->acl_hint) entry->physics.acl_hint = seed->acl_hint;
if (seed->pubsub_mask) entry->physics.pubsub_mask = seed->pubsub_mask;
break;
}
}
/*
* ============================================================================
* Phase 2: Linear Decay Mechanism
* ============================================================================
*
* Reduces execution_heat over time to model:
* - OS context switches (old task's heat becomes stale)
* - Temporal locality (recent access patterns > distant past)
* - Dissipation (physical analogy: thermal equilibrium)
*
* Mathematical Model (Discrete Linear):
* H(t) = max(0, H_0 - d*t)
*
* Where:
* H(t) = heat at time t
* H_0 = initial heat
* d = decay rate (heat units per heartbeat tick)
* t = heartbeat ticks elapsed since last execution -- never wall-clock
* time; see physics_metadata_apply_linear_decay()'s doc comment
*
* Frozen words (WORD_FROZEN flag) are exempt from decay.
* ============================================================================
*/
/**
* @brief Apply Loop #3 linear heat decay to a DictEntry.
*
* Implements the thermodynamic dissipation model: H(t) = max(0, H₀ - d*t),
* where t is measured in heartbeat ticks (@c vm->heartbeat.tick_count),
* never in wall-clock time. The decay amount is computed as
* (elapsed_ticks * slope_q48) >> 16 using the Q48.16 adaptive decay slope
* stored in the VM's heartbeat state. Uses a GCC CAS loop for atomic heat
* update when @c __GNUC__ is defined, falling back to a plain subtraction
* otherwise.
*
* Ticks, not nanoseconds: this entry's @c execution_heat feeds directly
* into @c dict_hash (see @c capsule_dict_hash_hook()), so any wall-clock
* dependency here makes dictionary state -- and therefore dict_hash --
* architecture-variable under QEMU/TCG's differing real emulation speed,
* or whenever real elapsed time between two touches of the same entry
* varies for reasons unrelated to execution (e.g. a blocking I/O wait
* between them). @c vm->heartbeat.tick_count only advances from
* @c vm_tick(), called synchronously from the interpreter's own dispatch
* path -- a purely execution-count-driven clock, immune to how long any
* intervening real-time work (including blocking I/O) actually took.
*
* No-op when:
* - @c WORD_FROZEN flag is set on the entry
* - @c elapsed_ticks == 0 (no heartbeat tick has fired since last decay)
* - @c vm->ssm_config has L3 disabled by the Jacquard mode selector
*
* @param entry DictEntry whose heat is decayed
* @param elapsed_ticks Heartbeat ticks elapsed since last decay application
* @param vm VM providing the adaptive decay slope and L3 gate flag
*/
void physics_metadata_apply_linear_decay(DictEntry *entry, uint64_t elapsed_ticks, VM *vm) {
if (!entry || !vm) {
return;
}
/* Frozen words do not decay */
if (entry->flags & WORD_FROZEN) {
return;
}
/* Don't bother when no tick has fired since the last application */
if (elapsed_ticks == 0) {
return;
}
/* L8 GATE: Check if L3 (linear decay) is enabled by Jacquard mode selector */
if (vm->ssm_config) {
ssm_config_t *config = (ssm_config_t*)vm->ssm_config;
if (!config->L3_linear_decay) {
return; /* L3 disabled by L8 mode selector */
}
}
/* ========================================================================
* INTENT: Calculate decay amount using adaptive Q48.16 fixed-point math
* FL1: Heat decay - counterbalances FL1 accumulation to prevent runaway
* FL3: Adaptive slope tuning - inference engine adjusts decay_slope_q48
* based on statistical analysis of heat trajectory effectiveness
* WHY: decay_slope_q48 is expressed as heat units per tick, not per
* microsecond -- the inference engine (Loop #6) adaptively
* calibrates it against whatever units it's actually applied in,
* so no conversion constant is needed here, just a consistent unit.
* ======================================================================== */
uint64_t slope_q48 = physics_decay_slope_load(vm);
uint64_t decay_amount_raw = (elapsed_ticks * slope_q48) >> 16;
/* Clamp to cell_t range (avoid overflow) */
cell_t decay_amount = (decay_amount_raw > (uint64_t)0x7FFFFFFFFFFFFFFF)
? 0x7FFFFFFFFFFFFFFF
: (cell_t)decay_amount_raw;
if (decay_amount == 0) {
return;
}
#if defined(__GNUC__)
cell_t old_heat;
cell_t new_heat;
do {
old_heat = __atomic_load_n(&entry->execution_heat, __ATOMIC_RELAXED);
if (old_heat == 0) {
return;
}
new_heat = (decay_amount >= old_heat) ? 0 : (old_heat - decay_amount);
} while (!__atomic_compare_exchange_n(&entry->execution_heat,
&old_heat,
new_heat,
0,
__ATOMIC_RELAXED,
__ATOMIC_RELAXED));
#else
if (decay_amount >= entry->execution_heat) {
entry->execution_heat = 0;
} else {
entry->execution_heat -= decay_amount;
}
#endif
}
v3/src/physics_pipelining_metrics.c
+754
View File
@@ -0,0 +1,754 @@
/*
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 ***
physics_pipelining_metrics.c - Word transition tracking implementation
Tracks word-to-word transitions to support speculative execution/pipelining.
Uses only fixed-point Q48.16 arithmetic (no floating-point).
*/
#include "physics_pipelining_metrics.h"
#include "vm.h"
#include <stdlib.h>
#include <string.h>
#include <stdio.h>
/* ============================================================================
* Q48.16 Fixed-Point Arithmetic Helpers
* ============================================================================
*/
/**
* @brief Convert a nanosecond count to Q48.16 fixed-point.
*
* Shifts @p ns left by 16 bits to produce a Q48.16 value where the integer
* part represents nanoseconds (1.0 ns = 65536 in Q48.16). Used to convert
* raw platform nanosecond timestamps into the common Q48.16 format before
* accumulating into @c prefetch_latency_saved_q48 and
* @c misprediction_cost_q48.
*
* @param ns Integer nanosecond value to convert.
* @return @p ns in Q48.16 format (@p ns × 65536).
*/
static inline int64_t ns_to_q48(int64_t ns) {
return ns << 16;
}
/**
* @brief Convert a Q48.16 fixed-point value to integer nanoseconds (truncated).
*
* Shifts @p q48 right by 16 bits, discarding the fractional part. The result
* is the integer nanosecond count represented by the Q48.16 value. Used in
* @c transition_metrics_stats_string() to convert the accumulated
* @c prefetch_latency_saved_q48 and @c misprediction_cost_q48 back to
* human-readable nanosecond integers for the stats report string.
*
* @param q48 Value in Q48.16 format.
* @return Integer nanosecond equivalent (truncated, not rounded).
*/
static inline int64_t q48_to_ns(int64_t q48) {
return q48 >> 16;
}
/**
* @brief Divide a Q48.16 value by a @c uint64_t, returning Q48.16.
*
* Computes @p a_q48 / @p b using integer division. The result preserves the
* Q48.16 scaling of @p a_q48 because @p b is dimensionless. Guards against
* divide-by-zero by returning 0 when @p b == 0. Used by
* @c transition_metrics_get_probability_q48() to compute the per-word
* transition probability:
* @code
* P(next = w) = (count_q48 << 16) / total_transitions
* @endcode
* where @c count_q48 = (uint64_t)count << 16 and @c total_transitions is the
* denominator @p b.
*
* @param a_q48 Numerator in Q48.16 format.
* @param b Denominator as a plain @c uint64_t (dimensionless count).
* @return @p a_q48 / @p b in Q48.16; 0 if @p b == 0.
*/
static inline int64_t q48_div_u64(int64_t a_q48, uint64_t b) {
if (b == 0) return 0;
return a_q48 / (int64_t)b;
}
/* ============================================================================
* Transition Metrics Implementation
* ============================================================================
*/
/**
* @brief Initialise a @c WordTransitionMetrics structure to its empty, ready-to-record state.
*
* Sets all counter and accumulator fields to zero and performs the following
* allocations:
*
* - @c metrics->transition_heat is left NULL — it is lazily allocated by the
* first call to @c transition_metrics_record() to avoid the @c dict_size
* parameter being required at construction time.
*
* - If @c TRANSITION_WINDOW_SIZE > 0, allocates @c metrics->context_window as
* a zero-filled array of @c TRANSITION_WINDOW_SIZE @c uint32_t word IDs and
* sets @c metrics->actual_window_size accordingly. If the allocation fails,
* @c actual_window_size is set to 0 and context tracking degrades gracefully
* (all context functions become no-ops).
*
* - @c metrics->context_transitions is left NULL — it is lazily allocated when
* Phase 2 context-pattern analysis is implemented.
*
* Returns 0 on success or −1 if @p metrics is NULL.
*
* @param metrics The @c WordTransitionMetrics to initialise; must not be NULL.
* @return 0 on success; −1 if @p metrics is NULL.
*/
int transition_metrics_init(WordTransitionMetrics *metrics) {
if (!metrics) return -1;
metrics->transition_heat = NULL; /* Lazy allocation on first use */
metrics->total_transitions = 0;
metrics->prefetch_attempts = 0;
metrics->prefetch_hits = 0;
metrics->prefetch_misses = 0;
metrics->prefetch_latency_saved_q48 = 0;
metrics->misprediction_cost_q48 = 0;
metrics->max_transition_probability_q48 = 0;
metrics->most_likely_next_word_id = 0;
/* Phase 1 Extension: Initialize context window (window size = 2 by default) */
if (TRANSITION_WINDOW_SIZE > 0) {
metrics->context_window = (uint32_t *)calloc(TRANSITION_WINDOW_SIZE, sizeof(uint32_t));
if (metrics->context_window) {
metrics->actual_window_size = TRANSITION_WINDOW_SIZE;
metrics->context_window_pos = 0;
} else {
metrics->actual_window_size = 0; /* Degraded: no context tracking */
}
} else {
metrics->actual_window_size = 0;
}
metrics->context_transitions = NULL; /* Lazy allocation on first context transition */
metrics->total_context_transitions = 0;
return 0;
}
/**
* @brief Record one word-to-word transition in the transition heat table.
*
* Called from the interpreter loop each time a word executes and there is a
* known previous word. Increments @c metrics->transition_heat[next_word_id]
* by one and @c metrics->total_transitions by one.
*
* **Lazy allocation:** The @c transition_heat array is not allocated at
* @c transition_metrics_init() time; on the first call when
* @c metrics->transition_heat == NULL, it is allocated as a zero-filled
* array of @p dict_size @c uint64_t counters. If the allocation fails −1 is
* returned and the transition is silently dropped.
*
* If @p next_word_id ≥ @p dict_size the call is rejected with −1 to prevent
* an out-of-bounds write into @c transition_heat (which was allocated with
* size @p dict_size).
*
* The accumulated @c transition_heat[] table is consumed by
* @c transition_metrics_get_probability_q48() and
* @c transition_metrics_update_cache() to determine the most-likely next word
* for speculative prefetch.
*
* @param metrics The metrics structure to update.
* @param next_word_id Zero-based word ID of the word that followed the
* current word; must be < @p dict_size.
* @param dict_size Current dictionary size, used both as the bounds
* check for @p next_word_id and as the allocation size
* for the lazy-allocated @c transition_heat array.
* @return 0 on success; −1 on NULL @p metrics, out-of-bounds
* @p next_word_id, or allocation failure.
*/
int transition_metrics_record(WordTransitionMetrics *metrics, uint32_t next_word_id, uint32_t dict_size) {
if (!metrics || next_word_id >= dict_size) {
return -1;
}
/* Lazy allocation: only allocate transition_heat array when first transition occurs */
if (!metrics->transition_heat) {
metrics->transition_heat = (uint64_t *)calloc(dict_size, sizeof(uint64_t));
if (!metrics->transition_heat) {
return -1; /* Memory allocation failure */
}
}
/* Record the transition */
metrics->transition_heat[next_word_id]++;
metrics->total_transitions++;
return 0;
}
/**
* @brief Return the transition probability to @p target_word_id in Q48.16 format.
*
* Computes P(next = @p target_word_id | current word) as a Q48.16 fixed-point
* ratio:
* @code
* P = (transition_heat[target_word_id] << 16) / total_transitions
* @endcode
* using @c q48_div_u64() to guard against divide-by-zero.
*
* Returns 0 if:
* - @p metrics is NULL.
* - @c metrics->total_transitions == 0 (no transitions recorded yet).
* - @c metrics->transition_heat is NULL (lazy allocation has not occurred).
*
* The caller is responsible for ensuring @p target_word_id is within the
* bounds of the allocated @c transition_heat array; this function does not
* re-check bounds after verifying the NULL guard above (bounds were enforced
* during @c transition_metrics_record()).
*
* Consumed by @c transition_metrics_update_cache() (scans all words to find
* the maximum) and @c transition_metrics_should_speculate() (checks whether
* a specific word's probability exceeds @c SPECULATION_THRESHOLD_Q48).
*
* @param metrics The metrics structure to query.
* @param target_word_id Zero-based word ID whose transition probability is
* requested; must be within the dict_size used at record time.
* @return P(next = @p target_word_id) in Q48.16; 0 if unavailable.
*/
int64_t transition_metrics_get_probability_q48(const WordTransitionMetrics *metrics, uint32_t target_word_id) {
if (!metrics || metrics->total_transitions == 0) {
return 0;
}
/* Safety: Bounds check on target_word_id to prevent out-of-bounds read
* Note: transition_heat is allocated with dict_size passed to transition_metrics_record()
* Callers must ensure target_word_id < dict_size used during allocation */
if (!metrics->transition_heat) {
return 0;
}
uint64_t count = metrics->transition_heat[target_word_id];
/* Probability = count / total_transitions, in Q48.16 format */
/* = (count << 16) / total_transitions */
int64_t count_q48 = (int64_t)count << 16;
return q48_div_u64(count_q48, metrics->total_transitions);
}
/**
* @brief Scan the transition heat table and cache the highest-probability next word.
*
* Iterates over all @p dict_size entries in @c metrics->transition_heat[],
* calling @c transition_metrics_get_probability_q48() for each non-zero entry
* and tracking the maximum. After the scan:
* - @c metrics->max_transition_probability_q48 holds the peak probability (Q48.16).
* - @c metrics->most_likely_next_word_id holds the word ID of that peak.
*
* These two cached fields allow @c transition_metrics_should_speculate() to
* make a prefetch decision in O(1) without re-scanning the full table on every
* word dispatch.
*
* If @p metrics, @c transition_heat, or @c total_transitions are not valid,
* both fields are reset to 0 and the function returns immediately.
*
* Called after each @c transition_metrics_record() in the high-frequency
* interpreter path, so the implementation must be fast. The full @p dict_size
* scan runs in O(dict_size) and skips zero-count entries early.
*
* @param metrics The metrics structure to update.
* @param dict_size Number of entries in @c metrics->transition_heat[];
* must match the size used at allocation time.
*/
void transition_metrics_update_cache(WordTransitionMetrics *metrics, uint32_t dict_size) {
if (!metrics || !metrics->transition_heat || metrics->total_transitions == 0) {
metrics->max_transition_probability_q48 = 0;
metrics->most_likely_next_word_id = 0;
return;
}
int64_t max_prob_q48 = 0;
uint32_t max_idx = 0;
/* Find word with highest transition count */
for (uint32_t i = 0; i < dict_size; i++) {
if (metrics->transition_heat[i] > 0) {
int64_t prob_q48 = transition_metrics_get_probability_q48(metrics, i);
if (prob_q48 > max_prob_q48) {
max_prob_q48 = prob_q48;
max_idx = i;
}
}
}
metrics->max_transition_probability_q48 = max_prob_q48;
metrics->most_likely_next_word_id = max_idx;
}
/**
* @brief Record a successful speculative prefetch and the latency it saved.
*
* Increments @c metrics->prefetch_hits by one and accumulates @p latency_saved_ns
* (converted to Q48.16 via @c ns_to_q48()) into
* @c metrics->prefetch_latency_saved_q48. The accumulated total is reported by
* @c transition_metrics_stats_string() as the aggregate latency benefit of
* correct speculation.
*
* Called by the speculative-execution path when a prefetched word matches the
* word that was actually executed next.
*
* @param metrics The metrics structure to update; no-op if NULL.
* @param latency_saved_ns The number of nanoseconds saved by avoiding a
* full dictionary lookup on this particular hit.
*/
void transition_metrics_record_prefetch_hit(WordTransitionMetrics *metrics, int64_t latency_saved_ns) {
if (!metrics) return;
metrics->prefetch_hits++;
metrics->prefetch_latency_saved_q48 += ns_to_q48(latency_saved_ns);
}
/**
* @brief Record a failed speculative prefetch and its recovery overhead.
*
* Increments @c metrics->prefetch_misses by one and accumulates
* @p recovery_cost_ns (converted to Q48.16 via @c ns_to_q48()) into
* @c metrics->misprediction_cost_q48. The accumulated total is the aggregate
* penalty paid for incorrect speculation and is reported by
* @c transition_metrics_stats_string() as "Misprediction Cost".
*
* The net benefit of the pipelining subsystem is:
* @code
* net_ns = prefetch_latency_saved_q48 - misprediction_cost_q48
* @endcode
* A positive net indicates that speculation is profitable overall.
*
* Called by the speculative-execution path when the prefetched word does not
* match the word that was actually executed next (branch misprediction analogue).
*
* @param metrics The metrics structure to update; no-op if NULL.
* @param recovery_cost_ns The number of nanoseconds spent unwinding the
* incorrect speculation (cache flush, state restore).
*/
void transition_metrics_record_prefetch_miss(WordTransitionMetrics *metrics, int64_t recovery_cost_ns) {
if (!metrics) return;
metrics->prefetch_misses++;
metrics->misprediction_cost_q48 += ns_to_q48(recovery_cost_ns);
}
/**
* @brief Decide whether to speculatively prefetch @p target_word_id.
*
* Applies a two-gate policy before authorising speculation:
*
* 1. **Minimum sample gate:** @c metrics->total_transitions must be ≥
* @c MIN_SAMPLES_FOR_SPECULATION. Below this threshold the transition
* probabilities are statistically unreliable — speculation would be
* indistinguishable from guessing.
*
* 2. **Probability threshold gate:** the Q48.16 probability returned by
* @c transition_metrics_get_probability_q48(metrics, @p target_word_id)
* must be ≥ @c SPECULATION_THRESHOLD_Q48. Words with very low conditional
* probability of following the current word are not worth prefetching.
*
* Both gates must pass for the function to return 1. A Phase 4 ROI check
* (comparing expected latency savings against expected misprediction cost) is
* planned but not yet implemented; a TODO comment marks the extension point.
*
* Returns 0 if @p metrics or @c transition_heat are NULL, or if either gate
* fails.
*
* @param metrics The metrics structure to consult.
* @param target_word_id Zero-based ID of the candidate next word.
* @return 1 if speculation is recommended; 0 otherwise.
*/
int transition_metrics_should_speculate(const WordTransitionMetrics *metrics, uint32_t target_word_id) {
if (!metrics || !metrics->transition_heat) {
return 0; /* No data yet */
}
/* Check: do we have enough samples? */
if (metrics->total_transitions < MIN_SAMPLES_FOR_SPECULATION) {
return 0; /* Not enough data */
}
/* Get probability of this word following */
int64_t prob_q48 = transition_metrics_get_probability_q48(metrics, target_word_id);
/* Check: does probability exceed threshold? */
if (prob_q48 < SPECULATION_THRESHOLD_Q48) {
return 0; /* Probability too low */
}
/* TODO: Phase 4 - Add ROI check here */
/* For now, threshold check is sufficient */
return 1; /* Should speculate */
}
/**
* @brief Allocate and return a human-readable transition metrics summary string.
*
* Allocates a 2048-byte buffer and fills it with a multi-line report:
* - Total transitions recorded.
* - Prefetch attempts, hits (with hit-rate %), and misses.
* - Aggregate latency saved by correct speculation (from
* @c prefetch_latency_saved_q48, converted to integer ns via @c q48_to_ns()).
* - Aggregate misprediction cost (from @c misprediction_cost_q48).
* - Net benefit (saved − cost) in nanoseconds.
* - The most-likely next word ID and its raw Q48.16 probability.
*
* The caller is responsible for calling @c free() on the returned pointer.
* Returns NULL if @p metrics is NULL or @c malloc() fails.
*
* @param metrics The metrics structure to summarise.
* @return Heap-allocated NUL-terminated stats string; caller must @c free().
* NULL on allocation failure or NULL @p metrics.
*/
char *transition_metrics_stats_string(const WordTransitionMetrics *metrics) {
if (!metrics) return NULL;
/* Allocate buffer for stats string */
char *buf = (char *)malloc(2048);
if (!buf) return NULL;
int saved_ns = q48_to_ns(metrics->prefetch_latency_saved_q48);
int cost_ns = q48_to_ns(metrics->misprediction_cost_q48);
int net_ns = saved_ns - cost_ns;
/* Calculate hit rate */
uint64_t total_speculations = metrics->prefetch_attempts;
double hit_rate = (total_speculations > 0) ? (100.0 * metrics->prefetch_hits / total_speculations) : 0.0;
snprintf(buf, 2048,
"Transition Statistics:\n"
" Total Transitions: %lu\n"
" Prefetch Attempts: %lu\n"
" Prefetch Hits: %lu (%.1f%% hit rate)\n"
" Prefetch Misses: %lu\n"
" Latency Saved: %d ns\n"
" Misprediction Cost: %d ns\n"
" Net Benefit: %d ns\n"
" Most Likely Next: word[%u] (P=0x%lx Q48.16)\n",
metrics->total_transitions,
metrics->prefetch_attempts,
metrics->prefetch_hits, hit_rate,
metrics->prefetch_misses,
saved_ns,
cost_ns,
net_ns,
metrics->most_likely_next_word_id,
metrics->max_transition_probability_q48);
return buf;
}
/**
* @brief Reset a @c WordTransitionMetrics to empty without freeing the context window.
*
* Frees and NULLs @c metrics->transition_heat (so the next
* @c transition_metrics_record() will re-allocate it), then zeroes all
* counter and accumulator fields. Also zeroes the context-window array
* (if allocated) and resets @c context_window_pos to 0, and frees and NULLs
* @c context_transitions. @c actual_window_size and the @c context_window
* pointer itself are preserved — the window stays allocated and ready for
* reuse.
*
* Intended for DoE benchmark runs that need a clean statistical baseline
* between treatment cells without the overhead of full teardown and
* reinitialisation. Cheaper than @c transition_metrics_cleanup() +
* @c transition_metrics_init() because it avoids reallocating the context
* window.
*
* @param metrics The metrics structure to reset; no-op if NULL.
*/
void transition_metrics_reset(WordTransitionMetrics *metrics) {
if (!metrics) return;
if (metrics->transition_heat) {
free(metrics->transition_heat);
metrics->transition_heat = NULL;
}
metrics->total_transitions = 0;
metrics->prefetch_attempts = 0;
metrics->prefetch_hits = 0;
metrics->prefetch_misses = 0;
metrics->prefetch_latency_saved_q48 = 0;
metrics->misprediction_cost_q48 = 0;
metrics->max_transition_probability_q48 = 0;
metrics->most_likely_next_word_id = 0;
/* Phase 1 Extension: Reset context window */
if (metrics->context_window) {
memset(metrics->context_window, 0, metrics->actual_window_size * sizeof(uint32_t));
metrics->context_window_pos = 0;
}
if (metrics->context_transitions) {
free(metrics->context_transitions);
metrics->context_transitions = NULL;
}
metrics->total_context_transitions = 0;
}
/**
* @brief Release all heap memory held by a @c WordTransitionMetrics.
*
* Frees and NULLs:
* - @c metrics->transition_heat — the per-word transition count array.
* - @c metrics->context_window — the sliding context-window array.
* - @c metrics->context_transitions — the Phase 2 sparse hash table (if allocated).
*
* Does NOT zero the struct fields beyond NULLing the freed pointers. The
* caller must not use @p metrics after this call without a subsequent
* @c transition_metrics_init(). Contrast with @c transition_metrics_reset(),
* which keeps the context window allocated for reuse.
*
* No-op if @p metrics is NULL.
*
* @param metrics The metrics structure to clean up; no-op if NULL.
*/
void transition_metrics_cleanup(WordTransitionMetrics *metrics) {
if (!metrics) return;
if (metrics->transition_heat) {
free(metrics->transition_heat);
metrics->transition_heat = NULL;
}
/* Phase 1 Extension: Clean up context window */
if (metrics->context_window) {
free(metrics->context_window);
metrics->context_window = NULL;
}
if (metrics->context_transitions) {
free(metrics->context_transitions);
metrics->context_transitions = NULL;
}
}
/* ============================================================================
* Context-Aware Transition Functions (Phase 1 Extension)
* ============================================================================
*
* Phase 1: Collect data only (these functions are stubs)
* Phase 2: Implement analysis logic
* Phase 3: Use for adaptive decisions
*/
/**
* @brief Slide the context window forward by one word, appending @p word_id.
*
* Implements a fixed-length sliding window over the recent word-ID history.
* Each call shifts all existing entries one position to the left (dropping
* the oldest), then writes @p word_id into the last slot:
* @code
* context_window[0..n-2] = context_window[1..n-1]
* context_window[n-1] = word_id
* @endcode
* This produces a FIFO queue of the last @c actual_window_size word IDs
* that can be passed to @c transition_metrics_record_context() for
* context-sensitive transition tracking (Phase 2).
*
* Returns −1 and is a no-op if:
* - @p metrics is NULL.
* - @c context_window is NULL (allocation at init failed — degraded mode).
* - @c actual_window_size == 0.
*
* @param metrics The metrics structure whose context window is updated.
* @param word_id The word ID just executed; appended to the right of the window.
* @return 0 on success; −1 if the context window is unavailable.
*/
int transition_metrics_update_context_window(WordTransitionMetrics *metrics, uint32_t word_id) {
if (!metrics || !metrics->context_window || metrics->actual_window_size == 0) {
return -1; /* Context tracking not initialized */
}
/* Slide window forward: shift elements left, add new word on right */
for (uint32_t i = 0; i < metrics->actual_window_size - 1; i++) {
metrics->context_window[i] = metrics->context_window[i + 1];
}
/* Add new word at end of window */
metrics->context_window[metrics->actual_window_size - 1] = word_id;
return 0;
}
/**
* @brief Record a context-conditioned transition (Phase 1 collection stub).
*
* Accepts a @p context window of @p window_size preceding word IDs and the
* @p next_word_id that followed. In Phase 1 only the total count is tracked:
* @c metrics->total_context_transitions is incremented by one, providing a
* baseline count that Phase 2 analysis can use to size its hash tables.
*
* **Phase 2 TODO:** Build a sparse hash table keyed on the context pattern
* @c (context[0], …, context[window_size-1]) to record per-context next-word
* distributions. The Phase 2 analysis will feed
* @c transition_metrics_binary_chop_suggest_window() with accuracy data to
* tune the optimal window size.
*
* Returns −1 (no-op) if @p metrics or @p context are NULL, @p window_size is
* 0, or @p next_word_id ≥ @p dict_size.
*
* @param metrics The metrics structure to update.
* @param context Array of @p window_size word IDs preceding @p next_word_id.
* @param window_size Number of entries in @p context; must be > 0.
* @param next_word_id Word ID that followed the context sequence.
* @param dict_size Current dictionary size; used for bounds checking
* @p next_word_id.
* @return 0 on success; −1 on invalid arguments.
*/
int transition_metrics_record_context(WordTransitionMetrics *metrics,
const uint32_t *context,
uint32_t window_size,
uint32_t next_word_id,
uint32_t dict_size) {
if (!metrics || !context || window_size == 0 || next_word_id >= dict_size) {
return -1;
}
/* Phase 1: Just count total context transitions for validation */
metrics->total_context_transitions++;
/* TODO Phase 2: Build sparse hash table of context patterns
* For now, we collect data but don't analyze it.
* This is the foundation for Phase 2's binary chop tuning.
*/
return 0;
}
/**
* @brief Allocate and return a context-window status report string (Phase 1 stub).
*
* Allocates a 1024-byte buffer and fills it with a brief Phase 1 collection
* status message:
* - @c actual_window_size — the active window width (0 if allocation failed).
* - @c total_context_transitions — the number of context transitions recorded.
* - A "[Phase 1 Collection - Phase 2 Analysis Pending]" status line.
*
* Phase 2 will replace this stub with a real accuracy report showing per-window-size
* prediction accuracy derived from the sparse context-pattern hash table. The
* accuracy data will feed @c transition_metrics_binary_chop_suggest_window()
* to converge on the optimal context window width.
*
* The caller is responsible for calling @c free() on the returned pointer.
* Returns NULL if @p metrics is NULL or @c malloc() fails.
*
* @param metrics The metrics structure to report on.
* @return Heap-allocated NUL-terminated string; caller must @c free().
* NULL on allocation failure or NULL @p metrics.
*/
char *transition_metrics_context_accuracy_string(const WordTransitionMetrics *metrics) {
if (!metrics) return NULL;
char *buf = (char *)malloc(1024);
if (!buf) return NULL;
/* Phase 1: Stub - just report collection status */
snprintf(buf, 1024,
"Context Metrics Status:\n"
" Actual Window Size: %u\n"
" Total Context Transitions: %lu\n"
" Status: [Phase 1 Collection - Phase 2 Analysis Pending]\n",
metrics->actual_window_size,
metrics->total_context_transitions);
return buf;
}
/**
* @brief Suggest a new context window size using binary-chop search (Phase 1 stub).
*
* In Phase 2 this function will implement a binary-chop search over window sizes
* to converge on the width that maximises context-prediction accuracy:
* - Start at window = 2.
* - If accuracy improves when doubling, try 4; if it declines, try 1.
* - Continue halving/doubling until the accuracy delta falls below a threshold.
*
* **Phase 1 stub behaviour:** Doubles the current window each call up to 8,
* then wraps back to 1:
* - @p current_window == 1 → suggests 2
* - @p current_window == 2 → suggests 4
* - @p current_window == 4 → suggests 8
* - @p current_window ≥ 8 → suggests 1 (cycle back)
* - Any other value → returns @p current_window unchanged.
*
* The @p accuracy_at_current parameter (prediction accuracy [0.0, 1.0] at the
* current window size) is accepted for API stability with the Phase 2 caller
* but is not used in the stub.
*
* @param metrics The metrics structure (unused in Phase 1 stub;
* reserved for Phase 2 accuracy history).
* @param current_window Currently active context window size.
* @param accuracy_at_current Prediction accuracy at @p current_window
* (unused in Phase 1 stub; range [0.0, 1.0]).
* @return Suggested new window size.
*/
uint32_t transition_metrics_binary_chop_suggest_window(const WordTransitionMetrics *metrics,
uint32_t current_window,
double accuracy_at_current) {
(void)metrics;
(void)accuracy_at_current;
/* Phase 1: Stub - just return doubled window size per user's request
* Phase 2 will implement actual binary chop search:
* - Start at window=2
* - If accuracy improves, try doubling (2→4)
* - If accuracy declines, try halving (4→2)
* - Converge to optimal size
*/
if (current_window >= 8) return 1; /* Maximum: back to 1 */
if (current_window == 1) return 2; /* 1 → 2 */
if (current_window == 2) return 4; /* 2 → 4 (doubling) */
if (current_window == 4) return 8; /* 4 → 8 (doubling) */
return current_window; /* Fallback */
}
v3/src/physics_runtime.c
+720
View File
@@ -0,0 +1,720 @@
/*
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 ***
physics_runtime.c - Phase 1 physics runtime scaffolding
Implements the host snapshot shim (POSIX) and provides a
fixed-size analytics heap compatible with the HOLA shared-memory layout.
The implementation favours predictable costs and clear extension points for
future governance-approved features.
*/
#include "physics_runtime.h"
#include "platform_time.h"
/* STARFORTH_MINIMAL: kernel build — skip Linux /proc runtime monitoring.
* Provide stub API so vmcore link succeeds; none of these are called. */
#if defined(STARFORTH_MINIMAL)
int physics_runtime_init(size_t analytics_heap_bytes)
{ (void)analytics_heap_bytes; return 0; }
void physics_runtime_shutdown(void) {}
int physics_analytics_publish_event(uint32_t channel, const void *payload, uint16_t payload_bytes)
{ (void)channel; (void)payload; (void)payload_bytes; return 0; }
int physics_host_snapshot(physics_host_snapshot_t *out)
{ (void)out; return -1; }
#else /* !STARFORTH_MINIMAL — full Linux/POSIX implementation below */
#include <errno.h>
#include <inttypes.h>
#include <limits.h>
#include <stdlib.h>
#include <string.h>
#include <stdio.h>
#ifndef PATH_MAX
#define PATH_MAX 4096
#endif
/* HISTORICAL: L4Re support has been removed as an active target.
* #ifdef __l4__
* #include <l4/sys/kip.h>
* #include <l4/re/env.h>
* #endif
*/
#include <sched.h>
#include <sys/time.h>
#include <sys/types.h>
#include <time.h>
#include <unistd.h>
#include <ctype.h>
/* ------------------------------------------------------------------------- */
/* Analytics heap internals */
/* ------------------------------------------------------------------------- */
typedef struct physics_runtime_state {
physics_analytics_heap_t heap;
int heap_ready;
uint64_t backend_seq;
} physics_runtime_state_t;
static physics_runtime_state_t g_runtime = {0};
/**
* @brief Round @c value up to the next multiple of @c alignment.
*
* @c alignment must be a power of two. Used internally to satisfy
* cache-line and struct alignment requirements in the analytics heap.
*
* @param value Value to align
* @param alignment Alignment boundary (must be power of two)
* @return Smallest multiple of @c alignment that is >= @c value
*/
static size_t align_up(size_t value, size_t alignment) {
return (value + alignment - 1u) & ~(alignment - 1u);
}
/* HISTORICAL: this whole section (through the matching "!__l4__" comment
* below) was wrapped in `#if !defined(__l4__)` -- these PSI/cgroup helpers
* are Linux-specific and were excluded from L4Re builds. L4Re support has
* been removed as an active target, so the guard (now always-true) has
* been removed too. */
/**
* @brief Parse a floating-point average field from a Linux PSI file line.
*
* Searches @c line for @c tag (e.g. @c "avg10="), reads the following
* floating-point value, and returns it scaled to millipercentage (×1000).
* Returns 0 on parse failure or negative value.
*
* @param line Raw text line from a @c /proc/pressure/ PSI file (cpu, memory, or io)
* @param tag Field prefix to locate (e.g. @c "avg10=")
* @return Scaled value in milli-units, or 0 on failure
*/
static uint32_t parse_avg_milli(const char *line, const char *tag) {
const char *p = strstr(line, tag);
if (!p) return 0;
p += strlen(tag);
errno = 0;
char *end = NULL;
double value = strtod(p, &end);
if (errno != 0 || end == p || value < 0.0) {
return 0;
}
double scaled = value * 1000.0;
if (scaled > (double) UINT32_MAX) scaled = (double) UINT32_MAX;
return (uint32_t)(scaled + 0.5);
}
/**
* @brief Read a Linux Pressure Stall Information (PSI) file.
*
* Parses @c /proc/pressure/{cpu,io,memory} and populates the six output
* pointers with avg10/avg60/avg300 milli-values for both the @c some and
* @c full stall categories. Any output pointer may be NULL to skip that field.
* Returns a bitmask: bit 0 set if @c some line was found, bit 1 if @c full.
*
* @param path Path to PSI file (e.g. @c "/proc/pressure/cpu")
* @param some10 avg10 for the @c some stall category (milli-units), or NULL
* @param some60 avg60 for the @c some stall category, or NULL
* @param some300 avg300 for the @c some stall category, or NULL
* @param full10 avg10 for the @c full stall category, or NULL
* @param full60 avg60 for the @c full stall category, or NULL
* @param full300 avg300 for the @c full stall category, or NULL
* @return Bitmask of parsed sections (0 = none, 1 = some, 2 = full, 3 = both)
*/
static int read_psi_file(const char *path,
uint32_t *some10, uint32_t *some60, uint32_t *some300,
uint32_t *full10, uint32_t *full60, uint32_t *full300) {
FILE *f = fopen(path, "r");
if (!f) {
return 0;
}
char line[256];
int mask = 0;
while (fgets(line, sizeof(line), f)) {
if (strncmp(line, "some", 4) == 0) {
if (some10) *some10 = parse_avg_milli(line, "avg10=");
if (some60) *some60 = parse_avg_milli(line, "avg60=");
if (some300) *some300 = parse_avg_milli(line, "avg300=");
mask |= 1;
} else if (strncmp(line, "full", 4) == 0) {
if (full10) *full10 = parse_avg_milli(line, "avg10=");
if (full60) *full60 = parse_avg_milli(line, "avg60=");
if (full300) *full300 = parse_avg_milli(line, "avg300=");
mask |= 2;
}
}
fclose(f);
return mask;
}
/**
* @brief Read aggregate CPU jiffy totals from @c /proc/stat.
*
* Parses the first @c cpu line from @c /proc/stat and sums user, nice, system,
* idle, iowait, irq, softirq, and steal columns into @c *total. The idle
* estimate is @c idle_j + @c iowait. Either output pointer may be NULL.
*
* @param total Output: total jiffy count across all categories
* @param idle Output: idle + iowait jiffies (effective idle)
* @return 0 on success, -1 on file open or parse failure
*/
static int read_proc_stat_totals(uint64_t *total, uint64_t *idle) {
FILE *f = fopen("/proc/stat", "r");
if (!f) {
return -1;
}
char line[256];
if (!fgets(line, sizeof(line), f)) {
fclose(f);
return -1;
}
fclose(f);
unsigned long long user = 0, nice = 0, system = 0, idle_j = 0;
unsigned long long iowait = 0, irq = 0, softirq = 0, steal = 0;
int scanned = sscanf(line, "cpu %llu %llu %llu %llu %llu %llu %llu %llu",
&user, &nice, &system, &idle_j, &iowait, &irq, &softirq, &steal);
if (scanned < 4) {
return -1;
}
unsigned long long total_j = user + nice + system + idle_j + iowait + irq + softirq + steal;
if (total) *total = total_j;
if (idle) *idle = idle_j + iowait;
return 0;
}
/**
* @brief Resolve the cgroup v2 filesystem path for the current process.
*
* Reads @c /proc/self/cgroup, finds the cgroup2 hierarchy entry (the line
* with @c "::" separator), and constructs the full sysfs path under
* @c /sys/fs/cgroup. The root cgroup ("/") maps to @c /sys/fs/cgroup itself.
*
* @param out Output buffer for the resolved path
* @param out_sz Size of @c out in bytes
* @return 0 on success, -1 if the path could not be resolved
*/
static int resolve_cgroup_path(char *out, size_t out_sz) {
FILE *f = fopen("/proc/self/cgroup", "r");
if (!f) {
return -1;
}
char line[512];
int rc = -1;
while (fgets(line, sizeof(line), f)) {
char *sep = strstr(line, "::");
if (!sep) continue;
char *path = sep + 2;
char *newline = strchr(path, '\n');
if (newline) *newline = '\0';
if (*path == '\0' || strcmp(path, "/") == 0) {
if (snprintf(out, out_sz, "%s", "/sys/fs/cgroup") < (int) out_sz) {
rc = 0;
break;
}
} else {
if (snprintf(out, out_sz, "/sys/fs/cgroup%s", path) < (int) out_sz) {
rc = 0;
break;
}
}
}
fclose(f);
return rc;
}
/**
* @brief Read the cumulative CPU usage in microseconds from a cgroup's @c cpu.stat.
*
* Opens @c <cgpath>/cpu.stat and extracts the @c usage_usec field.
* Returns 0 if the file cannot be opened or the field is absent.
*
* @param cgpath Absolute path to the cgroup directory
* @return Cumulative CPU usage in microseconds, or 0 on failure
*/
static uint64_t read_cgroup_cpu_usage_us(const char *cgpath) {
char path[PATH_MAX];
if (snprintf(path, sizeof(path), "%s/cpu.stat", cgpath) >= (int) sizeof(path)) {
return 0;
}
FILE *f = fopen(path, "r");
if (!f) {
return 0;
}
char line[256];
uint64_t value = 0;
while (fgets(line, sizeof(line), f)) {
if (sscanf(line, "usage_usec %" SCNu64, &value) == 1) {
break;
}
}
fclose(f);
return value;
}
/**
* @brief Read current memory usage in bytes from a cgroup's @c memory.current.
*
* Opens @c <cgpath>/memory.current and reads the single integer value.
* Returns 0 if the file cannot be opened or parsed.
*
* @param cgpath Absolute path to the cgroup directory
* @return Current memory usage in bytes, or 0 on failure
*/
static uint64_t read_cgroup_memory_current(const char *cgpath) {
char path[PATH_MAX];
if (snprintf(path, sizeof(path), "%s/memory.current", cgpath) >= (int) sizeof(path)) {
return 0;
}
FILE *f = fopen(path, "r");
if (!f) {
return 0;
}
unsigned long long value = 0;
if (fscanf(f, "%llu", &value) != 1) {
value = 0;
}
fclose(f);
return value;
}
/* end of the section historically wrapped in `#if !defined(__l4__)` */
/**
* @brief Allocate and initialise the HOLA analytics heap.
*
* Allocates a contiguous block of at least @c requested_bytes (or
* @c PHYSICS_ANALYTICS_DEFAULT_HEAP_BYTES if 0), enforcing a minimum that
* accommodates the header plus 512 KB ring buffer. Partitions the block into
* header (cache-line aligned), ring (60%), summary (30%), and scratch regions,
* then populates the @c physics_analytics_header_t with magic, version, and
* offsets. Safe to call repeatedly — returns 0 immediately if already ready.
*
* @param requested_bytes Desired heap size in bytes (0 = use default)
* @return 0 on success, -1 if allocation failed
*/
static int analytics_heap_allocate(size_t requested_bytes) {
if (g_runtime.heap_ready) {
return 0;
}
size_t bytes = requested_bytes;
if (bytes == 0) {
bytes = PHYSICS_ANALYTICS_DEFAULT_HEAP_BYTES;
}
/* Enforce minimum viable size: header + ring + summary */
const size_t min_bytes = align_up(sizeof(physics_analytics_header_t), 64) + (512u * 1024u);
if (bytes < min_bytes) {
bytes = min_bytes;
}
uint8_t *base = NULL;
/* HISTORICAL: this used to be an #if !defined(__l4__)/#else branch --
* both did an identical malloc(), with the L4Re side noting "simple
* malloc is fine for now; future work can switch to dataspace". L4Re
* support has been removed as an active target. */
base = (uint8_t *) malloc(bytes);
if (!base) {
return -1;
}
memset(base, 0, bytes);
physics_analytics_heap_t heap = {0};
heap.base = base;
heap.bytes = bytes;
size_t header_bytes = align_up(sizeof(physics_analytics_header_t), 64);
heap.header = (physics_analytics_header_t *) base;
/* Split remaining space into ring (60%), summary (30%), scratch (remainder) */
size_t remaining = bytes - header_bytes;
size_t ring_bytes = align_up((remaining * 6u) / 10u, 64);
if (ring_bytes > remaining) ring_bytes = remaining;
size_t summary_bytes = remaining > ring_bytes ? align_up((remaining - ring_bytes) * 3u / 4u, 64) : 0;
if (summary_bytes > remaining - ring_bytes) summary_bytes = remaining - ring_bytes;
size_t scratch_bytes = remaining - ring_bytes - summary_bytes;
heap.ring = base + header_bytes;
heap.ring_bytes = ring_bytes;
heap.summary = heap.ring + ring_bytes;
heap.summary_bytes = summary_bytes;
heap.scratch = heap.summary + summary_bytes;
heap.scratch_bytes = scratch_bytes;
/* Populate header */
physics_analytics_header_t *hdr = heap.header;
hdr->magic = HOLA_SHARED_MAGIC;
hdr->version_major = HOLA_PROTOCOL_MAJOR;
hdr->version_minor = HOLA_PROTOCOL_MINOR;
hdr->heap_bytes = (uint32_t) bytes;
hdr->ring_offset = (uint32_t) header_bytes;
hdr->ring_bytes = (uint32_t) ring_bytes;
hdr->summary_offset = (uint32_t)(heap.summary - heap.base);
hdr->summary_bytes = (uint32_t) summary_bytes;
hdr->scratch_offset = (uint32_t)(heap.scratch - heap.base);
hdr->scratch_bytes = (uint32_t) scratch_bytes;
hdr->produce_seq = 0;
hdr->consume_seq = 0;
hdr->write_offset = 0;
hdr->read_offset = 0;
hdr->dropped_events = 0;
hdr->flags = 0;
g_runtime.heap = heap;
g_runtime.heap_ready = 1;
g_runtime.backend_seq = 0;
return 0;
}
/**
* @brief Free the analytics heap and reset all global heap state.
*
* Safe to call when the heap is not ready. After this call,
* @c g_runtime.heap_ready is 0 and the heap pointer is NULL.
*/
static void analytics_heap_release(void) {
if (!g_runtime.heap_ready) {
return;
}
free(g_runtime.heap.base);
g_runtime.heap = (physics_analytics_heap_t) {
0
};
g_runtime.heap_ready = 0;
g_runtime.backend_seq = 0;
}
/**
* @brief Compute free bytes available in the analytics ring buffer.
*
* Assumes single-producer, single-consumer access with no concurrent writers.
* Clamps out-of-range @c write_offset and @c read_offset before computing.
*
* @param hdr Pointer to the analytics heap header
* @return Number of free bytes available for a new event write
*/
static size_t analytics_ring_free(const physics_analytics_header_t *hdr) {
uint32_t write = hdr->write_offset;
uint32_t read = hdr->read_offset;
uint32_t size = hdr->ring_bytes;
if (write >= size) write = 0;
if (read >= size) read = 0;
if (write >= read) {
return (size_t) (size - write + read - 1u);
}
return (size_t) (read - write - 1u);
}
/* ------------------------------------------------------------------------- */
/* Public API */
/* ------------------------------------------------------------------------- */
/**
* @brief Initialise the physics runtime and analytics heap.
*
* Must be called before any other physics_runtime_* function.
* Idempotent — safe to call multiple times; subsequent calls return 0
* immediately without re-allocating.
*
* @param analytics_heap_bytes Desired analytics heap size (0 = default)
* @return 0 on success, -1 on allocation failure
*/
int physics_runtime_init(size_t analytics_heap_bytes) {
return analytics_heap_allocate(analytics_heap_bytes);
}
/**
* @brief Shut down the physics runtime and release the analytics heap.
*
* Safe to call when the runtime was never initialised. After this call
* the analytics heap is gone and no events can be published until
* @c physics_runtime_init() is called again.
*/
void physics_runtime_shutdown(void) {
analytics_heap_release();
}
/**
* @brief Return a pointer to the live analytics heap descriptor.
*
* @return Pointer to the heap descriptor, or NULL if not yet initialised
*/
const physics_analytics_heap_t *physics_analytics_heap_info(void) {
return g_runtime.heap_ready ? &g_runtime.heap : NULL;
}
/**
* @brief Publish an analytics event into the ring buffer.
*
* Writes a @c physics_analytics_event_header_t followed by the payload
* (8-byte padded) into the ring at the current write offset. If insufficient
* space is available, increments @c dropped_events and returns -1. The event
* is timestamped with @c sf_monotonic_ns() at write time.
*
* @param channel Event channel identifier (e.g. @c PHYSICS_ANALYTICS_CHANNEL_HOST_SNAPSHOT)
* @param payload Event payload bytes (must not be NULL)
* @param payload_bytes Length of payload in bytes
* @return 0 on success, -1 if the heap is not ready, payload is NULL, or ring is full
*/
int physics_analytics_publish_event(uint32_t channel, const void *payload, uint16_t payload_bytes) {
if (!g_runtime.heap_ready || !payload) {
return -1;
}
physics_analytics_header_t *hdr = g_runtime.heap.header;
uint8_t *ring = g_runtime.heap.ring;
uint32_t ring_bytes = hdr->ring_bytes;
if (ring_bytes == 0) {
return -1;
}
size_t padded_payload = align_up(payload_bytes, 8);
size_t total_bytes = sizeof(physics_analytics_event_header_t) + padded_payload;
if (total_bytes >= ring_bytes) {
/* Payload cannot fit even into an empty ring */
hdr->dropped_events++;
return -1;
}
size_t free_bytes = analytics_ring_free(hdr);
if (total_bytes > free_bytes) {
hdr->dropped_events++;
return -1;
}
uint32_t write = hdr->write_offset;
if (write >= ring_bytes) {
write = 0;
}
if (write + total_bytes > ring_bytes) {
size_t tail = ring_bytes - write;
memset(ring + write, 0, tail);
write = 0;
}
physics_analytics_event_header_t *evt = (physics_analytics_event_header_t *) (ring + write);
evt->channel = channel;
evt->payload_bytes = payload_bytes;
evt->reserved = 0;
evt->timestamp_ns = sf_monotonic_ns();
memcpy((uint8_t *) (evt + 1), payload, payload_bytes);
if (padded_payload > payload_bytes) {
memset(((uint8_t *) (evt + 1)) + payload_bytes, 0, padded_payload - payload_bytes);
}
write += (uint32_t) total_bytes;
if (write >= ring_bytes) {
write = 0;
}
hdr->write_offset = write;
hdr->produce_seq++;
return 0;
}
/* ------------------------------------------------------------------------- */
/* Host snapshot shim */
/* ------------------------------------------------------------------------- */
/**
* @brief Collect a host system snapshot using POSIX / Linux interfaces.
*
* Populates @c out with monotonic and realtime timestamps, CPU count,
* scheduler policy and priority, load average (scaled × 1000), runnable
* thread estimate, PSI pressure readings, @c /proc/stat CPU jiffy totals,
* and cgroup v2 CPU usage and memory current values. Sets flags in
* @c out->flags to indicate which fields were successfully populated.
*
* @param out Output snapshot struct; zeroed and populated by this function
* @return 0 on success
*/
static int snapshot_posix(physics_host_snapshot_t *out) {
memset(out, 0, sizeof(*out));
out->backend = PHYSICS_HOST_BACKEND_POSIX;
out->monotonic_time_ns = sf_monotonic_ns();
out->realtime_ns = sf_realtime_ns();
long cpu_count = sysconf(_SC_NPROCESSORS_ONLN);
out->cpu_count = (cpu_count > 0) ? (uint32_t) cpu_count : 1u;
/* Scheduler information */
int policy = sched_getscheduler(0);
if (policy >= 0) {
out->scheduler_policy = (uint32_t) policy;
struct sched_param param = {0};
if (sched_getparam(0, &param) == 0) {
out->scheduler_priority = (uint32_t) param.sched_priority;
}
#if defined(_POSIX_PRIORITY_SCHEDULING)
if (policy == SCHED_RR) {
struct timespec ts = {0};
if (sched_rr_get_interval(0, &ts) == 0) {
out->scheduler_quantum_ns = (uint32_t)((ts.tv_sec * 1000000000LL) + ts.tv_nsec);
}
}
#endif
}
/* Load estimate (scaled by 1000) */
#if defined(_GNU_SOURCE)
double loads[3] = {0.0, 0.0, 0.0};
if (getloadavg(loads, 3) > 0) {
out->load_avg_milli = (uint32_t)(loads[0] * 1000.0);
}
#endif
/* Runnable thread estimate: best effort via load average */
if (out->load_avg_milli > 0) {
out->runnable_threads = (out->load_avg_milli + 999u) / 1000u;
}
int psi_mask = 0;
psi_mask |= read_psi_file("/proc/pressure/cpu",
&out->psi_cpu_some_avg10_milli,
&out->psi_cpu_some_avg60_milli,
&out->psi_cpu_some_avg300_milli,
&out->psi_cpu_full_avg10_milli,
&out->psi_cpu_full_avg60_milli,
&out->psi_cpu_full_avg300_milli);
psi_mask |= read_psi_file("/proc/pressure/io",
&out->psi_io_some_avg10_milli,
&out->psi_io_some_avg60_milli,
&out->psi_io_some_avg300_milli,
&out->psi_io_full_avg10_milli,
&out->psi_io_full_avg60_milli,
&out->psi_io_full_avg300_milli);
psi_mask |= read_psi_file("/proc/pressure/memory",
&out->psi_mem_some_avg10_milli,
&out->psi_mem_some_avg60_milli,
&out->psi_mem_some_avg300_milli,
NULL, NULL, NULL);
if (psi_mask) {
out->flags |= PHYSICS_HOST_FLAG_PSI;
}
uint64_t total_jiffies = 0;
uint64_t idle_jiffies = 0;
if (read_proc_stat_totals(&total_jiffies, &idle_jiffies) == 0) {
out->cpu_total_jiffies = total_jiffies;
out->cpu_idle_jiffies = idle_jiffies;
out->flags |= PHYSICS_HOST_FLAG_CPU_STAT;
}
char cgpath[PATH_MAX];
if (resolve_cgroup_path(cgpath, sizeof(cgpath)) == 0) {
uint64_t usage = read_cgroup_cpu_usage_us(cgpath);
uint64_t mem_cur = read_cgroup_memory_current(cgpath);
out->cgroup_cpu_usage_us = usage;
out->cgroup_memory_current_bytes = mem_cur;
if (usage != 0 || mem_cur != 0) {
out->flags |= PHYSICS_HOST_FLAG_CGROUP;
}
}
out->backend_seq = ++g_runtime.backend_seq;
return 0;
}
/* HISTORICAL: an L4Re backend used to sit here, selected ahead of
* snapshot_posix() by physics_host_snapshot() below whenever __l4__ was
* defined. L4Re support has been removed as an active target.
*
* static int snapshot_l4re(physics_host_snapshot_t *out) {
* memset(out, 0, sizeof(*out));
* out->backend = PHYSICS_HOST_BACKEND_L4RE;
* out->monotonic_time_ns = sf_monotonic_ns();
* out->realtime_ns = sf_realtime_ns();
*
* l4_kernel_info_t *kip = l4re_kip();
* (void) kip;
* out->cpu_count = 1u; // TODO: query processor count from KIP once available
*
* out->backend_seq = ++g_runtime.backend_seq;
* return 0;
* }
*/
/**
* @brief Capture a host environment snapshot and publish it to the analytics ring.
*
* Uses the POSIX backend. On success also publishes the snapshot as a
* @c PHYSICS_ANALYTICS_CHANNEL_HOST_SNAPSHOT event to the analytics ring
* buffer (if the heap is initialised).
*
* @param out Output snapshot struct to populate (must not be NULL)
* @return 0 on success, -1 if @c out is NULL or the backend fails
*/
int physics_host_snapshot(physics_host_snapshot_t *out) {
if (!out) {
return -1;
}
int rc;
/* HISTORICAL: an #ifdef __l4__ block here tried snapshot_l4re() first
* and `goto publish` past snapshot_posix() on success. L4Re support
* has been removed as an active target. */
rc = snapshot_posix(out);
if (rc != 0) {
return rc;
}
if (g_runtime.heap_ready) {
physics_analytics_publish_event(PHYSICS_ANALYTICS_CHANNEL_HOST_SNAPSHOT,
out,
(uint16_t) sizeof(*out));
}
return 0;
}
#endif /* STARFORTH_MINIMAL */
/* ------------------------------------------------------------------------- */
/* End */
/* ------------------------------------------------------------------------- */
v3/src/platform/README.md
+20
View File
@@ -0,0 +1,20 @@
# src/platform/
Platform abstraction layer for the hosted VM build.
- `alloc_host.c` — hosted (`malloc`-backed) allocator implementation of
`include/platform_alloc.h`.
- `alloc_kernel.c` — a kernel-side allocator implementation of the same
interface. Note: `src/starkernel/vm/alloc_kernel.c` is the copy actually
referenced by `Makefile.starkernel`'s kernel build; this one under
`src/platform/` is not wired into any build target — check before relying
on it.
- `platform_init.c` — platform-specific initialization dispatch.
- `threading.c` — threading primitives backing the heartbeat background
thread (`HEARTBEAT_THREAD_ENABLED=1`).
Subdirectories:
- `linux/time.c` — POSIX (`clock_gettime`) timing backend.
- `l4re/time.c` — HISTORICAL: L4Re/Fiasco.OC timing backend. L4Re was a
supported platform target through mid-2026; it has been removed as an
active target and this file is no longer wired into any build.
v3/src/platform/alloc_host.c
+164
View File
@@ -0,0 +1,164 @@
/*
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.
*/
/*
* platform/alloc_host.c - Host (Linux/POSIX) memory allocator
*
* Simple wrapper around standard malloc/free with statistics tracking.
*/
#include "../../include/platform_alloc.h"
#include <stdlib.h>
#include <string.h>
/* Statistics tracking */
static sf_alloc_stats_t g_stats = {0};
/**
* @brief Initialise the host allocator statistics.
*
* Resets the @c g_stats struct to zero. Safe to call multiple times;
* subsequent calls simply reset the counters. No heap memory is allocated
* by this function — the underlying allocator is the system @c malloc.
*
* @return 0 always (cannot fail on the hosted path)
*/
int sf_alloc_init(void)
{
memset(&g_stats, 0, sizeof(g_stats));
return 0;
}
/**
* @brief Allocate @c size bytes from the system heap.
*
* Delegates to @c malloc(). On success, increments @c g_stats.used_bytes
* and @c g_stats.alloc_count, and updates @c g_stats.peak_bytes if the
* new used total exceeds the recorded peak.
*
* @param size Number of bytes to allocate; 0 returns NULL
* @return Pointer to allocated memory, or NULL on allocation failure or zero size
*/
void* sf_malloc(size_t size)
{
if (size == 0) return NULL;
void* ptr = malloc(size);
if (ptr)
{
g_stats.used_bytes += size;
g_stats.alloc_count++;
if (g_stats.used_bytes > g_stats.peak_bytes)
{
g_stats.peak_bytes = g_stats.used_bytes;
}
}
return ptr;
}
/**
* @brief Allocate a zero-initialised array of @c count elements of @c size bytes each.
*
* Delegates to @c calloc(). Updates statistics the same way as @c sf_malloc():
* adds @c count*size to @c used_bytes, increments @c alloc_count, and updates
* @c peak_bytes.
*
* @param count Number of elements; 0 returns NULL
* @param size Size of each element in bytes; 0 returns NULL
* @return Pointer to zero-filled memory, or NULL on allocation failure or zero arguments
*/
void* sf_calloc(size_t count, size_t size)
{
if (count == 0 || size == 0) return NULL;
void* ptr = calloc(count, size);
if (ptr)
{
size_t total = count * size;
g_stats.used_bytes += total;
g_stats.alloc_count++;
if (g_stats.used_bytes > g_stats.peak_bytes)
{
g_stats.peak_bytes = g_stats.used_bytes;
}
}
return ptr;
}
/**
* @brief Resize a previously allocated block to @c new_size bytes.
*
* Delegates to @c realloc(). On success, increments @c g_stats.alloc_count.
* The exact byte delta is not tracked because the original allocation size is
* not stored alongside the pointer — @c used_bytes is therefore approximate
* after any @c sf_realloc() call. For accurate accounting, wrap allocations
* with size-tracking headers.
*
* @param ptr Pointer to an existing allocation, or NULL (behaves like @c sf_malloc)
* @param new_size Desired new size in bytes; 0 may free the block (platform-defined)
* @return Pointer to resized memory, or NULL on failure (original block unchanged)
*/
void* sf_realloc(void* ptr, size_t new_size)
{
void* new_ptr = realloc(ptr, new_size);
if (new_ptr)
{
/* Note: Can't track exact delta without size tracking */
g_stats.alloc_count++;
}
return new_ptr;
}
/**
* @brief Release a previously allocated block back to the system heap.
*
* Delegates to @c free(). Increments @c g_stats.free_count on non-NULL @c ptr.
* The freed byte count is not subtracted from @c used_bytes because the
* original size is not tracked — see @c sf_realloc() note.
*
* @param ptr Pointer to free; NULL is a safe no-op
*/
void sf_free(void* ptr)
{
if (!ptr) return;
/* Note: We can't track exact bytes freed without size tracking.
* For accurate stats, would need to wrap allocations with headers.
* For now, just count frees. */
g_stats.free_count++;
free(ptr);
}
/**
* @brief Copy the current allocator statistics into @c stats.
*
* Fills @c *stats with a snapshot of @c g_stats. Note that @c used_bytes
* overstates the live total when blocks have been freed or reallocated,
* because freed sizes are not tracked. @c free_count is accurate.
*
* @param stats Output buffer to populate; no-op if NULL
*/
void sf_alloc_get_stats(sf_alloc_stats_t* stats)
{
if (!stats) return;
*stats = g_stats;
}
v3/src/platform/alloc_kernel.c
+225
View File
@@ -0,0 +1,225 @@
/*
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.
*/
/*
* platform/alloc_kernel.c - Kernel (bare-metal) memory allocator
*
* Static arena with bump allocation. Free is a no-op.
* This is appropriate for kernel use where:
* - VM is long-lived (no restart)
* - Allocations happen at init time
* - Runtime allocations are rare
*
* Arena size: 4MB by default (configurable via SF_ARENA_SIZE)
*/
#include "../../include/platform_alloc.h"
#include <stdint.h>
#ifndef SF_ARENA_SIZE
#define SF_ARENA_SIZE (4 * 1024 * 1024) /* 4MB default */
#endif
/* Alignment for all allocations (8 bytes for 64-bit safety) */
#define SF_ALIGN 8
#define SF_ALIGN_UP(x) (((x) + (SF_ALIGN - 1)) & ~(SF_ALIGN - 1))
/* Static arena */
static uint8_t g_arena[SF_ARENA_SIZE] __attribute__((aligned(SF_ALIGN)));
static size_t g_arena_offset = 0;
static int g_initialized = 0;
/* Statistics */
static sf_alloc_stats_t g_stats = {0};
/**
* @brief Initialise the kernel bump allocator.
*
* Resets @c g_arena_offset to zero and clears all @c g_stats fields.
* Sets @c g_initialized so that @c sf_malloc() skips the lazy-init guard.
* Safe to call at any point; all prior allocations become invalid after a
* reset, so this must only be called before any VM allocation takes place.
*
* @return 0 always (cannot fail)
*/
int sf_alloc_init(void)
{
g_arena_offset = 0;
g_initialized = 1;
g_stats.total_bytes = SF_ARENA_SIZE;
g_stats.used_bytes = 0;
g_stats.peak_bytes = 0;
g_stats.alloc_count = 0;
g_stats.free_count = 0;
return 0;
}
/*
* @brief Allocate @c size bytes from the static kernel arena.
*
* Advances @c g_arena_offset by @c SF_ALIGN_UP(size). Returns a pointer
* directly into @c g_arena; the caller must not @c free() the result.
* Returns NULL (cast 0) when the arena is exhausted or @c size is zero.
* Lazy-calls @c sf_alloc_init() if the arena has not yet been initialised.
*
* @param size Number of bytes to allocate; 0 returns NULL
* @return Pointer into the static arena, or NULL on exhaustion or zero size
*/
void* sf_malloc(size_t size)
{
if (!g_initialized) sf_alloc_init();
if (size == 0) return (void*)0;
size_t aligned_size = SF_ALIGN_UP(size);
size_t new_offset = g_arena_offset + aligned_size;
if (new_offset > SF_ARENA_SIZE)
{
/* Out of memory */
return (void*)0;
}
void* ptr = &g_arena[g_arena_offset];
g_arena_offset = new_offset;
g_stats.used_bytes = g_arena_offset;
g_stats.alloc_count++;
if (g_stats.used_bytes > g_stats.peak_bytes)
{
g_stats.peak_bytes = g_stats.used_bytes;
}
return ptr;
}
/*
* @brief Allocate a zero-initialised block of @c count * @c size bytes from the arena.
*
* Delegates to @c sf_malloc() then manually zeroes the result with a byte loop
* (no @c memset dependency — avoids linking the C runtime in freestanding builds).
* Guards against @c count*size overflow by verifying @c total/size == count.
*
* @param count Number of elements; 0 returns NULL
* @param size Size of each element in bytes; 0 returns NULL
* @return Pointer to zero-filled arena memory, or NULL on overflow/exhaustion/zero args
*/
void* sf_calloc(size_t count, size_t size)
{
if (count == 0 || size == 0) return (void*)0;
size_t total = count * size;
/* Check for overflow */
if (size != 0 && total / size != count)
{
return (void*)0;
}
void* ptr = sf_malloc(total);
if (ptr)
{
/* Zero-initialize */
uint8_t* p = (uint8_t*)ptr;
for (size_t i = 0; i < total; i++)
{
p[i] = 0;
}
}
return ptr;
}
/*
* @brief Resize an allocation — bump-allocator approximation.
*
* Because the arena does not store block sizes, the old block cannot be
* reclaimed. This function allocates a fresh block of @c new_size bytes and
* returns it; the old block is orphaned in the arena. The caller is responsible
* for copying any content from @c ptr to the returned pointer before discarding
* @c ptr. If @c ptr is NULL, behaves identically to @c sf_malloc(new_size).
*
* @param ptr Existing allocation (orphaned after this call); NULL is safe
* @param new_size Desired size in bytes; 0 returns NULL
* @return Pointer to a new arena block of at least @c new_size bytes, or NULL
*/
void* sf_realloc(void* ptr, size_t new_size)
{
/*
* Bump allocator limitation: we don't track allocation sizes.
* For kernel use, realloc is rarely needed.
*
* Strategy: allocate new block, caller must copy if needed.
* This wastes memory but works for rare realloc cases.
*
* If ptr is NULL, this is equivalent to malloc.
*/
if (!ptr) return sf_malloc(new_size);
if (new_size == 0) return (void*)0;
/* Allocate new block - old block is orphaned (bump allocator limitation) */
return sf_malloc(new_size);
}
/*
* @brief Release a block — no-op for the bump allocator.
*
* The kernel arena has no reclaim mechanism; memory is held until the
* next @c sf_alloc_init() call (i.e. the next power cycle). Increments
* @c g_stats.free_count so the caller can observe that @c sf_free() was
* invoked, but no bytes are returned to the arena.
*
* @param ptr Block to "free"; NULL is a safe no-op
*/
void sf_free(void* ptr)
{
/* Bump allocator: free is a no-op.
*
* This is acceptable because:
* 1. VM allocations happen at init time
* 2. VM runs until power-off
* 3. No fragmentation issues in practice
*
* If needed, could implement a simple free list here.
*/
if (ptr)
{
g_stats.free_count++;
}
(void)ptr;
}
/*
* @brief Copy the current arena statistics into @c stats.
*
* Fills @c *stats with a snapshot of @c g_stats. @c total_bytes is fixed at
* @c SF_ARENA_SIZE; @c used_bytes equals the current arena offset (exact,
* since no reclaim occurs); @c free_count tracks @c sf_free() call count
* even though no memory is actually released.
*
* @param stats Output buffer to populate; no-op if NULL
*/
void sf_alloc_get_stats(sf_alloc_stats_t* stats)
{
if (!stats) return;
*stats = g_stats;
}
v3/src/platform/l4re/README.md
+6
View File
@@ -0,0 +1,6 @@
# src/platform/l4re/
- `time.c` — HISTORICAL: L4Re/Fiasco.OC timing backend implementing
`include/platform_time.h`. L4Re was a supported platform target through
mid-2026; it has been removed as an active target, and this file is no
longer wired into any build (hosted or kernel).
v3/src/platform/l4re/time.c
+300
View File
@@ -0,0 +1,300 @@
/*
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 Platform Time - L4Re/StarshipOS Backend
*
* HISTORICAL: L4Re/Fiasco.OC was a supported platform target through
* mid-2026 (`make L4RE=1`). Removed as an active target -- no Makefile
* defines __l4__ anymore, so the entire body of this file is unreachable
* dead code. Retained for reference; see Makefile's "Platform support"
* section for the commented-out restoration path if L4Re support is ever
* revived.
*
* Implements platform time abstraction using L4Re RTC server and KIP clock.
*
* License: See LICENSE file
*/
#include "../../../include/platform_time.h"
#ifdef __l4__
#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#include <time.h>
/* L4Re headers */
#include <l4/sys/kip.h>
#include <l4/re/env.h>
#include <l4/rtc/rtc>
/* L4Re RTC capability (obtained at init) */
static L4::Cap<L4rtc::Rtc> rtc_cap = L4::Cap<L4rtc::Rtc>::Invalid;
static l4_uint64_t rtc_offset = 0; /* nanoseconds from 1970 to boot */
static int rtc_available = 0;
/* L4Re implementation */
/**
* @brief Return the current monotonic time in nanoseconds (L4Re build).
*
* Reads the KIP (Kernel Info Page) clock via @c l4_kip_clock_ns(). The KIP
* clock is a monotonic counter driven by the L4Re microkernel and is the
* standard high-resolution time source on L4Re. Returns 0 if the KIP pointer
* is unavailable (should never occur in a healthy L4Re environment).
*
* @return Nanoseconds since the L4Re epoch (system boot), or 0 on KIP error
*/
static sf_time_ns_t l4re_get_monotonic_ns(void) {
/* Use L4Re KIP clock: monotonic time since boot */
l4_kernel_info_t *kip = l4re_kip();
if (!kip) {
return 0; /* Fallback if KIP unavailable */
}
return l4_kip_clock_ns(kip);
}
/**
* @brief Return the current wall-clock time in nanoseconds since the Unix epoch (L4Re build).
*
* Combines the RTC offset (nanoseconds from epoch to system boot, obtained
* from the L4Re RTC server during @c sf_time_init_l4re()) with the current
* KIP clock value to produce an absolute timestamp. Falls back to monotonic
* time alone when @c rtc_available is 0, and to @c rtc_offset alone when
* the KIP pointer is unavailable.
*
* @return Nanoseconds since 1970-01-01 00:00:00 UTC, or approximate value on fallback
*/
static sf_time_ns_t l4re_get_realtime_ns(void) {
/* Use RTC server offset + KIP clock for wall-clock time */
if (!rtc_available) {
/* No RTC: return monotonic time (better than nothing) */
return l4re_get_monotonic_ns();
}
/* Real-time = RTC offset (ns since epoch to boot) + KIP clock (ns since boot) */
l4_kernel_info_t *kip = l4re_kip();
if (!kip) {
return rtc_offset; /* Fallback to RTC offset only */
}
return rtc_offset + l4_kip_clock_ns(kip);
}
/**
* @brief Set the system real-time clock via the L4Re RTC server (L4Re build).
*
* Computes the new RTC timer offset as @c ns_since_epoch minus the current
* KIP clock value, then calls @c rtc_cap->set_timer_offset() over IPC.
* On success, updates the cached @c rtc_offset. Returns -1 if the RTC
* capability is invalid, the KIP pointer is unavailable, or the IPC call
* fails.
*
* @param ns_since_epoch Desired wall-clock time in nanoseconds since Unix epoch
* @return 0 on success, -1 on any failure (no RTC capability, KIP error, IPC error)
*/
static int l4re_set_realtime_ns(sf_time_ns_t ns_since_epoch) {
if (!rtc_available || !rtc_cap.is_valid()) {
return -1; /* No RTC capability */
}
/* Calculate new offset: desired epoch time - current KIP clock */
l4_kernel_info_t *kip = l4re_kip();
if (!kip) {
return -1;
}
l4_uint64_t kip_ns = l4_kip_clock_ns(kip);
l4_uint64_t new_offset = ns_since_epoch - kip_ns;
/* Set RTC offset via IPC */
long ret = rtc_cap->set_timer_offset(new_offset);
if (ret < 0) {
return -1;
}
/* Update cached offset */
rtc_offset = new_offset;
return 0;
}
/**
* @brief Format a nanosecond-precision wall-clock time as a human-readable string (L4Re build).
*
* Converts @c ns_since_epoch to a @c time_t, calls @c localtime() and
* @c strftime() using the L4Re libc. Unlike the Linux backend, this variant
* uses a full date+time format (@c "%Y-%m-%d %H:%M:%S" or @c "%Y-%m-%d %I:%M:%S %p")
* rather than time-only. On @c localtime() failure, writes the raw second count as
* a decimal fallback and returns -1.
*
* @param ns_since_epoch Wall-clock time in nanoseconds since Unix epoch
* @param buf Output buffer (at least @c SF_TIME_STAMP_SIZE bytes); must not be NULL
* @param format_24h Non-zero for 24-hour format, zero for 12-hour with AM/PM
* @return 0 on success, -1 if @c buf is NULL or time formatting fails
*/
static int l4re_format_timestamp(sf_time_ns_t ns_since_epoch, char *buf, int format_24h) {
if (!buf) {
return -1;
}
/* Convert nanoseconds to seconds for libc time functions */
time_t seconds = (time_t)(ns_since_epoch / 1000000000ULL);
/* Use L4Re libc localtime + strftime */
struct tm *tm_info = localtime(&seconds);
if (!tm_info) {
/* Fallback: show raw seconds */
snprintf(buf, SF_TIME_STAMP_SIZE, "%llu", (unsigned long long) seconds);
return -1;
}
/* Format timestamp based on 24h preference */
const char *format = format_24h ? "%Y-%m-%d %H:%M:%S" : "%Y-%m-%d %I:%M:%S %p";
size_t ret = strftime(buf, SF_TIME_STAMP_SIZE, format, tm_info);
return (ret > 0) ? 0 : -1;
}
/**
* @brief Report whether an RTC is available (L4Re build).
*
* Returns the @c rtc_available flag set during @c sf_time_init_l4re().
* A value of 0 means the RTC IPC capability was absent or its offset query
* failed; wall-clock functions will return monotonic time as a fallback.
*
* @return 1 if the L4Re RTC server is reachable and its offset was obtained, 0 otherwise
*/
static int l4re_has_rtc(void) {
return rtc_available;
}
/* L4Re backend vtable */
const sf_time_backend_t sf_time_backend_l4re = {
.get_monotonic_ns = l4re_get_monotonic_ns,
.get_realtime_ns = l4re_get_realtime_ns,
.set_realtime_ns = l4re_set_realtime_ns,
.format_timestamp = l4re_format_timestamp,
.has_rtc = l4re_has_rtc,
};
/**
* @brief Initialise the L4Re time backend — acquire RTC capability and fetch epoch offset.
*
* Called once from @c sf_time_init() on L4Re builds. Attempts to obtain the
* @c "rtc" capability from the L4Re environment, then queries the RTC server
* for its timer offset (nanoseconds from the Unix epoch to the system boot
* time). On success sets @c rtc_available = 1 and caches @c rtc_offset.
* On any failure (missing capability, IPC error) sets @c rtc_available = 0
* and @c rtc_offset = 0, leaving the backend in monotonic-only mode.
* Diagnostic messages are printed to @c stderr throughout.
*
* @note Defined only when @c __l4__ is set; compiles to a no-op stub otherwise.
*/
void sf_time_init_l4re(void) {
fprintf(stderr, "[L4Re Time] Initializing L4Re time backend...\n");
/* Try to get RTC capability from L4Re environment */
rtc_cap = L4Re::Env::env()->get_cap<L4rtc::Rtc>("rtc");
if (!rtc_cap.is_valid()) {
fprintf(stderr, "[L4Re Time] WARNING: RTC capability not available\n");
fprintf(stderr, "[L4Re Time] Falling back to monotonic-only mode\n");
fprintf(stderr, "[L4Re Time] Real-time will use KIP clock (time since boot)\n");
rtc_available = 0;
rtc_offset = 0;
return;
}
/* RTC capability acquired successfully */
fprintf(stderr, "[L4Re Time] RTC capability acquired\n");
/* Query the RTC timer offset (nanoseconds from epoch to boot) */
long ret = rtc_cap->get_timer_offset(&rtc_offset);
if (ret < 0) {
fprintf(stderr, "[L4Re Time] ERROR: Failed to get RTC timer offset (ret=%ld)\n", ret);
fprintf(stderr, "[L4Re Time] RTC may not be initialized or running\n");
fprintf(stderr, "[L4Re Time] Setting offset to 0 (will show time since boot as epoch)\n");
rtc_available = 0;
rtc_offset = 0;
return;
}
/* Success! */
rtc_available = 1;
fprintf(stderr, "[L4Re Time] RTC offset retrieved: %llu ns since epoch\n",
(unsigned long long) rtc_offset);
/* Convert offset to a readable date for verification */
time_t boot_time_sec = (time_t)(rtc_offset / 1000000000ULL);
struct tm *boot_tm = gmtime(&boot_time_sec);
if (boot_tm) {
char boot_str[64];
strftime(boot_str, sizeof(boot_str), "%Y-%m-%d %H:%M:%S UTC", boot_tm);
fprintf(stderr, "[L4Re Time] System boot time: %s\n", boot_str);
}
/* Display current time */
l4_kernel_info_t *kip = l4re_kip();
if (kip) {
l4_uint64_t now_ns = rtc_offset + l4_kip_clock_ns(kip);
time_t now_sec = (time_t)(now_ns / 1000000000ULL);
struct tm *now_tm = gmtime(&now_sec);
if (now_tm) {
char now_str[64];
strftime(now_str, sizeof(now_str), "%Y-%m-%d %H:%M:%S UTC", now_tm);
fprintf(stderr, "[L4Re Time] Current time: %s\n", now_str);
}
}
fprintf(stderr, "[L4Re Time] Initialization complete\n");
}
#else
/* Dummy implementation when not building for L4Re */
const sf_time_backend_t sf_time_backend_l4re = {0};
void sf_time_init_l4re(void) {
}
#endif /* __l4__ */
v3/src/platform/linux/README.md
+4
View File
@@ -0,0 +1,4 @@
# src/platform/linux/
- `time.c` — POSIX timing backend (`clock_gettime`) for the hosted Linux
build; implements `include/platform_time.h`.
v3/src/platform/linux/io.c
+49
View File
@@ -0,0 +1,49 @@
/*
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 Platform IO - Linux/POSIX Backend
*
* Implements platform_io.h's terminal-readiness check using select() on
* fd 0, the standard POSIX non-blocking-stdin-peek idiom. Zero timeout:
* a single poll, never blocks.
*
* License: See LICENSE file
*/
#include "../../../include/platform_io.h"
#include <sys/select.h>
#include <unistd.h>
int sf_terminal_ready(void) {
fd_set readfds;
struct timeval tv;
FD_ZERO(&readfds);
FD_SET(STDIN_FILENO, &readfds);
tv.tv_sec = 0;
tv.tv_usec = 0;
int r = select(STDIN_FILENO + 1, &readfds, NULL, NULL, &tv);
return (r > 0 && FD_ISSET(STDIN_FILENO, &readfds)) ? 1 : 0;
}
v3/src/platform/linux/time.c
+172
View File
@@ -0,0 +1,172 @@
/*
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 Platform Time - Linux/POSIX Backend
*
* Implements platform time abstraction using POSIX clock_gettime().
*
* License: See LICENSE file
*/
#define _POSIX_C_SOURCE 199309L
#include "../../../include/platform_time.h"
#include <stdio.h>
#include <time.h>
#include <string.h>
/* POSIX implementation */
/**
* @brief Return the current monotonic time in nanoseconds.
*
* Reads @c CLOCK_MONOTONIC via @c clock_gettime(). The clock advances
* continuously and is unaffected by wall-clock adjustments — suitable for
* measuring elapsed durations such as execution latency and decay intervals.
* Returns 0 on @c clock_gettime() failure (should not occur on any modern
* POSIX kernel).
*
* @return Nanoseconds since an arbitrary but fixed epoch, or 0 on error
*/
static sf_time_ns_t posix_get_monotonic_ns(void) {
struct timespec ts;
if (clock_gettime(CLOCK_MONOTONIC, &ts) != 0)
return 0;
return (sf_time_ns_t) ts.tv_sec * 1000000000ULL + (sf_time_ns_t) ts.tv_nsec;
}
/**
* @brief Return the current wall-clock time in nanoseconds since the Unix epoch.
*
* Reads @c CLOCK_REALTIME via @c clock_gettime(). Subject to NTP or @c settimeofday()
* adjustments — use @c posix_get_monotonic_ns() for interval timing.
* Returns 0 on @c clock_gettime() failure.
*
* @return Nanoseconds since 1970-01-01 00:00:00 UTC, or 0 on error
*/
static sf_time_ns_t posix_get_realtime_ns(void) {
struct timespec ts;
if (clock_gettime(CLOCK_REALTIME, &ts) != 0)
return 0;
return (sf_time_ns_t) ts.tv_sec * 1000000000ULL + (sf_time_ns_t) ts.tv_nsec;
}
/**
* @brief Set the system real-time clock to @c ns_since_epoch.
*
* Converts @c ns_since_epoch to a @c struct timespec and calls
* @c clock_settime(CLOCK_REALTIME). Requires @c CAP_SYS_TIME or equivalent
* privilege; fails with @c EPERM if the caller lacks permission.
*
* @param ns_since_epoch Desired new wall-clock time in nanoseconds since Unix epoch
* @return 0 on success, non-zero errno-encoded error on failure
*/
static int posix_set_realtime_ns(sf_time_ns_t ns_since_epoch) {
struct timespec ts;
ts.tv_sec = (time_t)(ns_since_epoch / 1000000000ULL);
ts.tv_nsec = (long) (ns_since_epoch % 1000000000ULL);
return clock_settime(CLOCK_REALTIME, &ts);
}
/**
* @brief Format a nanosecond-precision wall-clock time as a human-readable string.
*
* Converts @c ns_since_epoch to local time, formats hours/minutes/seconds via
* @c strftime(), then appends a three-digit millisecond suffix. The result is
* written into @c buf (must be at least @c SF_TIME_STAMP_SIZE bytes). On
* @c localtime() or @c strftime() failure, writes @c "??:??:??.???" into @c buf
* and returns -1.
*
* @param ns_since_epoch Wall-clock time in nanoseconds since Unix epoch
* @param buf Output buffer (at least @c SF_TIME_STAMP_SIZE bytes); must not be NULL
* @param format_24h Non-zero for 24-hour format (@c %H:%M:%S), zero for 12-hour (@c %I:%M:%S %p)
* @return 0 on success, -1 if @c buf is NULL or time formatting fails
*/
static int posix_format_timestamp(sf_time_ns_t ns_since_epoch, char *buf, int format_24h) {
if (!buf)
return -1;
time_t seconds = (time_t)(ns_since_epoch / 1000000000ULL);
unsigned int ms = (unsigned int)((ns_since_epoch % 1000000000ULL) / 1000000ULL);
struct tm *tm_info = localtime(&seconds);
if (!tm_info) {
strncpy(buf, "??:??:??.???", SF_TIME_STAMP_SIZE - 1);
buf[SF_TIME_STAMP_SIZE - 1] = '\0';
return -1;
}
char hms[16];
const char *format = format_24h ? "%H:%M:%S" : "%I:%M:%S %p";
if (strftime(hms, sizeof(hms), format, tm_info) == 0) {
strncpy(buf, "??:??:??.???", SF_TIME_STAMP_SIZE - 1);
buf[SF_TIME_STAMP_SIZE - 1] = '\0';
return -1;
}
snprintf(buf, SF_TIME_STAMP_SIZE, "%s.%03u", hms, ms);
return 0;
}
/**
* @brief Probe whether a real-time clock is available.
*
* Attempts a @c clock_gettime(CLOCK_REALTIME) probe. POSIX systems invariably
* support @c CLOCK_REALTIME so this will return 1 in practice; the check
* mirrors the bare-metal backend's interface where RTC presence is genuinely
* uncertain.
*
* @return 1 if @c CLOCK_REALTIME is readable, 0 otherwise
*/
static int posix_has_rtc(void) {
/* POSIX systems typically have working CLOCK_REALTIME */
struct timespec ts;
return (clock_gettime(CLOCK_REALTIME, &ts) == 0) ? 1 : 0;
}
/* POSIX backend vtable */
const sf_time_backend_t sf_time_backend_posix = {
.get_monotonic_ns = posix_get_monotonic_ns,
.get_realtime_ns = posix_get_realtime_ns,
.set_realtime_ns = posix_set_realtime_ns,
.format_timestamp = posix_format_timestamp,
.has_rtc = posix_has_rtc,
};
v3/src/platform/platform_init.c
+85
View File
@@ -0,0 +1,85 @@
/*
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 Platform Initialization
*
* Selects and initializes the appropriate platform backend based on build configuration.
*
* License: See LICENSE file
*/
#include "../../include/platform_time.h"
/* Global backend pointer (starts as NULL) */
const sf_time_backend_t *sf_time_backend = NULL;
/* HISTORICAL: L4Re-specific init (defined in src/platform/l4re/time.c,
* retained but no longer wired into any build). L4Re support has been
* removed as an active target.
* #ifdef __l4__
* extern void sf_time_init_l4re(void);
* #endif
*/
/**
* @brief Initialize platform time subsystem
*
* Selects the POSIX backend (clock_gettime()). Call this once at program
* startup before using any time functions.
*/
void sf_time_init(void) {
if (sf_time_backend != NULL)
return; /* Already initialized */
/* HISTORICAL: an #ifdef __l4__ branch here called sf_time_init_l4re()
* and selected sf_time_backend_l4re. L4Re support has been removed as
* an active target.
* #ifdef __l4__
* sf_time_init_l4re();
* sf_time_backend = &sf_time_backend_l4re;
* #else
*/
/* POSIX build */
sf_time_backend = &sf_time_backend_posix;
/* #endif -- matches the commented-out #ifdef __l4__ above */
}
v3/src/platform/threading.c
+202
View File
@@ -0,0 +1,202 @@
/*
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.
*/
/*
* platform/threading.c - Minimal mutex abstraction bridging POSIX and
* embedded (spinlock-based) targets
*/
#include "../../include/platform_lock.h"
/* HISTORICAL: these two conditions also referenced L4RE_TARGET
* (`&& !defined(L4RE_TARGET)` / `|| defined(L4RE_TARGET)`) -- L4Re had no
* pthreads either, so it shared the spinlock path with STARFORTH_MINIMAL.
* L4Re support has been removed as an active target. */
#if !defined(STARFORTH_MINIMAL)
#include <pthread.h>
#endif
#if defined(STARFORTH_MINIMAL)
/* Spinlock-based mutex for minimal/embedded builds */
/**
* @brief Initialise a spinlock mutex (minimal build).
*
* Sets @c mutex->state to 0 (unlocked). Safe to call on a mutex that has
* already been destroyed. On embedded targets where @c pthread is unavailable,
* this replaces @c pthread_mutex_init().
*
* @param mutex Mutex to initialise; returns -1 if NULL
* @return 0 on success, -1 if @c mutex is NULL
*/
int sf_mutex_init(sf_mutex_t *mutex)
{
if (!mutex) return -1;
mutex->state = 0;
return 0;
}
/**
* @brief Destroy a spinlock mutex (minimal build).
*
* Resets @c mutex->state to 0. No resources are released because the
* spinlock uses only the single @c state field. Safe to call on an
* already-destroyed mutex.
*
* @param mutex Mutex to destroy; no-op if NULL
*/
void sf_mutex_destroy(sf_mutex_t *mutex)
{
if (!mutex) return;
mutex->state = 0;
}
/**
* @brief Acquire a spinlock mutex (minimal build).
*
* Busy-waits using @c __sync_lock_test_and_set() until the lock is obtained.
* Issues an architecture-appropriate yield hint (@c PAUSE on x86,
* @c YIELD on ARM/AArch64, @c NOP on RISC-V) inside the spin loop to
* reduce power consumption and SMT contention.
*
* @param mutex Mutex to lock; no-op if NULL
*/
void sf_mutex_lock(sf_mutex_t *mutex)
{
if (!mutex) return;
while (__sync_lock_test_and_set(&mutex->state, 1))
{
/* CPU yield to reduce power consumption and improve performance */
#if defined(__x86_64__) || defined(__i386__) || defined(_M_X64) || defined(_M_IX86)
/* x86/x86_64: PAUSE instruction reduces pipeline flush penalty */
__asm__ __volatile__("pause" ::: "memory");
#elif defined(__aarch64__) || defined(__arm__)
/* ARM/AArch64: YIELD hint for SMT threads */
__asm__ __volatile__("yield" ::: "memory");
#elif defined(__riscv)
/* RISC-V: NOP as yield hint */
__asm__ __volatile__("nop" ::: "memory");
#else
/* Fallback: compiler barrier prevents optimization */
__asm__ __volatile__("" ::: "memory");
#endif
}
}
/**
* @brief Release a spinlock mutex (minimal build).
*
* Clears the lock state atomically using @c __sync_lock_release(), which
* implies a full memory barrier on all supported architectures. Threads
* blocked in @c sf_mutex_lock() will observe the release on their next
* test-and-set iteration.
*
* @param mutex Mutex to unlock; no-op if NULL
*/
void sf_mutex_unlock(sf_mutex_t *mutex)
{
if (!mutex) return;
__sync_lock_release(&mutex->state);
}
#else /* POSIX */
/**
* @brief Initialise a POSIX mutex (hosted build).
*
* Delegates to @c pthread_mutex_init() with default attributes.
*
* @param mutex Mutex to initialise; returns -1 if NULL
* @return 0 on success, -1 if @c mutex is NULL, or a positive @c errno value
* propagated from @c pthread_mutex_init()
*/
int sf_mutex_init(sf_mutex_t *mutex)
{
if (!mutex) return -1;
return pthread_mutex_init(&mutex->handle, NULL);
}
/**
* @brief Destroy a POSIX mutex (hosted build).
*
* Delegates to @c pthread_mutex_destroy(). The mutex must not be locked
* when destroyed. Return value is discarded; callers that need the error
* code should call @c pthread_mutex_destroy() directly.
*
* @param mutex Mutex to destroy; no-op if NULL
*/
void sf_mutex_destroy(sf_mutex_t *mutex)
{
if (!mutex) return;
pthread_mutex_destroy(&mutex->handle);
}
/**
* @brief Acquire a POSIX mutex (hosted build).
*
* Delegates to @c pthread_mutex_lock(). Blocks until the mutex is available.
* Return value is discarded; a locking error will manifest as a deadlock or
* data race, not a silent failure.
*
* @param mutex Mutex to lock; no-op if NULL
*/
void sf_mutex_lock(sf_mutex_t *mutex)
{
if (!mutex) return;
pthread_mutex_lock(&mutex->handle);
}
/**
* @brief Release a POSIX mutex (hosted build).
*
* Delegates to @c pthread_mutex_unlock(). Must be called by the same thread
* that acquired the lock. Return value is discarded.
*
* @param mutex Mutex to unlock; no-op if NULL
*/
void sf_mutex_unlock(sf_mutex_t *mutex)
{
if (!mutex) return;
pthread_mutex_unlock(&mutex->handle);
}
#endif
v3/src/profiler.c
+530
View File
@@ -0,0 +1,530 @@
/*
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.
*/
/**
* @file profiler.c
* @brief Performance profiling implementation for StarForth
*
* This module implements performance profiling functionality for the StarForth virtual machine.
* It tracks execution statistics including:
* - Word execution counts and timing
* - Dictionary lookup frequency
* - Stack operations
* - Memory usage patterns
*
* The profiler supports multiple detail levels from basic to verbose profiling.
*/
#define _POSIX_C_SOURCE 199309L
#include "../include/profiler.h"
#include "../include/platform_time.h"
#include "../include/vm.h"
#include "../include/physics_metadata.h"
#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#include <time.h>
/* Forward declare DictEntry */
typedef struct DictEntry DictEntry;
/**
* @brief Statistics for individual word execution
*/
typedef struct {
const DictEntry *entry; /**< Pointer to dictionary entry */
uint64_t call_count; /**< Number of times word was called */
uint64_t total_time_ns; /**< Total execution time in nanoseconds */
uint64_t min_time_ns; /**< Minimum execution time in nanoseconds */
uint64_t max_time_ns; /**< Maximum execution time in nanoseconds */
} WordStats;
/* Global profiler state */
static struct {
ProfileLevel level;
int enabled;
/* Word execution tracking */
WordStats *word_stats;
size_t word_count;
size_t word_capacity;
/* Current word timing */
const char *current_word;
uint64_t current_start_time;
/* Global counters */
uint64_t total_dict_lookups;
uint64_t total_stack_ops;
uint64_t total_memory_reads;
uint64_t total_memory_writes;
} profiler_state = {0};
void *g_profiler = &profiler_state;
/**
* @brief Get current time in nanoseconds
* @return Current time in nanoseconds from monotonic clock
*/
static uint64_t get_time_ns(void) {
/* Use platform abstraction for monotonic time */
return sf_monotonic_ns();
}
/**
* @brief Safely print a word name, handling non-null-terminated names
* @param entry Dictionary entry whose name to print
*/
static void print_word_name_safe(const DictEntry *entry) {
if (!entry) {
printf("<null>");
return;
}
for (size_t i = 0; i < entry->name_len && i < 32; i++) {
putchar((unsigned char) entry->name[i]);
}
}
/*
* @brief Initialize the profiler subsystem
* @param level Profiling detail level to enable
* @return 0 on success, -1 on failure
*/
int profiler_init(ProfileLevel level) {
if (level == PROFILE_DISABLED) {
return 0;
}
profiler_state.level = level;
profiler_state.enabled = 1;
/* Allocate initial word stats array */
profiler_state.word_capacity = 256;
profiler_state.word_stats = calloc(profiler_state.word_capacity, sizeof(WordStats));
if (!profiler_state.word_stats) {
profiler_state.enabled = 0;
return -1;
}
profiler_state.word_count = 0;
profiler_state.total_dict_lookups = 0;
profiler_state.total_stack_ops = 0;
profiler_state.total_memory_reads = 0;
profiler_state.total_memory_writes = 0;
return 0;
}
/**
* @brief Shutdown the profiler and free resources
*/
void profiler_shutdown(void) {
if (profiler_state.word_stats) {
free(profiler_state.word_stats);
profiler_state.word_stats = NULL;
}
profiler_state.enabled = 0;
profiler_state.word_count = 0;
}
/**
* @brief Find or create statistics entry for a word
* @param entry Dictionary entry to find/create stats for
* @return Pointer to word stats or NULL if not found/created
*/
static WordStats *get_word_stats(const DictEntry *entry) {
if (!profiler_state.enabled || !entry) return NULL;
/* Search for existing entry - compare by pointer address since
DictEntry pointers are stable for the lifetime of the word */
for (size_t i = 0; i < profiler_state.word_count; i++) {
if (profiler_state.word_stats[i].entry == entry) {
return &profiler_state.word_stats[i];
}
}
/* Create new entry if space available */
if (profiler_state.word_count < profiler_state.word_capacity) {
WordStats *stats = &profiler_state.word_stats[profiler_state.word_count++];
stats->entry = entry;
stats->call_count = 0;
stats->total_time_ns = 0;
stats->min_time_ns = UINT64_MAX;
stats->max_time_ns = 0;
return stats;
}
return NULL;
}
/*
* @brief Record entry into a word for profiling
* @param entry Dictionary entry being entered
*/
void profiler_word_enter(const DictEntry *entry) {
if (!profiler_state.enabled || profiler_state.level < PROFILE_DETAILED) return;
if (!entry) return;
profiler_state.current_word = (const char *) entry;
profiler_state.current_start_time = get_time_ns();
}
/*
* @brief Record exit from a word for profiling
* @param entry Dictionary entry being exited
*/
void profiler_word_exit(const DictEntry *entry) {
if (!profiler_state.enabled || profiler_state.level < PROFILE_DETAILED) return;
if (!entry || !profiler_state.current_word) return;
uint64_t elapsed = get_time_ns() - profiler_state.current_start_time;
WordStats *stats = get_word_stats(entry);
if (stats) {
stats->call_count++;
stats->total_time_ns += elapsed;
if (elapsed < stats->min_time_ns) stats->min_time_ns = elapsed;
if (elapsed > stats->max_time_ns) stats->max_time_ns = elapsed;
}
physics_metadata_record_latency((DictEntry *) entry, elapsed);
profiler_state.current_word = NULL;
}
/*
* @brief Track word execution frequency without timing overhead
* @param entry Dictionary entry being executed
*
* This is a lightweight alternative to profiler_word_enter/exit that only
* tracks execution counts without timing. Use for PROFILE_BASIC level.
*/
void profiler_word_count(const DictEntry *entry) {
if (!profiler_state.enabled || !entry) return;
if (profiler_state.level >= PROFILE_DETAILED) return;
WordStats *stats = get_word_stats(entry);
if (stats) {
stats->call_count++;
}
}
/* Increment counters */
void profiler_inc_dict_lookup(void) {
if (profiler_state.enabled && profiler_state.level >= PROFILE_BASIC) {
profiler_state.total_dict_lookups++;
}
}
void profiler_inc_stack_op(void) {
if (profiler_state.enabled && profiler_state.level >= PROFILE_VERBOSE) {
profiler_state.total_stack_ops++;
}
}
void profiler_memory_read(size_t bytes) {
if (profiler_state.enabled && profiler_state.level >= PROFILE_VERBOSE) {
profiler_state.total_memory_reads += bytes;
}
}
void profiler_memory_write(size_t bytes) {
if (profiler_state.enabled && profiler_state.level >= PROFILE_VERBOSE) {
profiler_state.total_memory_writes += bytes;
}
}
/**
* @brief Compare two WordStats entries by total execution time
* @param a First WordStats entry to compare
* @param b Second WordStats entry to compare
* @return -1, 0, or 1 for qsort ordering
*/
static int compare_by_time(const void *a, const void *b) {
const WordStats *wa = (const WordStats *) a;
const WordStats *wb = (const WordStats *) b;
if (wb->total_time_ns > wa->total_time_ns) return 1;
if (wb->total_time_ns < wa->total_time_ns) return -1;
return 0;
}
/**
* @brief Compare two WordStats entries by call count
* @param a First WordStats entry to compare
* @param b Second WordStats entry to compare
* @return -1, 0, or 1 for qsort ordering
*/
static int compare_by_calls(const void *a, const void *b) {
const WordStats *wa = (const WordStats *) a;
const WordStats *wb = (const WordStats *) b;
if (wb->call_count > wa->call_count) return 1;
if (wb->call_count < wa->call_count) return -1;
return 0;
}
/**
* @brief Generate and print detailed profiling report
*
* Generates a report including:
* - Global statistics (dictionary lookups, stack ops, memory usage)
* - Top words by execution time
* - Most frequently called words
*/
void profiler_generate_report(void) {
if (!profiler_state.enabled) {
printf("Profiler not enabled\n");
return;
}
printf("\n");
printf("========================================\n");
printf(" StarForth Profiler Report\n");
printf("========================================\n\n");
/* Global statistics */
if (profiler_state.level >= PROFILE_BASIC) {
printf("Global Statistics:\n");
printf(" Dictionary lookups: %lu\n", (unsigned long) profiler_state.total_dict_lookups);
if (profiler_state.level >= PROFILE_VERBOSE) {
printf(" Stack operations: %lu\n", (unsigned long) profiler_state.total_stack_ops);
printf(" Memory reads: %lu bytes\n", (unsigned long) profiler_state.total_memory_reads);
printf(" Memory writes: %lu bytes\n", (unsigned long) profiler_state.total_memory_writes);
}
printf("\n");
}
/* Word execution statistics */
if (profiler_state.word_count > 0) {
if (profiler_state.level >= PROFILE_DETAILED) {
/* Detailed mode: show timing info */
printf("Top Words by Execution Time:\n");
printf("%-20s %10s %15s %12s %12s\n", "Word", "Calls", "Total (µs)", "Avg (ns)", "Max (ns)");
printf("--------------------------------------------------------------------------------\n");
/* Sort by total time */
qsort(profiler_state.word_stats, profiler_state.word_count,
sizeof(WordStats), compare_by_time);
/* Show top 20 */
size_t limit = profiler_state.word_count < 20 ? profiler_state.word_count : 20;
for (size_t i = 0; i < limit; i++) {
WordStats *s = &profiler_state.word_stats[i];
if (s->call_count > 0) {
uint64_t avg_ns = s->total_time_ns / s->call_count;
print_word_name_safe(s->entry);
/* Pad to 20 characters */
size_t name_len = s->entry ? s->entry->name_len : 0;
for (size_t j = name_len; j < 20; j++) putchar(' ');
printf(" %10lu %15.2f %12lu %12lu\n",
(unsigned long) s->call_count,
s->total_time_ns / 1000.0,
(unsigned long) avg_ns,
(unsigned long) s->max_time_ns);
}
}
printf("\n");
}
/* Show frequency data for all levels >= BASIC */
if (profiler_state.level >= PROFILE_BASIC) {
printf("Most Frequently Called Words:\n");
printf("%-20s %10s\n", "Word", "Calls");
printf("----------------------------------------\n");
qsort(profiler_state.word_stats, profiler_state.word_count,
sizeof(WordStats), compare_by_calls);
size_t limit = profiler_state.word_count < 15 ? profiler_state.word_count : 15;
for (size_t i = 0; i < limit; i++) {
WordStats *s = &profiler_state.word_stats[i];
if (s->call_count > 0) {
print_word_name_safe(s->entry);
/* Pad to 20 characters */
size_t name_len = s->entry ? s->entry->name_len : 0;
for (size_t j = name_len; j < 20; j++) putchar(' ');
printf(" %10lu\n", (unsigned long) s->call_count);
}
}
printf("\n");
}
}
printf("========================================\n\n");
}
/* Stub implementations for unused functions */
void profiler_reset(void) {
if (!profiler_state.enabled) return;
/* Reset all counters */
for (size_t i = 0; i < profiler_state.word_count; i++) {
profiler_state.word_stats[i].call_count = 0;
profiler_state.word_stats[i].total_time_ns = 0;
profiler_state.word_stats[i].min_time_ns = UINT64_MAX;
profiler_state.word_stats[i].max_time_ns = 0;
}
profiler_state.total_dict_lookups = 0;
profiler_state.total_stack_ops = 0;
profiler_state.total_memory_reads = 0;
profiler_state.total_memory_writes = 0;
}
void profiler_set_level(ProfileLevel level) {
profiler_state.level = level;
}
uint64_t profiler_get_time_ns(void) {
return get_time_ns();
}
void profiler_start_timer(ProfileCategory category) { (void) category; }
void profiler_end_timer(ProfileCategory category) { (void) category; }
void profiler_memory_alloc(size_t bytes) { (void) bytes; }
void profiler_inc_vm_cycles(uint64_t cycles) { (void) cycles; }
void profiler_inc_branch(void) {
}
void profiler_inc_loop_iter(void) {
}
void profiler_print_summary(void) { profiler_generate_report(); }
/**
* @brief Print hot word analysis with optimization recommendations
*
* Analyzes word execution frequency and provides actionable recommendations
* for performance optimization including:
* - Assembly optimization candidates
* - Inlining opportunities
* - Cache-friendly ordering
*/
void profiler_print_hotspots(void) {
if (!profiler_state.enabled || profiler_state.word_count == 0) {
printf("No profiling data available\n");
return;
}
printf("\n");
printf("========================================\n");
printf(" Hot Word Analysis & Optimization\n");
printf("========================================\n\n");
/* Sort by call frequency */
qsort(profiler_state.word_stats, profiler_state.word_count,
sizeof(WordStats), compare_by_calls);
/* Calculate total calls for percentage */
uint64_t total_calls = 0;
for (size_t i = 0; i < profiler_state.word_count; i++) {
total_calls += profiler_state.word_stats[i].call_count;
}
if (total_calls == 0) {
printf("No word executions recorded\n");
return;
}
printf("Top 25 Most Frequently Called Words:\n");
printf("%-20s %12s %10s %s\n", "Word", "Calls", "% Total", "Optimization Suggestion");
printf("--------------------------------------------------------------------------------\n");
size_t limit = profiler_state.word_count < 25 ? profiler_state.word_count : 25;
for (size_t i = 0; i < limit; i++) {
WordStats *s = &profiler_state.word_stats[i];
if (s->call_count == 0) continue;
double pct = (s->call_count * 100.0) / total_calls;
/* Print word name */
print_word_name_safe(s->entry);
size_t name_len = s->entry ? s->entry->name_len : 0;
for (size_t j = name_len; j < 20; j++) putchar(' ');
printf(" %12lu %9.2f%% ", (unsigned long) s->call_count, pct);
/* Provide optimization suggestions based on frequency */
if (pct >= 5.0) {
printf("⚡ HIGH PRIORITY: Inline assembly candidate");
} else if (pct >= 2.0) {
printf("🔥 Consider assembly optimization");
} else if (pct >= 1.0) {
printf("💡 Monitor for optimization");
} else if (pct >= 0.5) {
printf("📊 Profile for PGO");
} else {
printf("—");
}
printf("\n");
}
printf("\n");
printf("Summary:\n");
printf(" Total word executions: %lu\n", (unsigned long) total_calls);
printf(" Unique words tracked: %lu\n", (unsigned long) profiler_state.word_count);
/* Calculate top 10 coverage */
uint64_t top10_calls = 0;
size_t top10_limit = profiler_state.word_count < 10 ? profiler_state.word_count : 10;
for (size_t i = 0; i < top10_limit; i++) {
top10_calls += profiler_state.word_stats[i].call_count;
}
double top10_pct = (top10_calls * 100.0) / total_calls;
printf(" Top 10 coverage: %.1f%%\n", top10_pct);
printf("\n========================================\n\n");
}
void profiler_print_word_analysis(void) {
profiler_print_hotspots();
}
void profiler_print_memory_analysis(void) {
}
void profiler_analyze_performance(VM *vm) { (void) vm; }
void profiler_suggest_optimizations(void) {
profiler_print_hotspots();
}
v3/src/repl.c
+144
View File
@@ -0,0 +1,144 @@
/*
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.
*/
#include "../include/repl.h"
#include "../include/log.h"
#include "../include/vm.h"
#include <stdio.h>
/**
* @brief Extension point for non-recoverable VM errors (weak symbol).
*
* Called by the REPL when @c EMERGENCY_CONSOLE_ENABLED = 0 and an error
* occurs. The default implementation logs the fault at @c LOG_ERROR level
* and sets @c vm->halted = 1, causing the REPL loop to exit cleanly.
*
* Platforms that need hardware reset, watchdog kick, or JTAG debug-probe
* integration should provide a strong definition in a platform-specific file
* (e.g., @c starkernel/hal/fault.c) to override this weak default.
*
* @param vm Active VM whose @c vm->error triggered the fault path
*/
__attribute__((weak)) void vm_fault_handler(VM *vm) {
log_message(LOG_ERROR, "VM fault — emergency console disabled; halting");
vm->halted = 1;
}
/**
* @brief Starts the Forth REPL (Read-Eval-Print Loop)
*
* @param vm Pointer to the VM structure
* @param script_mode If 1, suppress prompts and "ok" output (for piped input)
*
* @details This function implements an interactive REPL for the Forth interpreter.
* It continuously reads input from the user, interprets it, and prints the result
* until the VM is halted or an error occurs.
*
* In interactive mode (script_mode=0):
* - Prints colored prompt "ok> "
* - Acknowledges successful commands with " ok"
* - Reports errors with " ERROR"
*
* In script mode (script_mode=1):
* - Suppresses all prompts and status messages
* - Suitable for piped input (heredoc, pipes, redirects)
*/
void vm_repl(VM *vm, int script_mode) {
if (!script_mode) {
log_message(LOG_INFO, "Starting Forth REPL");
}
char input[256];
while (!vm->halted && !vm->error) {
/* Print prompt only in interactive mode */
if (!script_mode) {
if (vm->zuse_session)
printf("\033[36mzuse)ok>\033[0m \033[92m");
else
printf("\033[36mok>\033[0m \033[92m");
fflush(stdout);
}
if (!fgets(input, sizeof(input), stdin)) {
if (!script_mode) {
printf("\033[0m");
fflush(stdout);
}
break;
}
if (!script_mode) {
printf("\033[0m");
fflush(stdout);
}
vm_interpret(vm, input);
/* ABORT stops mid-line (see vm_interpret/execute_colon_word) but the
* flag is left set for the caller to consume -- this REPL line is
* that boundary. Clear it here so the next line isn't silently
* refused by vm_interpret's own abort_requested check. */
vm->abort_requested = 0;
if (!script_mode) {
/* Print status only in interactive mode */
if (!vm->error) {
printf(" ok\n");
} else {
printf(" ERROR\n");
#if EMERGENCY_CONSOLE_ENABLED
vm->error = 0; /* recover: allow next input */
#else
vm_fault_handler(vm); /* non-recoverable: extension point */
#endif
}
} else {
if (vm->error) {
#if EMERGENCY_CONSOLE_ENABLED
vm->error = 0;
#else
vm_fault_handler(vm);
#endif
}
}
}
}
v3/src/rolling_window_of_truth.c
+1353
View File
File diff suppressed because it is too large Load Diff
v3/src/ssm_jacquard.c
+482
View File
@@ -0,0 +1,482 @@
/*
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.
*/
#include "ssm_jacquard.h"
#include <string.h>
#include <stdlib.h>
/* ============================================================================
* L8 Initialization
* ============================================================================
*/
/**
* @brief Initialise the L8 Jacquard steady-state machine.
*
* Sets @c current_mode and @c pending_mode to @c initial_mode, zeroes
* @c hysteresis_counter, and sets @c table to NULL. Callers must invoke
* @c ssm_l8_init_table() separately if the adaptive UCB table is required.
*
* @param state Pointer to the L8 state to initialise
* @param initial_mode Starting mode (typically @c SSM_MODE_C0)
*/
void ssm_l8_init(ssm_l8_state_t *state, ssm_l8_mode_t initial_mode)
{
if (!state) return;
state->current_mode = initial_mode;
state->hysteresis_counter = 0;
state->pending_mode = initial_mode;
state->table = NULL; /* Caller calls ssm_l8_init_table() separately */
}
/* ============================================================================
* L8 Mode Selection Logic (Data-Driven from Top 5% DoE Analysis)
* ============================================================================
*/
/**
* @brief Update the L8 mode selector using current runtime metrics.
*
* Classifies @c metrics into four binary feature bits (L2/L3/L5/L6) derived
* from DoE top-5% analysis and computes a target mode. Applies hysteresis:
* the mode only commits after @c SSM_HYSTERESIS_TICKS consecutive ticks with
* the same target. Called by the heartbeat thread on every tick.
*
* @param metrics Runtime metrics snapshot (entropy, CV, temporal decay)
* @param state L8 state to update; @c current_mode is written on commit
*/
void ssm_l8_update(const ssm_l8_metrics_t *metrics, ssm_l8_state_t *state)
{
if (!metrics || !state) return;
/* Classify metrics into binary features */
int entropy_high = (metrics->entropy >= SSM_ENTROPY_HIGH_THRESHOLD);
int cv_high = (metrics->cv >= SSM_CV_HIGH_THRESHOLD);
int temporal_high = (metrics->temporal_decay >= SSM_TEMPORAL_DECAY_THRESHOLD);
int temporal_med = (metrics->temporal_decay >= SSM_TEMPORAL_DECAY_LOW_THRESHOLD);
/* Determine target mode using 4-bit logic (L2 L3 L5 L6) */
ssm_l8_mode_t target_mode = SSM_MODE_C0; /* Default: minimal */
/* L2 bit: Enable rolling window if high entropy (diversity) */
int L2_bit = entropy_high ? 1 : 0;
/* L3 bit: Enable linear decay if high temporal locality */
int L3_bit = temporal_high ? 1 : 0;
/* L5 bit: Enable window inference if high CV (volatility) */
int L5_bit = cv_high ? 1 : 0;
/* L6 bit: Enable decay inference if CV high AND moderate temporal */
int L6_bit = (cv_high && temporal_med) ? 1 : 0;
/* Combine bits into mode selector: L2 L3 L5 L6 */
target_mode = (ssm_l8_mode_t)((L2_bit << 3) | (L3_bit << 2) | (L5_bit << 1) | L6_bit);
/* Hysteresis: only change mode after SSM_HYSTERESIS_TICKS consecutive votes */
if (target_mode == state->pending_mode) {
/* Same target as last time, increment counter */
state->hysteresis_counter++;
if (state->hysteresis_counter >= SSM_HYSTERESIS_TICKS) {
/* Threshold reached, commit mode change */
if (target_mode != state->current_mode) {
state->current_mode = target_mode;
}
state->hysteresis_counter = 0; /* Reset for next change */
}
} else {
/* Target changed, reset hysteresis */
state->pending_mode = target_mode;
state->hysteresis_counter = 1;
}
}
/* ============================================================================
* L8 Mode Application (Set L2/L3/L5/L6 Bits)
* ============================================================================
*/
/**
* @brief Apply the current L8 mode to a runtime configuration struct.
*
* Extracts the four loop-enable bits (L2/L3/L5/L6) from
* @c state->current_mode and writes them into @c config. Used by the
* legacy (non-table) L8 path when the adaptive UCB table is not present.
*
* @param state L8 state containing the committed current mode
* @param config Runtime configuration to update
*/
void ssm_apply_mode(const ssm_l8_state_t *state, ssm_config_t *config)
{
if (!state || !config) return;
/* Extract bits from mode (L2 L3 L5 L6) */
int mode_val = (int)state->current_mode;
config->L2_rolling_window = (mode_val >> 3) & 1; /* Bit 3 */
config->L3_linear_decay = (mode_val >> 2) & 1; /* Bit 2 */
config->L5_window_inference = (mode_val >> 1) & 1; /* Bit 1 */
config->L6_decay_inference = (mode_val >> 0) & 1; /* Bit 0 */
}
/* ============================================================================
* L8 Utility Functions
* ============================================================================
*/
/**
* @brief Return a human-readable name string for the given L8 mode.
*
* Returns a static string such as @c "C4_TEMPORAL" or @c "C15_FULL_ADAPTIVE".
* Modes marked ✅ TOP 5% are the configurations favoured by the DoE study.
* Returns @c "UNKNOWN" for out-of-range values.
*
* @param mode L8 mode enumeration value
* @return Pointer to a static null-terminated string (never NULL)
*/
const char* ssm_l8_mode_name(ssm_l8_mode_t mode)
{
switch (mode) {
case SSM_MODE_C0: return "C0_MINIMAL";
case SSM_MODE_C1: return "C1_DECAY_INF";
case SSM_MODE_C2: return "C2_WINDOW_INF";
case SSM_MODE_C3: return "C3_VOLATILE";
case SSM_MODE_C4: return "C4_TEMPORAL"; /* ✅ TOP 5% */
case SSM_MODE_C5: return "C5_TEMPORAL_DECAY_INF";
case SSM_MODE_C6: return "C6_TEMPORAL_WINDOW_INF";
case SSM_MODE_C7: return "C7_FULL_INFERENCE"; /* ✅ TOP 5% */
case SSM_MODE_C8: return "C8_DIVERSE";
case SSM_MODE_C9: return "C9_DIVERSE_DECAY_INF"; /* ✅ TOP 5% */
case SSM_MODE_C10: return "C10_DIVERSE_WINDOW_INF";
case SSM_MODE_C11: return "C11_DIVERSE_INFERENCE"; /* ✅ TOP 5% */
case SSM_MODE_C12: return "C12_DIVERSE_TEMPORAL"; /* ✅ TOP 5% */
case SSM_MODE_C13: return "C13_COMPLEX";
case SSM_MODE_C14: return "C14_FULL_ADAPTIVE_NO_DECAY_INF";
case SSM_MODE_C15: return "C15_FULL_ADAPTIVE";
default: return "UNKNOWN";
}
}
/* ============================================================================
* Adaptive Table: DoE Prior Seeding
* ============================================================================
*
* Maps the DoE top-5% 4-bit modes (L2/L3/L5/L6) to the 7-bit space
* (L1=0, L4=0, L7=1 held fixed for the high-score variants).
*
* Bit layout: b6=L1, b5=L2, b4=L3, b3=L4, b2=L5, b1=L6, b0=L7
*
* Top-5% modes (4-bit → 7-bit with L1=0,L4=0,L7=1):
* C4 (L3 only): 0100 → 0 0 1 0 0 0 1 = 0x11 = 17
* C7 (L3+L5+L6): 0111 → 0 0 1 0 1 1 1 = 0x17 = 23
* C9 (L2+L6): 1001 → 0 1 0 0 0 1 1 = 0x23 = 35
* C11 (L2+L5+L6): 1011 → 0 1 0 0 1 1 1 = 0x27 = 39
* C12 (L2+L3): 1100 → 0 1 1 0 0 0 1 = 0x31 = 49
*/
/**
* @brief Seed the adaptive UCB config table with DoE prior scores.
*
* Computes benefit scores derived from the DoE top-5% analysis for all
* @c cd_tuning_word().num_configs (128) configs and hands them to
* @c cd_config_table_seed(). The five top-5% configs (C4/C7/C9/C11/C12 in
* 4-bit space → indices 17/23/35/39/49 in 7-bit space) receive 80% of
* @c cd_tuning_word().score_max; configs involving L1 or L4 (known expensive
* loops) receive 5–10%; all others receive 40%. Sets the starting config
* to index 17 (C4-equivalent: L3+L7 only).
*
* @param table Pointer to the CDConfigTable to seed (already initialised
* via cd_config_table_init())
*/
static void ssm_l8_seed_from_doe(CDConfigTable *table)
{
/* Top-5% config indices in 7-bit space */
static const uint8_t top5[] = { 17u, 23u, 35u, 39u, 49u };
CDTuning tuning = cd_tuning_word();
uint32_t initial_scores[128];
uint32_t score_max = tuning.score_max;
uint32_t c, i;
for (c = 0u; c < tuning.num_configs; c++) {
uint8_t bits = (uint8_t)c;
int has_l1 = (bits & SSM_CFG_L1) != 0;
int has_l4 = (bits & SSM_CFG_L4) != 0;
int is_top5 = 0;
uint32_t score;
for (i = 0u; i < 5u; i++) {
if (bits == top5[i]) { is_top5 = 1; break; }
}
if (is_top5) score = (score_max * 80u) / 100u;
else if (has_l1 && has_l4) score = (score_max * 5u) / 100u;
else if (has_l1 || has_l4) score = (score_max * 10u) / 100u;
else score = (score_max * 40u) / 100u;
initial_scores[c] = score;
}
/* Start on C4-equivalent (config index 17: L3+L7 only) */
cd_config_table_seed(table, &tuning, initial_scores, 17u);
}
/* ============================================================================
* Adaptive Table: Per-Tick Reward + UCB Selection (static)
* ============================================================================ */
/**
* @brief Score the current config from this tick's outcome and UCB-select
* this tick's config.
*
* Computes a joint convergence signal from this tick's ANOVA outcome and
* the relative delta between this tick's and the previous tick's (window,
* locality) pair. Updates the regime-specific benefit score for the current
* config using exponential decay plus a signed delta -- the decay is what
* provides smoothing over time; there's no separate multi-tick batching on
* top of it (VM-FLEET-ATTRACTOR-DESIGN-20260705.md rev r: one clock, the
* heartbeat tick -- a tick is a tick). Then runs
* UCB1 over all 128 configs for the current regime, selecting the one with
* the highest upper confidence bound as this tick's config.
*
* @param table Adaptive config table
* @param config Runtime config to update with the newly selected bits
* @param metrics This tick's metrics snapshot (for the ANOVA signal)
* @param current_window Current rolling window width, this tick
* @param locality_q16 Current locality signal from cd_classify_ids(), this tick
*/
static void ssm_l8_tick_score_and_select(CDConfigTable *table, ssm_config_t *config,
const ssm_l8_metrics_t *metrics,
uint32_t current_window, uint32_t locality_q16)
{
CDTuning tuning = cd_tuning_word();
uint8_t active_bits = table->entries[table->current_config].config_bits;
int use_joint_convergence = ((active_bits & SSM_CFG_L5) || (active_bits & SSM_CFG_L6)) ? 1 : 0;
/* --- ANOVA stability: this tick's own outcome, not an accumulated
* fraction. Neutral (32768) when inference didn't run this tick --
* no signal either way, not "unstable." */
uint32_t anova_stability = metrics->inference_ran_this_tick
? (metrics->inference_early_exited ? 65536u : 0u)
: 32768u;
uint8_t bits = cd_config_table_tick(table, &tuning, table->current_regime,
anova_stability, use_joint_convergence,
current_window, locality_q16);
/* Apply new config bits to ssm_config_t -- all 7, not just the 4
* the legacy 16-mode selector could express. */
if (config != NULL) {
config->L1_heat_tracking = (bits & SSM_CFG_L1) ? 1 : 0;
config->L2_rolling_window = (bits & SSM_CFG_L2) ? 1 : 0;
config->L3_linear_decay = (bits & SSM_CFG_L3) ? 1 : 0;
config->L4_pipelining = (bits & SSM_CFG_L4) ? 1 : 0;
config->L5_window_inference = (bits & SSM_CFG_L5) ? 1 : 0;
config->L6_decay_inference = (bits & SSM_CFG_L6) ? 1 : 0;
config->L7_adaptive_heartrate = (bits & SSM_CFG_L7) ? 1 : 0;
}
}
/* ============================================================================
* Adaptive Table: Public API
* ============================================================================
*/
/**
* @brief Allocate and initialise the adaptive UCB config table.
*
* Mallocs and initialises a @c CDConfigTable sized by @c cd_tuning_word(),
* seeds it with @c ssm_l8_seed_from_doe(), and attaches it to
* @c state->table. If either allocation fails, @c state->table is set to
* NULL and the system falls back to legacy mode (@c ssm_apply_mode()).
*
* @param state L8 state that will own the table
*/
void ssm_l8_init_table(ssm_l8_state_t *state)
{
CDConfigTable *table;
CDTuning tuning;
if (!state) return;
table = (CDConfigTable *)malloc(sizeof(CDConfigTable));
if (!table) {
state->table = NULL; /* Fall back to legacy mode */
return;
}
tuning = cd_tuning_word();
if (cd_config_table_init(table, &tuning) != 0) {
free(table);
state->table = NULL; /* Fall back to legacy mode */
return;
}
ssm_l8_seed_from_doe(table);
state->table = table;
}
/**
* @brief Free the adaptive UCB config table owned by @c state.
*
* Safe to call with @c state->table == NULL. Sets @c state->table to NULL
* after freeing so the state falls back to legacy mode.
*
* @param state L8 state whose table is freed
*/
void ssm_l8_free_table(ssm_l8_state_t *state)
{
if (!state || !state->table) return;
cd_config_table_free(state->table);
free(state->table);
state->table = NULL;
}
/**
* @brief Tick the adaptive UCB table: classify, score, and reselect.
*
* Classifies the current tick into one of 8 regimes (entropy x CV x
* locality) and stores it unconditionally, then scores the current config
* from this tick's outcome and UCB-reselects, every single call -- no
* batching, no derived counter of any kind (VM-FLEET-ATTRACTOR-DESIGN-
* 20260705.md rev r: one clock, the heartbeat tick, applied uniformly).
* The locality component of both the regime and the joint-convergence
* reward comes from cd_classify_ids() over recent_word_ids -- purely
* execution-count-derived, no wall-clock input (rev s; see header comment
* on this function's declaration for why that matters). Also mirrors the
* winning L2/L3/L5/L6 bits back into @c state->current_mode for
* diagnostic display. No-op if @c state->table is NULL.
*
* @param state L8 state with attached adaptive table
* @param metrics Current runtime metrics snapshot
* @param config Runtime config updated this tick
* @param current_window Current rolling window width
* @param recent_word_ids Recent word-execution-ID history, oldest first
* @param recent_word_ids_count Number of valid entries in recent_word_ids
*/
void ssm_l8_update_table(ssm_l8_state_t *state, const ssm_l8_metrics_t *metrics,
ssm_config_t *config,
uint32_t current_window,
const uint32_t *recent_word_ids, uint32_t recent_word_ids_count)
{
CDConfigTable *table;
CDTuning tuning = cd_tuning_word();
CDRegimeMetrics cd;
uint8_t regime;
if (!state || !state->table || !metrics) return;
table = state->table;
cd = cd_classify_ids(recent_word_ids, recent_word_ids_count,
tuning.locality_lookback);
/* Current regime (same 3-bit shape as legacy L8), stored every tick,
* unconditionally. */
regime = (uint8_t)(
((metrics->entropy >= SSM_ENTROPY_HIGH_THRESHOLD) ? 4u : 0u) |
((metrics->cv >= SSM_CV_HIGH_THRESHOLD) ? 2u : 0u) |
((cd.locality_q16 >= tuning.locality_high_threshold_q16) ? 1u : 0u)
);
table->current_regime = regime;
ssm_l8_tick_score_and_select(table, config, metrics, current_window, cd.locality_q16);
/* Mirror L2/L3/L5/L6 bits into the legacy mode field for diagnostics */
{
uint8_t bits = table->entries[table->current_config].config_bits;
state->current_mode = (ssm_l8_mode_t)(
(((bits & SSM_CFG_L2) ? 1u : 0u) << 3) |
(((bits & SSM_CFG_L3) ? 1u : 0u) << 2) |
(((bits & SSM_CFG_L5) ? 1u : 0u) << 1) |
(((bits & SSM_CFG_L6) ? 1u : 0u) << 0)
);
}
}
/**
* @brief Apply the UCB-selected config bits to a runtime configuration struct.
*
* Reads the current winning config entry from the adaptive table and writes
* all 7 of its bits into @c config. Use this instead of @c ssm_apply_mode()
* when the adaptive table is present (@c state->table != NULL).
*
* @param state L8 state with an attached, initialised adaptive table
* @param config Runtime configuration to update
*/
void ssm_apply_mode_from_table(const ssm_l8_state_t *state, ssm_config_t *config)
{
const CDConfigTable *table;
uint8_t bits;
if (!state || !state->table || !config) return;
table = state->table;
bits = table->entries[table->current_config].config_bits;
config->L1_heat_tracking = (bits & SSM_CFG_L1) ? 1 : 0;
config->L2_rolling_window = (bits & SSM_CFG_L2) ? 1 : 0;
config->L3_linear_decay = (bits & SSM_CFG_L3) ? 1 : 0;
config->L4_pipelining = (bits & SSM_CFG_L4) ? 1 : 0;
config->L5_window_inference = (bits & SSM_CFG_L5) ? 1 : 0;
config->L6_decay_inference = (bits & SSM_CFG_L6) ? 1 : 0;
config->L7_adaptive_heartrate = (bits & SSM_CFG_L7) ? 1 : 0;
}
/**
* @brief Force the adaptive table onto an externally-chosen config.
*
* Sets @c current_config directly (as if the bandit's own UCB selection had
* picked it) and applies its bits immediately. Since scoring and UCB
* reselection now run on every heartbeat tick (rev r: one clock, no
* batching of any kind), this is a one-tick nudge, not a hold: the
* forced config earns exactly one tick's worth of reward signal into its
* own regime_score, then the very next tick's ssm_l8_update_table() call
* scores it and reselects on its own, same as any other tick. Calling
* this repeatedly (e.g. once per DoE draw, faster than the VM's own
* tick cadence) keeps a config in effect in practice, not because it's
* pinned -- because it's what's currently forced, most recently.
*
* @param state L8 state with an attached, initialised adaptive table
* @param config Runtime configuration to update immediately
* @param config_idx Desired config, masked to the 128-entry (7-bit) space
*/
void ssm_l8_force_config(ssm_l8_state_t *state, ssm_config_t *config, uint8_t config_idx)
{
if (!state || !state->table || !config) return;
cd_config_table_force(state->table, config_idx & 0x7Fu);
ssm_apply_mode_from_table(state, config);
}
v3/src/stack_management.c
+177
View File
@@ -0,0 +1,177 @@
/*
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.
*/
/**
* @file stack_management.c
* @brief Implementation of stack operations for the Forth virtual machine
*
* This module provides the core stack manipulation functions for both the data stack
* and return stack of the Forth virtual machine. It includes optimized assembly
* implementations for x86_64 and ARM64 architectures when available.
*/
#include "vm.h"
#include "log.h"
#include "profiler.h"
#if defined(USE_ASM_OPT) && USE_ASM_OPT
# if defined(ARCH_X86_64)
# include "vm_asm_opt.h"
# elif defined(ARCH_ARM64) || defined(__aarch64__) || defined(__arm64__)
# include "vm_asm_opt_arm64.h"
# elif defined(ARCH_RISCV64) || (defined(__riscv) && (__riscv_xlen == 64))
# include "vm_asm_opt_riscv64.h"
# endif
#endif
/**
* @brief Push a value onto the data stack
*
* @param vm Pointer to the VM structure
* @param value Value to push onto the stack
*
* @note Performs bounds checking to prevent stack overflow
* @note Uses assembly optimization if available for x86_64 or ARM64
*/
void vm_push(VM *vm, cell_t value) {
PROFILE_INC_STACK_OP();
#if defined(USE_ASM_OPT) && USE_ASM_OPT && (defined(ARCH_X86_64) || defined(ARCH_ARM64) || defined(ARCH_RISCV64))
/* Use optimized assembly version for x86_64 or ARM64 */
vm_push_asm(vm, value);
#ifndef NDEBUG
if (!vm->error) {
log_message(LOG_DEBUG, "PUSH: %ld (dsp=%d)", value, vm->dsp);
}
#endif
#else
/* Standard C implementation */
if (vm->dsp >= STACK_SIZE - 1) {
log_message(LOG_ERROR, "Stack overflow");
vm->error = 1;
return;
}
vm->data_stack[++vm->dsp] = value;
log_message(LOG_DEBUG, "PUSH: %ld (dsp=%d)", value, vm->dsp);
#endif
}
/**
* @brief Pop a value from the data stack
*
* @param vm Pointer to the VM structure
* @return The popped value
*
* @note Returns 0 and sets error flag if stack underflow occurs
* @note Uses assembly optimization if available for x86_64 or ARM64
*/
cell_t vm_pop(VM *vm) {
PROFILE_INC_STACK_OP();
#if defined(USE_ASM_OPT) && USE_ASM_OPT && (defined(ARCH_X86_64) || defined(ARCH_ARM64) || defined(ARCH_RISCV64))
/* Use optimized assembly version for x86_64 */
cell_t value = vm_pop_asm(vm);
#ifndef NDEBUG
if (!vm->error) {
log_message(LOG_DEBUG, "POP: %ld (dsp=%d)", value, vm->dsp);
}
#endif
return value;
#else
/* Standard C implementation */
if (vm->dsp < 0) {
log_message(LOG_ERROR, "Stack underflow (dsp=%d)", vm->dsp);
vm->error = 1;
return 0;
}
cell_t value = vm->data_stack[vm->dsp--];
log_message(LOG_DEBUG, "POP: %ld (dsp=%d)", value, vm->dsp);
return value;
#endif
}
/**
* @brief Push a value onto the return stack
*
* @param vm Pointer to the VM structure
* @param value Value to push onto the return stack
*
* @note Sets error flag if stack overflow occurs
* @note Uses assembly optimization if available for x86_64 or ARM64
*/
void vm_rpush(VM *vm, cell_t value) {
#if defined(USE_ASM_OPT) && USE_ASM_OPT && (defined(ARCH_X86_64) || defined(ARCH_ARM64) || defined(ARCH_RISCV64))
/* Use optimized assembly version for x86_64 */
vm_rpush_asm(vm, value);
#else
/* Standard C implementation */
if (vm->rsp >= STACK_SIZE - 1) {
vm->error = 1; /* Return stack overflow */
return;
}
vm->return_stack[++vm->rsp] = value;
#endif
}
/**
* @brief Pop a value from the return stack
*
* @param vm Pointer to the VM structure
* @return The popped value
*
* @note Returns 0 and sets error flag if stack underflow occurs
* @note Uses assembly optimization if available for x86_64 or ARM64
*/
cell_t vm_rpop(VM *vm) {
#if defined(USE_ASM_OPT) && USE_ASM_OPT && (defined(ARCH_X86_64) || defined(ARCH_ARM64) || defined(ARCH_RISCV64))
/* Use optimized assembly version for x86_64 */
return vm_rpop_asm(vm);
#else
/* Standard C implementation */
if (vm->rsp < 0) {
vm->error = 1; /* Return stack underflow */
return 0;
}
cell_t value = vm->return_stack[vm->rsp--];
return value;
#endif
}
v3/src/test_runner/README.md
+17
View File
@@ -0,0 +1,17 @@
# src/test_runner/
Test harness for the hosted VM's test suite, run via
`./starforth --run-tests`. Organized in POST (Power-On Self Test) order:
unit tests → dictionary/word-category tests → integration/stress/
adversarial tests.
- `test_runner.c` — test harness orchestration (loads and runs all
modules in POST order).
- `test_common.c` — shared test utilities.
- `test_contracts.c` — contract-based testing infrastructure (pre/post
condition assertions around word execution).
Subdirectories:
- `include/` — public headers for this harness.
- `modules/` — per-category test files; see
`src/test_runner/modules/README.md`.
v3/src/test_runner/include/README.md
+8
View File
@@ -0,0 +1,8 @@
# src/test_runner/include/
Public headers for the test harness.
- `test_runner.h` — harness orchestration interface.
- `test_common.h` — shared test utility declarations.
- `test_contracts.h` — contract-based testing (pre/post-condition
assertion) interface.
v3/src/test_runner/include/test_common.h
+214
View File
@@ -0,0 +1,214 @@
/*
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.
*/
/**
* @file test_common.h
* @brief Common test utilities and structures for StarForth test runner
* @details This file contains test configuration, structures, and utility functions
* used throughout the StarForth test framework.
*/
#ifndef TEST_COMMON_H
#define TEST_COMMON_H
#include "../../../include/vm.h"
#include "../../../include/log.h"
#include "test_contracts.h"
/** @name Test Configuration
* @{
*/
/** Maximum length of test output buffer */
#define MAX_TEST_OUTPUT 1024
/** Maximum length of test input buffer */
#define MAX_TEST_INPUT 256
/** Maximum number of test cases per word */
#define MAX_TESTS_PER_WORD 20
/** @} */
/* fail fast */
extern int fail_fast;
/** @brief Types of test cases */
typedef enum {
TEST_NORMAL = 0, /**< Standard test case */
TEST_EDGE_CASE = 1, /**< Edge case test */
TEST_ERROR_CASE = 2 /**< Error condition test */
} TestType;
/** @brief Structure representing a single test case */
typedef struct {
const char *name; /**< Name of the test case */
const char *input; /**< Input Forth code */
const char *expected; /**< Expected output */
TestType type; /**< Type of test case */
int should_error; /**< Whether test should produce an error */
int implemented; /**< Whether the functionality is implemented */
WordContract contract; /**< Per-test contract override; zero = inherit from suite/module */
} TestCase;
/** @brief Collection of test cases for a single Forth word */
typedef struct {
const char *word_name; /**< Name of the Forth word being tested */
TestCase tests[MAX_TESTS_PER_WORD]; /**< Array of test cases */
int test_count; /**< Number of tests in the suite */
WordContract suite_contract; /**< Suite-level contract; zero = inherit from module */
} WordTestSuite;
/** @name Core Test Execution Functions
* @{
*/
/*
* @brief Executes a single test case
* @param vm Pointer to the VM instance
* @param word_name Name of the word being tested
* @param test Test case to execute
* @return Test execution result
*/
TestResult run_single_test(VM *vm, const char *word_name, const TestCase *test);
/*
* @brief Runs all tests in a test suite
* @param vm Pointer to the VM instance
* @param suite Test suite to execute
*/
void run_test_suite(VM *vm, const WordTestSuite *suite);
/**
* @brief Runs all tests in a suite with an inherited module-level contract.
*
* Contract resolution order (first non-NONE wins):
* test->contract > suite->suite_contract > module_contract
*
* When CONTRACTS_ENABLED=1, each passing TEST_NORMAL test is re-run under
* physics perturbation to witness A4' (word_physics_transparent).
*
* @param vm Pointer to the VM instance
* @param suite Test suite to execute
* @param module_contract Default contract for tests that don't specify one
*/
void run_test_suite_m(VM *vm, const WordTestSuite *suite, WordContract module_contract);
/*
* @brief Prints test results_run_01_2025_12_08 summary for a module
* @param module_name Name of the module
* @param pass Number of passed tests
* @param fail Number of failed tests
* @param skip Number of skipped tests
* @param error Number of errors
*/
void print_module_summary(const char *module_name, int pass, int fail, int skip, int error);
/** @} */
/** @name Test Assertion Functions
* @{
*/
/*
* @brief Verifies the VM stack depth
* @param vm Pointer to the VM instance
* @param expected_depth Expected stack depth
* @return 1 if assertion passes, 0 otherwise
*/
int assert_stack_depth(VM *vm, int expected_depth);
/*
* @brief Verifies the value at the top of the stack
* @param vm Pointer to the VM instance
* @param expected_value Expected value
* @return 1 if assertion passes, 0 otherwise
*/
int assert_stack_top(VM *vm, int expected_value);
/*
* @brief Verifies VM error state
* @param vm Pointer to the VM instance
* @param should_have_error Expected error state
* @return 1 if assertion passes, 0 otherwise
*/
int assert_vm_error(VM *vm, int should_have_error);
/** @} */
/** @name VM State Management Functions
* @{
*/
/*
* @brief Saves current VM state
* @param vm Pointer to the VM instance
* @param dsp Pointer to store data stack pointer
* @param rsp Pointer to store return stack pointer
* @param error Pointer to store error state
* @param mode Pointer to store VM mode
*/
void save_vm_state(VM *vm, int *dsp, int *rsp, int *error, vm_mode_t *mode);
/*
* @brief Restores VM state from saved values
* @param vm Pointer to the VM instance
* @param dsp Data stack pointer to restore
* @param rsp Return stack pointer to restore
* @param error Error state to restore
* @param mode VM mode to restore
*/
void restore_vm_state(VM *vm, int dsp, int rsp, int error, vm_mode_t mode);
/*
* @brief Saves dictionary state before test execution
* @param vm Pointer to VM instance
* @param latest Pointer to store latest dictionary entry
* @param here Pointer to store HERE pointer
*/
void save_dict_state(VM * vm, DictEntry * *latest, size_t * here);
/*
* @brief Restores dictionary state after test execution
* @param vm Pointer to VM instance
* @param latest Latest dictionary entry to restore
* @param here HERE pointer to restore
* @details Removes all words added during test by restoring dictionary pointers
*/
void restore_dict_state(VM *vm, DictEntry *latest, size_t here);
/** @} */
#endif /* TEST_COMMON_H */
v3/src/test_runner/include/test_contracts.h
+121
View File
@@ -0,0 +1,121 @@
/*
StarForth — Steady-State Virtual Machine Runtime
Copyright (c) 2023–2025 Robert A. James
Licensed under the Starship License 1.0 (SL-1.0)
*/
#ifndef TEST_CONTRACTS_H
#define TEST_CONTRACTS_H
#include "vm.h" /* resolved via -Iinclude */
#include <stdint.h>
#include <stddef.h>
/* ============================================================================
* Word Contract System — Runtime witnesses for Isabelle/HOL axioms
*
* Two axioms require runtime verification:
* A1 heartbeat_exec_neutral — vm_tick() must not write exec-equiv fields
* A4' word_physics_transparent — word results must be independent of physics state
*
* Contracts attach at three levels; resolution order (first non-NONE wins):
* individual TestCase > WordTestSuite.suite_contract > module_contract arg
*
* Contract checks run unconditionally as part of POST.
* ============================================================================ */
typedef uint32_t contract_flags_t;
#define CONTRACT_NONE 0u
/* A4': re-run word with perturbed physics; assert identical exec result */
#define CONTRACT_PHYSICS_TRANSPARENT (1u << 0)
/* A1: call vm_tick() and assert exec-equiv fields are unchanged */
#define CONTRACT_HEARTBEAT_SAFE (1u << 1)
/* Number of physics perturbation rounds per test case (0 = use default) */
#define CONTRACT_DEFAULT_FUZZ_ROUNDS 4
typedef struct {
contract_flags_t flags;
int fuzz_rounds; /* 0 = use CONTRACT_DEFAULT_FUZZ_ROUNDS */
} WordContract;
/* Exec-domain snapshot — exactly the four fields in exec_equiv */
typedef struct {
cell_t stack[STACK_SIZE];
int dsp;
int rsp;
int error;
} ExecResult;
/* Physics field snapshot for save/restore around A4' checks */
typedef struct {
uint64_t decay_slope_q48;
uint32_t eff_window_size;
uint64_t tick_target_ns;
cell_t heat_25th;
cell_t heat_50th;
cell_t heat_75th;
uint64_t prefetch_attempts;
uint64_t total_executions;
} PhysicsSnapshot;
/* Global counter incremented on each contract violation (CONTRACTS_ENABLED only) */
extern int global_contract_violations;
/*
* Accessor functions for global_contract_violations.
* Use these from other TUs — direct extern access generates GOTPCRELX which
* the PE linker does not relax, causing double-dereference bugs in -fPIC PE builds.
*/
int contract_get_violation_count(void);
void contract_reset_violation_count(void);
/*
* capture_exec_result — snapshot the four exec-equiv fields from vm into r.
*/
void capture_exec_result(VM *vm, ExecResult *r);
/*
* exec_results_equal — 1 if a and b agree on dsp, rsp, error, and live stack.
*/
int exec_results_equal(const ExecResult *a, const ExecResult *b);
/*
* save_physics / restore_physics — snapshot and restore key physics scalars.
*/
void save_physics(VM *vm, PhysicsSnapshot *s);
void restore_physics(VM *vm, const PhysicsSnapshot *s);
/*
* perturb_physics — replace key physics scalars with fresh random values.
* round is used to vary the RNG seed across multiple rounds.
*/
void perturb_physics(VM *vm, int round);
/*
* check_physics_transparent — A4' contract check for a single test case.
*
* Runs input with the current physics state (baseline), then runs it again
* fuzz_rounds times with physics perturbed, asserting identical ExecResult
* each time. Returns 1 if all rounds match, 0 on first violation (which is
* also logged as an error). Skips error-expected and unimplemented tests.
*
* NOTE: input must not define dictionary words; the dict is not snapshotted
* inside this function. Callers that cover defining-words tests should
* save/restore dict state around this call.
*/
int check_physics_transparent(VM *vm, const char *word_name,
const char *input,
int should_error, int implemented,
int fuzz_rounds);
/*
* assert_heartbeat_safe — A1 contract check.
*
* Snapshots exec-equiv fields, calls vm_tick(), then asserts all four fields
* are unchanged. Returns 1 if the assertion holds, 0 on violation.
*/
int assert_heartbeat_safe(VM *vm);
#endif /* TEST_CONTRACTS_H */
v3/src/test_runner/include/test_runner.h
+181
View File
@@ -0,0 +1,181 @@
/*
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.
*/
#ifndef TEST_RUNNER_H
#define TEST_RUNNER_H
#include "../../../include/vm.h"
#include <stdint.h>
/**
* @brief Structure holding test execution statistics
*/
typedef struct {
int total_tests; /**< Total number of tests executed */
int total_pass; /**< Number of passed tests */
int total_fail; /**< Number of failed tests */
int total_skip; /**< Number of skipped tests */
int total_error; /**< Number of tests that resulted in errors */
} TestStats;
/**
* @brief Structure representing a test module
*/
typedef struct {
const char *module_name; /**< Name of the test module */
void *reserved; /**< Reserved for future use */
int reserved_int; /**< Reserved integer value */
void (*run_module_tests)(VM *vm); /**< Function pointer to run module tests */
} TestModule;
/* Global test statistics - extern declaration */
extern TestStats global_test_stats;
/*
* Same-TU accumulator — use instead of direct struct access from other TUs.
* Direct extern struct access generates R_X86_64_REX_GOTPCRELX which the
* PE linker does not relax, causing double-dereference in -fPIC PE builds.
*/
void test_stats_accumulate(int tests, int pass, int fail, int skip, int error);
/*
* @brief Run tests for stack manipulation words
* @param vm Pointer to the VM instance
*/
void run_stack_words_tests(VM * vm);
void run_return_stack_words_tests(VM * vm);
void run_memory_words_tests(VM * vm);
void run_arithmetic_words_tests(VM * vm);
void run_logical_words_tests(VM * vm);
void run_mixed_arithmetic_words_tests(VM * vm);
void run_double_words_tests(VM * vm);
void run_dictionary_words_tests(VM * vm);
void run_io_words_tests(VM * vm);
void run_format_words_tests(VM * vm);
void run_string_words_tests(VM * vm);
void run_dictionary_manipulation_words_tests(VM * vm);
void run_vocabulary_words_tests(VM * vm);
void run_block_words_tests(VM * vm);
void run_system_words_tests(VM * vm);
void run_defining_words_tests(VM * vm);
void run_control_words_tests(VM * vm);
void run_starforth_words_tests(VM * vm);
void run_acl_words_tests(VM * vm);
/*
* @brief Run tests for Q48.16 fixed-point words (Module 25)
* @param vm Pointer to the VM instance
*/
void run_q48_words_tests(VM * vm);
/*
* @brief Run tests for the proof-covered subset of inference-engine words (Module 26)
* @param vm Pointer to the VM instance
*/
void run_inference_words_tests(VM * vm);
/*
* @brief Run tests for the proof-covered subset of physics-freeze words (Module 27)
* @param vm Pointer to the VM instance
*/
void run_physics_freeze_words_tests(VM * vm);
/*
* @brief Run tests for Mama FORTH vocabulary (capsule system M7.1)
* @param vm Pointer to the VM instance
*
* In hosted builds, all tests are skipped (Mama words are kernel-only).
* In kernel builds, tests validate capsule enumeration and VM birth.
*/
void run_mama_forth_words_tests(VM * vm);
/*
* @brief Enable benchmark mode for performance testing
* @param iterations Number of iterations for benchmark tests
*/
void enable_benchmark_mode(int iterations);
/*
* @brief Execute stress tests
* @param vm Pointer to the VM instance
*/
void run_stress_tests(VM * vm);
/*
* @brief Execute integration tests
* @param vm Pointer to the VM instance
*/
void run_integration_tests(VM * vm);
/*
* @brief Run all available tests
* @param vm Pointer to the VM instance
*/
void run_all_tests(VM * vm);
/*
* @brief Run tests for a specific module
* @param vm Pointer to the VM instance
* @param module_name Name of the module to test
*/
void run_module_tests(VM *vm, const char *module_name);
/*
* @brief Run tests for a specific word
* @param vm Pointer to the VM instance
* @param word_name Name of the word to test
*/
void run_word_tests(VM *vm, const char *word_name);
/**
* @brief Run ultra-comprehensive break-me diagnostic suite
* @param vm Pointer to the VM instance
*
* Executes the most exhaustive test battery ever designed for StarForth,
* generates a detailed markdown report in docs/BREAK_ME_REPORT.md,
* and includes a surprise easter egg at the end.
*/
void run_break_me_tests(VM * vm);
#endif /* TEST_RUNNER_H */
v3/src/test_runner/modules/README.md
+26
View File
@@ -0,0 +1,26 @@
# src/test_runner/modules/
Per-category test files, one per FORTH-79 word category plus
integration/stress/adversarial suites, run in this order by
`test_runner.c` (POST order).
**Word-category tests** (validate each `src/word_source/*.c` file):
`arithmetic_words_test.c`, `mixed_arithmetic_words_test.c`,
`stack_words_test.c`, `control_words_test.c`, `defining_words_tests.c`,
`memory_words_test.c`, `return_stack_words_test.c`, `double_words_test.c`,
`logical_words_test.c`, `io_words_test.c`, `string_words_test.c`,
`block_words_test.c`, `format_words_test.c`, `system_words_test.c`,
`dictionary_words_test.c`, `dictionary_manipulation_words_test.c`,
`vocabulary_words_test.c`, `starforth_words_test.c`,
`mama_forth_words_test.c`, `acl_words_test.c`.
**Cross-cutting tests**:
- `integration_tests.c` — multi-word interaction tests.
- `stress_tests.c` — load/volume tests.
- `break_me_tests.c` — adversarial/fuzzing tests.
Note: not every `src/word_source/*.c` file has a dedicated test module
here (e.g. `defer_words.c`, `log_words.c`, `inference_words.c`,
`lifecycle_words_hosted.c`, `editor_words.c` are exercised indirectly via
integration tests or the `tools/hermes_*.sh` smoke tests rather than a
standalone `*_test.c` module).
v3/src/test_runner/modules/acl_words_test.c
+628
View File
@@ -0,0 +1,628 @@
/*
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.
*/
/*
* acl_words_test.c — POST tests for the word-level ACL system (Module 24)
*
* Tests directly manipulate DictEntry ACL fields in C and then verify
* behaviour through the interpreter or via direct field inspection.
* This avoids depending on ACL.4th being loaded during POST.
*/
#include "../include/test_runner.h"
#include "../include/test_common.h"
#include "../../../include/vm.h"
#include "../../word_source/include/acl_words.h"
#include <stdio.h>
/* ------------------------------------------------------------------ */
static int tests_passed = 0;
static int tests_failed = 0;
#define ACL_ASSERT(cond, msg) \
do { \
if (cond) { \
tests_passed++; \
log_message(LOG_DEBUG, " PASS: %s", msg); \
} else { \
tests_failed++; \
log_message(LOG_ERROR, " FAIL: %s", msg); \
} \
} while (0)
/* ------------------------------------------------------------------ */
/**
* @brief Test 1 — ACL-PIN is a one-way ratchet.
*
* Creates a temporary word and pins it via @c ACL-PIN. Verifies that
* subsequent calls to @c ACL-MODE!, @c ACL-TTL!, and @c ACL-ALLOW! are
* all no-ops while the word is pinned. The pin flag itself must remain 1.
*
* Expected assertions (4):
* - @c acl_pinned == 1 after ACL-PIN
* - @c acl_mode unchanged after ACL-MODE! on pinned entry
* - @c acl_ttl unchanged after ACL-TTL! on pinned entry
* - @c acl_allow unchanged after ACL-ALLOW! on pinned entry
*
* @param vm VM instance (shared state; caller restores after this function).
*/
static void test_acl_pin_immutable(VM *vm)
{
DictEntry *e = vm_create_word(vm, "__acl_pin_test__", 16, NULL);
if (!e) { tests_failed++; return; }
e->acl_mode = ACL_MODE_TTL;
e->acl_pinned = 0;
/* Pin it */
vm_push(vm, (cell_t)(uintptr_t)e);
vm_interpret(vm, "ACL-PIN");
vm->error = 0;
ACL_ASSERT(e->acl_pinned == 1, "ACL-PIN sets acl_pinned=1");
/* Attempt to change mode via ACL-MODE! (C primitive) — should be no-op when pinned */
vm_push(vm, (cell_t)ACL_MODE_STRICT);
vm_push(vm, (cell_t)(uintptr_t)e);
vm_interpret(vm, "ACL-MODE!");
vm->error = 0;
ACL_ASSERT(e->acl_mode == ACL_MODE_TTL, "ACL-STRICT is no-op when pinned");
/* Attempt to change TTL — should be ignored */
uint32_t old_ttl = e->acl_ttl;
vm_push(vm, (cell_t)9999);
vm_push(vm, (cell_t)(uintptr_t)e);
vm_interpret(vm, "ACL-TTL!");
vm->error = 0;
ACL_ASSERT(e->acl_ttl == old_ttl, "ACL-TTL! is no-op when pinned");
/* Attempt to change allow — should be ignored */
e->acl_allow = 1;
vm_push(vm, (cell_t)0);
vm_push(vm, (cell_t)(uintptr_t)e);
vm_interpret(vm, "ACL-ALLOW!");
vm->error = 0;
ACL_ASSERT(e->acl_allow == 1, "ACL-ALLOW! is no-op when pinned");
}
/**
* @brief Test 2 — ACL-INHERIT copies mode, clears pin, and resets TTL/allow.
*
* Constructs a source entry with STRICT mode, pinned, TTL=5000, allow=0,
* and a destination entry with a different mode and also pinned. Calls
* @c acl_inherit_entry() directly and checks the resulting destination
* state. Verifies the Isabelle/HOL lemma @c ACL_Inherit_Clears_Pin.
*
* Expected assertions (4):
* - @c dst->acl_mode == ACL_MODE_STRICT (mode copied from src)
* - @c dst->acl_pinned == 0 (pin cleared regardless of dst's original pin)
* - @c dst->acl_ttl == 0 (TTL reset to 0)
* - @c dst->acl_allow == 1 (allow reset to 1)
*
* @param vm VM instance (used for word creation; not modified beyond that).
*/
static void test_acl_inherit(VM *vm)
{
DictEntry *src = vm_create_word(vm, "__acl_src__", 11, NULL);
DictEntry *dst = vm_create_word(vm, "__acl_dst__", 11, NULL);
if (!src || !dst) { tests_failed++; return; }
src->acl_mode = ACL_MODE_STRICT;
src->acl_pinned = 1;
src->acl_ttl = 5000;
src->acl_allow = 0;
dst->acl_pinned = 1; /* even a pinned dst should be cleared */
dst->acl_mode = ACL_MODE_TTL;
acl_inherit_entry(src, dst);
ACL_ASSERT(dst->acl_mode == ACL_MODE_STRICT, "ACL-INHERIT copies acl_mode");
ACL_ASSERT(dst->acl_pinned == 0, "ACL-INHERIT clears acl_pinned");
ACL_ASSERT(dst->acl_ttl == 0, "ACL-INHERIT resets acl_ttl to 0");
ACL_ASSERT(dst->acl_allow == 1, "ACL-INHERIT resets acl_allow to 1");
}
/**
* @brief Test 3 — emergency_console flag bypasses a denied word.
*
* Defines a FORTH word that pushes 42, then sets its @c acl_allow to 0
* to simulate a policy denial. Executes the word with @c emergency_console=1
* and verifies that the word body ran (stack depth increased by 1).
*
* The @c emergency_console bypass is required by the bare-metal fault
* handler so that critical recovery words can always execute.
*
* Expected assertions (1):
* - @c vm->dsp == saved_dsp + 1 (word ran despite deny)
*
* @param vm VM instance.
*/
static void test_emergency_console_bypass(VM *vm)
{
/* Define a simple FORTH word that pushes a marker */
vm_interpret(vm, ": __acl_ec_test__ 42 ;");
vm->error = 0;
DictEntry *e = vm_find_word(vm, "__acl_ec_test__", 15);
if (!e) { tests_failed++; return; }
/* Deny it */
e->acl_allow = 0;
e->acl_ttl = 0;
e->acl_pinned = 0;
/* With emergency_console=1: should execute despite deny */
int saved_dsp = vm->dsp;
vm->emergency_console = 1;
vm_interpret(vm, "__acl_ec_test__");
vm->emergency_console = 0;
vm->error = 0;
ACL_ASSERT(vm->dsp == saved_dsp + 1, "emergency_console bypasses ACL deny");
if (vm->dsp > saved_dsp) vm->dsp--; /* pop the 42 */
/* Restore allow so subsequent tests don't trip over it */
e->acl_allow = 1;
}
/**
* @brief Test 4 — ACL denial aborts execution without running the word body.
*
* Defines a word that pushes a sentinel (99), then denies it with
* @c acl_allow=0 and @c acl_ttl=1 (hot-path decrement triggers the deny
* check without invoking @c acl_recheck()). Verifies that executing the
* word sets either @c vm->abort_requested, @c vm->error, or leaves the
* stack depth unchanged — and that the sentinel was never pushed.
*
* @c acl_ttl=1 is used rather than 0 to stay on the hot path (TTL
* decrements to 0 → check; avoids the fail-open cold-path recheck).
*
* Expected assertions (2):
* - Execution was aborted (abort_requested || error || stack unchanged)
* - Stack depth is unchanged (sentinel was not pushed)
*
* @param vm VM instance.
*/
static void test_acl_deny_aborts(VM *vm)
{
/* Define a word that pushes a sentinel value */
vm_interpret(vm, ": __acl_deny_test__ 99 ;");
vm->error = 0;
DictEntry *e = vm_find_word(vm, "__acl_deny_test__", 17);
if (!e) { tests_failed++; return; }
e->acl_allow = 0;
e->acl_ttl = 1; /* hot path: decrement then check; avoids fail-open recheck */
e->acl_pinned = 0;
int saved_dsp = vm->dsp;
vm->emergency_console = 0;
vm_interpret(vm, "__acl_deny_test__");
int was_aborted = (vm->abort_requested || vm->error || vm->dsp == saved_dsp);
vm->abort_requested = 0;
vm->error = 0;
ACL_ASSERT(was_aborted, "denied word triggers abort");
ACL_ASSERT(vm->dsp == saved_dsp, "denied word: stack unchanged");
e->acl_allow = 1;
}
/**
* @brief Test 5 — ACL TTL hot-path decrements without invoking recheck.
*
* Defines a word with @c acl_ttl=10 and @c acl_allow=1, then executes
* it three times via the outer interpreter. Each outer-interpreter
* execution decrements @c acl_ttl by 1, so the expected final value is 7.
*
* This confirms the hot-path optimisation: the interpreter only calls
* @c acl_recheck() when @c acl_ttl reaches 0, not on every invocation.
*
* Expected assertions (1):
* - @c e->acl_ttl == 7 after three executions (10 → 9 → 8 → 7)
*
* @param vm VM instance.
*/
static void test_acl_ttl_hot_path(VM *vm)
{
vm_interpret(vm, ": __acl_ttl_test__ 1 DROP ;");
vm->error = 0;
DictEntry *e = vm_find_word(vm, "__acl_ttl_test__", 16);
if (!e) { tests_failed++; return; }
e->acl_allow = 1;
e->acl_ttl = 10;
e->acl_pinned = 0;
e->acl_mode = ACL_MODE_TTL;
/* Execute the word 3 times via the outer interpreter */
vm->emergency_console = 0;
vm_interpret(vm, "__acl_ttl_test__");
vm->error = 0;
vm_interpret(vm, "__acl_ttl_test__");
vm->error = 0;
vm_interpret(vm, "__acl_ttl_test__");
vm->error = 0;
ACL_ASSERT(e->acl_ttl == 7, "TTL hot path: TTL decrements from 10 to 7 after 3 execs");
}
/**
* @brief Test 6 — STRICT mode keeps TTL at 0 after every recheck.
*
* In @c ACL_MODE_STRICT, @c ACL-RECHECK must reset @c acl_ttl to 0 after
* each allow decision so the recheck fires on every subsequent execution.
*
* If @c ACL.4th is not loaded, @c ACL-RECHECK is absent and @c acl_recheck()
* fails open (@c acl_ttl = @c ACL_TTL_OPEN). In that case the test is
* conditionally skipped (counted as a pass) since the ACL system is not
* yet active.
*
* Expected assertions (1, or skip counted as 1 pass):
* - @c e->acl_ttl == 0 after one execution in STRICT mode with ACL loaded.
*
* @param vm VM instance.
*/
static void test_acl_strict_mode(VM *vm)
{
vm_interpret(vm, ": __acl_strict_test__ DROP ;");
vm->error = 0;
DictEntry *e = vm_find_word(vm, "__acl_strict_test__", 19);
if (!e) { tests_failed++; return; }
e->acl_mode = ACL_MODE_STRICT;
e->acl_allow = 1;
e->acl_ttl = 0;
e->acl_pinned = 0;
/* ACL-RECHECK for STRICT mode must reset TTL to 0 after allowing */
vm_push(vm, (cell_t)(uintptr_t)e);
DictEntry *recheck = vm_find_word(vm, "ACL-RECHECK", 11);
if (recheck) {
/* ACL-RECHECK is not yet in the dict (ACL.4th not loaded) — skip FORTH call */
/* Test via acl_recheck() directly: in STRICT mode, TTL stays 0 */
/* We can't call acl_recheck() directly (static), but we can test
that the vm_interpret path triggers the recheck path correctly.
After execution with TTL=0 and allow=1, TTL should still be 0
in STRICT mode (recheck was called and set TTL=0 again). */
vm->dsp--; /* clean up the push above */
vm_interpret(vm, "0 __acl_strict_test__");
vm->error = 0;
ACL_ASSERT(e->acl_ttl == 0, "STRICT mode: TTL remains 0 after recheck");
} else {
/* ACL.4th not loaded yet — fallback sets TTL=OPEN; note but don't fail */
vm->dsp--;
log_message(LOG_INFO, " SKIP: STRICT mode test (ACL.4th not loaded)");
tests_passed++; /* conditional skip counts as pass in POST */
}
}
/**
* @brief Test 7 — Adaptive TTL scales with execution heat via ACL-TTL-COMPUTE.
*
* Sets @c execution_heat=2560 on a temporary entry and invokes
* @c ACL-TTL-COMPUTE if the word is present (i.e., @c ACL.4th is loaded).
* The expected formula is @c ttl = heat/4 + 256 = 640 + 256 = 896.
*
* If @c ACL-TTL-COMPUTE is not present (ACL.4th not yet loaded), the test
* is conditionally skipped and counted as a pass.
*
* Expected assertions (1, or skip):
* - @c ACL-TTL-COMPUTE returns 896 for heat=2560.
*
* @param vm VM instance.
*/
static void test_acl_adaptive_ttl(VM *vm)
{
DictEntry *e = vm_create_word(vm, "__acl_heat_test__", 17, NULL);
if (!e) { tests_failed++; return; }
/* Set heat and verify TTL-COMPUTE via FORTH (if ACL.4th loaded) */
e->execution_heat = 2560;
e->acl_allow = 1;
e->acl_pinned = 0;
DictEntry *ttl_compute = vm_find_word(vm, "ACL-TTL-COMPUTE", 15);
if (ttl_compute) {
vm_push(vm, (cell_t)(uintptr_t)e);
vm_interpret(vm, "ACL-TTL-COMPUTE");
vm->error = 0;
if (vm->dsp >= 0) {
cell_t ttl = vm_pop(vm);
/* heat=2560, ttl = 2560/4 + 256 = 640+256 = 896 */
ACL_ASSERT(ttl == 896, "ACL-TTL-COMPUTE: heat=2560 → ttl=896");
} else {
tests_failed++;
log_message(LOG_ERROR, " FAIL: ACL-TTL-COMPUTE left empty stack");
}
} else {
log_message(LOG_INFO, " SKIP: ACL-TTL-COMPUTE (ACL.4th not loaded)");
tests_passed++;
}
vm->error = 0;
}
/**
* @brief Test 8 — A pinned word cannot be shadowed by redefinition.
*
* Creates a word, pins it, then attempts to create another word with
* the same name via @c vm_create_word(). Verifies that the second create
* returns NULL and sets @c vm->error, and that the original pinned entry
* is still the one returned by @c vm_find_word().
*
* This enforces the Isabelle/HOL lemma @c ACL_Pin_Monotone: pin is
* permanent and cannot be overridden even by a new definition.
*
* Expected assertions (3):
* - @c vm_create_word() returns NULL for the shadowed name
* - @c vm->error is non-zero after the blocked create
* - @c vm_find_word() still returns the original pinned entry
*
* @param vm VM instance.
*/
static void test_acl_pin_blocks_shadow(VM *vm)
{
DictEntry *orig = vm_create_word(vm, "__acl_shadow_target__", 21, NULL);
if (!orig) { tests_failed++; return; }
orig->acl_pinned = 1;
DictEntry *shadow = vm_create_word(vm, "__acl_shadow_target__", 21, NULL);
ACL_ASSERT(shadow == NULL, "vm_create_word returns NULL for pinned name");
ACL_ASSERT(vm->error != 0, "vm->error set when shadow blocked");
vm->error = 0;
DictEntry *found = vm_find_word(vm, "__acl_shadow_target__", 21);
ACL_ASSERT(found == orig, "original pinned entry still found after blocked shadow");
}
/**
* @brief Test 9 — ACL-MODE@/ACL-PINNED?/ACL-TTL@/ACL-ALLOW@/ACL-HEAT@/
* ACL-WORD-ID read a word's ACL fields via the interpreter.
*
* Proof-covered field accessors (`proof/StarForth_ACL_*.thy`) that had no
* interpreter-level POST coverage before this test — every other ACL test
* in this file exercises the write accessors (`ACL-MODE!`/`ACL-TTL!`/
* `ACL-ALLOW!`) or calls the underlying C functions directly, but never
* pushed an xt and interpreted these six read words.
*
* Sets each field to a distinctive non-default value directly on a fresh
* test word, then pushes its xt and interprets each accessor in turn,
* checking the value returned on the stack.
*
* Expected assertions (6):
* - ACL-MODE@ returns @c ACL_MODE_STRICT
* - ACL-PINNED? returns -1 (true) for a pinned entry
* - ACL-TTL@ returns 4242
* - ACL-ALLOW@ returns 0 (false)
* - ACL-HEAT@ returns the entry's @c execution_heat
* - ACL-WORD-ID returns the entry's @c word_id
*
* @param vm VM instance.
*/
static void test_acl_read_accessors(VM *vm)
{
DictEntry *e = vm_create_word(vm, "__acl_read_test__", 18, NULL);
if (!e) { tests_failed++; return; }
e->acl_mode = ACL_MODE_STRICT;
e->acl_pinned = 1;
e->acl_ttl = 4242;
e->acl_allow = 0;
e->execution_heat = 777;
vm_push(vm, (cell_t)(uintptr_t)e);
vm_interpret(vm, "ACL-MODE@");
vm->error = 0;
ACL_ASSERT(vm_pop(vm) == (cell_t)ACL_MODE_STRICT, "ACL-MODE@ reads acl_mode");
vm_push(vm, (cell_t)(uintptr_t)e);
vm_interpret(vm, "ACL-PINNED?");
vm->error = 0;
ACL_ASSERT(vm_pop(vm) == -1, "ACL-PINNED? reads acl_pinned as true");
vm_push(vm, (cell_t)(uintptr_t)e);
vm_interpret(vm, "ACL-TTL@");
vm->error = 0;
ACL_ASSERT(vm_pop(vm) == 4242, "ACL-TTL@ reads acl_ttl");
vm_push(vm, (cell_t)(uintptr_t)e);
vm_interpret(vm, "ACL-ALLOW@");
vm->error = 0;
ACL_ASSERT(vm_pop(vm) == 0, "ACL-ALLOW@ reads acl_allow as false");
vm_push(vm, (cell_t)(uintptr_t)e);
vm_interpret(vm, "ACL-HEAT@");
vm->error = 0;
ACL_ASSERT(vm_pop(vm) == (cell_t)e->execution_heat, "ACL-HEAT@ reads execution_heat");
vm_push(vm, (cell_t)(uintptr_t)e);
vm_interpret(vm, "ACL-WORD-ID");
vm->error = 0;
ACL_ASSERT(vm_pop(vm) == (cell_t)e->word_id, "ACL-WORD-ID reads word_id");
}
/**
* @brief Test 10 — ACL-INHERIT, as an interpreted FORTH word (src dst -- ).
*
* `test_acl_inherit` above already proves the underlying
* @c acl_inherit_entry() C function is correct (Isabelle lemma
* @c ACL_Inherit_Clears_Pin) by calling it directly. This test instead
* exercises the FORTH-level dispatch path itself — pushing two xts and
* interpreting "ACL-INHERIT" — which nothing in this file previously did,
* so the word's own stack-popping/argument-order code was untested.
*
* Expected assertions (2):
* - @c dst->acl_mode == ACL_MODE_STRICT after interpreting ACL-INHERIT
* - @c dst->acl_pinned == 0 after interpreting ACL-INHERIT
*
* @param vm VM instance.
*/
static void test_acl_inherit_word_dispatch(VM *vm)
{
DictEntry *src = vm_create_word(vm, "__acl_inh_src__", 15, NULL);
DictEntry *dst = vm_create_word(vm, "__acl_inh_dst__", 15, NULL);
if (!src || !dst) { tests_failed++; return; }
src->acl_mode = ACL_MODE_STRICT;
src->acl_pinned = 0;
dst->acl_pinned = 1;
dst->acl_mode = ACL_MODE_TTL;
vm_push(vm, (cell_t)(uintptr_t)src);
vm_push(vm, (cell_t)(uintptr_t)dst);
vm_interpret(vm, "ACL-INHERIT");
vm->error = 0;
ACL_ASSERT(dst->acl_mode == ACL_MODE_STRICT, "ACL-INHERIT (word) copies acl_mode");
ACL_ASSERT(dst->acl_pinned == 0, "ACL-INHERIT (word) clears acl_pinned");
}
/**
* @brief Test 11 — ACL-INIT-PRIMITIVES resets unpinned words, skips pinned ones.
*
* Creates two fresh words with non-default ACL state: one left unpinned,
* one pinned. Interprets "ACL-INIT-PRIMITIVES" (which walks the entire
* dictionary) and verifies the unpinned word was reset to the permissive
* defaults (@c acl_ttl=0, @c acl_allow=1, @c acl_mode=ACL_MODE_TTL) while
* the pinned word's deliberately-different state was left untouched.
*
* Expected assertions (4):
* - unpinned word's @c acl_ttl reset to 0
* - unpinned word's @c acl_allow reset to 1
* - unpinned word's @c acl_mode reset to ACL_MODE_TTL
* - pinned word's @c acl_ttl is NOT reset (still its original value)
*
* @param vm VM instance.
*/
static void test_acl_init_primitives(VM *vm)
{
DictEntry *unpinned = vm_create_word(vm, "__acl_initp_free__", 19, NULL);
DictEntry *pinned = vm_create_word(vm, "__acl_initp_pin__", 18, NULL);
if (!unpinned || !pinned) { tests_failed++; return; }
unpinned->acl_ttl = 555;
unpinned->acl_allow = 0;
unpinned->acl_mode = ACL_MODE_STRICT;
unpinned->acl_pinned = 0;
pinned->acl_ttl = 555;
pinned->acl_allow = 0;
pinned->acl_mode = ACL_MODE_STRICT;
pinned->acl_pinned = 1;
vm_interpret(vm, "ACL-INIT-PRIMITIVES");
vm->error = 0;
ACL_ASSERT(unpinned->acl_ttl == 0, "ACL-INIT-PRIMITIVES resets unpinned acl_ttl");
ACL_ASSERT(unpinned->acl_allow == 1, "ACL-INIT-PRIMITIVES resets unpinned acl_allow");
ACL_ASSERT(unpinned->acl_mode == ACL_MODE_TTL, "ACL-INIT-PRIMITIVES resets unpinned acl_mode");
ACL_ASSERT(pinned->acl_ttl == 555, "ACL-INIT-PRIMITIVES leaves pinned entry untouched");
}
/* ------------------------------------------------------------------ */
/**
* @brief Module 24 entry point — run all word-level ACL POST tests.
*
* Saves the current VM state (dsp, rsp, error, mode, emergency_console)
* before each sub-test and restores it between tests so failures do not
* cascade. Runs eleven tests covering:
*
* 1. ACL-PIN one-way ratchet (4 assertions)
* 2. ACL-INHERIT semantics (4 assertions)
* 3. emergency_console bypass (1 assertion)
* 4. ACL denial aborts word execution (2 assertions)
* 5. TTL hot-path decrement (1 assertion)
* 6. STRICT mode — TTL stays 0 (1 assertion or conditional skip)
* 7. Adaptive TTL via ACL-TTL-COMPUTE (1 assertion or conditional skip)
* 8. Pin blocks shadowing (3 assertions)
* 9. Read accessors — ACL-MODE@/PINNED?/TTL@/ALLOW@/HEAT@/WORD-ID (6 assertions)
* 10. ACL-INHERIT as an interpreted word, not just its C twin (2 assertions)
* 11. ACL-INIT-PRIMITIVES resets unpinned, skips pinned (4 assertions)
*
* Tests that depend on @c ACL.4th being loaded are conditionally skipped
* during bare POST (before @c ACL.4th runs) and counted as passes so the
* POST score is not penalised by load-order.
*
* @param vm VM instance; must be initialised and have the standard
* word vocabulary available.
*/
void run_acl_words_tests(VM *vm)
{
log_message(LOG_INFO, "Running ACL Words Tests (Module 24)...");
tests_passed = 0;
tests_failed = 0;
int saved_dsp, saved_rsp, saved_error;
vm_mode_t saved_mode;
save_vm_state(vm, &saved_dsp, &saved_rsp, &saved_error, &saved_mode);
uint8_t saved_ec = vm->emergency_console;
test_acl_pin_immutable(vm);
restore_vm_state(vm, saved_dsp, saved_rsp, 0, saved_mode);
test_acl_inherit(vm);
restore_vm_state(vm, saved_dsp, saved_rsp, 0, saved_mode);
test_emergency_console_bypass(vm);
restore_vm_state(vm, saved_dsp, saved_rsp, 0, saved_mode);
test_acl_deny_aborts(vm);
restore_vm_state(vm, saved_dsp, saved_rsp, 0, saved_mode);
test_acl_ttl_hot_path(vm);
restore_vm_state(vm, saved_dsp, saved_rsp, 0, saved_mode);
test_acl_strict_mode(vm);
restore_vm_state(vm, saved_dsp, saved_rsp, 0, saved_mode);
test_acl_adaptive_ttl(vm);
restore_vm_state(vm, saved_dsp, saved_rsp, 0, saved_mode);
test_acl_pin_blocks_shadow(vm);
restore_vm_state(vm, saved_dsp, saved_rsp, 0, saved_mode);
test_acl_read_accessors(vm);
restore_vm_state(vm, saved_dsp, saved_rsp, 0, saved_mode);
test_acl_inherit_word_dispatch(vm);
restore_vm_state(vm, saved_dsp, saved_rsp, 0, saved_mode);
test_acl_init_primitives(vm);
restore_vm_state(vm, saved_dsp, saved_rsp, 0, saved_mode);
vm->emergency_console = saved_ec;
print_module_summary("ACL Words", tests_passed, tests_failed, 0, 0);
}
v3/src/test_runner/modules/arithmetic_words_test.c
+285
View File
@@ -0,0 +1,285 @@
/*
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.
*/
#include "../include/test_runner.h"
#include "../include/test_common.h"
/* Arithmetic Words Test Suites - Module 5 */
static WordTestSuite arithmetic_word_suites[] = {
{
"+", {
{"basic", "5 7 + . CR", "Should print: 12", TEST_NORMAL, 0, 1, {0}},
{"zero_add", "42 0 + . CR", "Should print: 42", TEST_NORMAL, 0, 1, {0}},
{"negative", "-5 3 + . CR", "Should print: -2", TEST_NORMAL, 0, 1, {0}},
{"both_negative", "-5 -3 + . CR", "Should print: -8", TEST_NORMAL, 0, 1, {0}},
{"overflow", "2147483647 1 + . CR", "Should overflow", TEST_EDGE_CASE, 0, 1, {0}},
{"underflow", "-2147483648 -1 + . CR", "Should underflow", TEST_EDGE_CASE, 0, 1, {0}},
{"empty_stack", "+", "Should cause stack underflow", TEST_ERROR_CASE, 1, 1, {0}},
{"one_item", "42 +", "Should cause stack underflow", TEST_ERROR_CASE, 1, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
8, {0}
},
{
"-", {
{"basic", "10 3 - . CR", "Should print: 7", TEST_NORMAL, 0, 1, {0}},
{"zero_sub", "42 0 - . CR", "Should print: 42", TEST_NORMAL, 0, 1, {0}},
{"from_zero", "0 5 - . CR", "Should print: -5", TEST_NORMAL, 0, 1, {0}},
{"negative", "5 -3 - . CR", "Should print: 8", TEST_NORMAL, 0, 1, {0}},
{"same_values", "42 42 - . CR", "Should print: 0", TEST_NORMAL, 0, 1, {0}},
{"overflow", "-2147483648 1 - . CR", "Should underflow", TEST_EDGE_CASE, 0, 1, {0}},
{"underflow", "2147483647 -1 - . CR", "Should overflow", TEST_EDGE_CASE, 0, 1, {0}},
{"empty_stack", "-", "Should cause stack underflow", TEST_ERROR_CASE, 1, 1, {0}},
{"one_item", "42 -", "Should cause stack underflow", TEST_ERROR_CASE, 1, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
9, {0}
},
{
"*", {
{"basic", "6 7 * . CR", "Should print: 42", TEST_NORMAL, 0, 1, {0}},
{"by_zero", "42 0 * . CR", "Should print: 0", TEST_NORMAL, 0, 1, {0}},
{"by_one", "42 1 * . CR", "Should print: 42", TEST_NORMAL, 0, 1, {0}},
{"by_negative", "6 -7 * . CR", "Should print: -42", TEST_NORMAL, 0, 1, {0}},
{"negative_negative", "-6 -7 * . CR", "Should print: 42", TEST_NORMAL, 0, 1, {0}},
{"large_numbers", "32767 2 * . CR", "Should print: 65534", TEST_EDGE_CASE, 0, 1, {0}},
{"overflow", "65536 65536 * . CR", "May overflow", TEST_EDGE_CASE, 0, 1, {0}},
{"empty_stack", "*", "Should cause stack underflow", TEST_ERROR_CASE, 1, 1, {0}},
{"one_item", "42 *", "Should cause stack underflow", TEST_ERROR_CASE, 1, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
9, {0}
},
{
"/", {
{"basic", "15 3 / . CR", "Should print: 5", TEST_NORMAL, 0, 1, {0}},
{"by_one", "42 1 / . CR", "Should print: 42", TEST_NORMAL, 0, 1, {0}},
{"negative_dividend", "-15 3 / . CR", "Should print: -5", TEST_NORMAL, 0, 1, {0}},
{"negative_divisor", "15 -3 / . CR", "Should print: -5", TEST_NORMAL, 0, 1, {0}},
{"both_negative", "-15 -3 / . CR", "Should print: 5", TEST_NORMAL, 0, 1, {0}},
{"truncation", "7 3 / . CR", "Should print: 2 (truncated)", TEST_NORMAL, 0, 1, {0}},
{"by_zero", "42 0 /", "Should cause division by zero", TEST_ERROR_CASE, 1, 1, {0}},
{"empty_stack", "/", "Should cause stack underflow", TEST_ERROR_CASE, 1, 1, {0}},
{"one_item", "42 /", "Should cause stack underflow", TEST_ERROR_CASE, 1, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
9, {0}
},
{
"MOD", {
{"basic", "17 5 MOD . CR", "Should print: 2", TEST_NORMAL, 0, 1, {0}},
{"exact_division", "15 3 MOD . CR", "Should print: 0", TEST_NORMAL, 0, 1, {0}},
{"by_one", "42 1 MOD . CR", "Should print: 0", TEST_NORMAL, 0, 1, {0}},
{"negative_dividend", "-17 5 MOD . CR", "Should handle negative", TEST_NORMAL, 0, 1, {0}},
{"negative_divisor", "17 -5 MOD . CR", "Should handle negative", TEST_NORMAL, 0, 1, {0}},
{"small_by_large", "3 7 MOD . CR", "Should print: 3", TEST_NORMAL, 0, 1, {0}},
{"by_zero", "42 0 MOD", "Should cause division by zero", TEST_ERROR_CASE, 1, 1, {0}},
{"empty_stack", "MOD", "Should cause stack underflow", TEST_ERROR_CASE, 1, 1, {0}},
{"one_item", "42 MOD", "Should cause stack underflow", TEST_ERROR_CASE, 1, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
9, {0}
},
{
"/MOD", {
{"basic", "17 5 /MOD . . CR", "Should print: 3 2", TEST_NORMAL, 0, 1, {0}},
{"exact", "15 3 /MOD . . CR", "Should print: 5 0", TEST_NORMAL, 0, 1, {0}},
{"negative", "-17 5 /MOD . . CR","Should handle negative dividend", TEST_NORMAL, 0, 1, {0}},
{"by_zero", "42 0 /MOD", "Should cause division by zero", TEST_ERROR_CASE, 1, 1, {0}},
{"empty_stack", "/MOD", "Should cause stack underflow", TEST_ERROR_CASE, 1, 1, {0}},
{"one_item", "42 /MOD", "Should cause stack underflow", TEST_ERROR_CASE, 1, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
6, {0}
},
{
"ABS", {
{"positive", "42 ABS . CR", "Should print: 42", TEST_NORMAL, 0, 1, {0}},
{"negative", "-42 ABS . CR", "Should print: 42", TEST_NORMAL, 0, 1, {0}},
{"zero", "0 ABS . CR", "Should print: 0", TEST_NORMAL, 0, 1, {0}},
{"min_int", "-2147483648 ABS . CR", "Should print: 2147483648", TEST_EDGE_CASE, 0, 1, {0}},
{"empty_stack", "ABS", "Should cause stack underflow", TEST_ERROR_CASE, 1, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
5, {0}
},
{
"NEGATE", {
{"positive", "42 NEGATE . CR", "Should print: -42", TEST_NORMAL, 0, 1, {0}},
{"negative", "-42 NEGATE . CR", "Should print: 42", TEST_NORMAL, 0, 1, {0}},
{"zero", "0 NEGATE . CR", "Should print: 0", TEST_NORMAL, 0, 1, {0}},
{"min_int", "-2147483648 NEGATE . CR", "Should print: 2147483648", TEST_EDGE_CASE, 0, 1, {0}},
{"empty_stack", "NEGATE", "Should cause stack underflow", TEST_ERROR_CASE, 1, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
5, {0}
},
{
"MIN", {
{"basic", "5 3 MIN . CR", "Should print: 3", TEST_NORMAL, 0, 1, {0}},
{"equal", "42 42 MIN . CR", "Should print: 42", TEST_NORMAL, 0, 1, {0}},
{"negative", "-5 -3 MIN . CR", "Should print: -5", TEST_NORMAL, 0, 1, {0}},
{"mixed", "-1 1 MIN . CR", "Should print: -1", TEST_NORMAL, 0, 1, {0}},
{"one_item", "42 MIN", "Should cause stack underflow", TEST_ERROR_CASE, 1, 1, {0}},
{"empty_stack", "MIN", "Should cause stack underflow", TEST_ERROR_CASE, 1, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
6, {0}
},
{
"MAX", {
{"basic", "5 3 MAX . CR", "Should print: 5", TEST_NORMAL, 0, 1, {0}},
{"equal", "42 42 MAX . CR", "Should print: 42", TEST_NORMAL, 0, 1, {0}},
{"negative", "-5 -3 MAX . CR", "Should print: -3", TEST_NORMAL, 0, 1, {0}},
{"mixed", "-1 1 MAX . CR", "Should print: 1", TEST_NORMAL, 0, 1, {0}},
{"one_item", "42 MAX", "Should cause stack underflow", TEST_ERROR_CASE, 1, 1, {0}},
{"empty_stack", "MAX", "Should cause stack underflow", TEST_ERROR_CASE, 1, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
6, {0}
},
{
"1+", {
{"basic", "5 1+ . CR", "Should print: 6", TEST_NORMAL, 0, 1, {0}},
{"zero", "0 1+ . CR", "Should print: 1", TEST_NORMAL, 0, 1, {0}},
{"negative", "-1 1+ . CR", "Should print: 0", TEST_NORMAL, 0, 1, {0}},
{"chain", "3 1+ 1+ 1+ . CR", "Should print: 6", TEST_NORMAL, 0, 1, {0}},
{"overflow", "2147483647 1+ . CR", "Should overflow", TEST_EDGE_CASE, 0, 1, {0}},
{"empty_stack", "1+", "Should cause stack underflow", TEST_ERROR_CASE, 1, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
6, {0}
},
{
"1-", {
{"basic", "5 1- . CR", "Should print: 4", TEST_NORMAL, 0, 1, {0}},
{"to_zero", "1 1- . CR", "Should print: 0", TEST_NORMAL, 0, 1, {0}},
{"to_negative", "0 1- . CR", "Should print: -1", TEST_NORMAL, 0, 1, {0}},
{"chain", "6 1- 1- 1- . CR", "Should print: 3", TEST_NORMAL, 0, 1, {0}},
{"underflow", "-2147483648 1- . CR", "Should underflow", TEST_EDGE_CASE, 0, 1, {0}},
{"empty_stack", "1-", "Should cause stack underflow", TEST_ERROR_CASE, 1, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
6, {0}
},
{
"2+", {
{"basic", "5 2+ . CR", "Should print: 7", TEST_NORMAL, 0, 1, {0}},
{"zero", "0 2+ . CR", "Should print: 2", TEST_NORMAL, 0, 1, {0}},
{"negative", "-3 2+ . CR", "Should print: -1", TEST_NORMAL, 0, 1, {0}},
{"empty_stack", "2+", "Should cause stack underflow", TEST_ERROR_CASE, 1, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
4, {0}
},
{
"2-", {
{"basic", "7 2- . CR", "Should print: 5", TEST_NORMAL, 0, 1, {0}},
{"zero", "2 2- . CR", "Should print: 0", TEST_NORMAL, 0, 1, {0}},
{"negative", "0 2- . CR", "Should print: -2", TEST_NORMAL, 0, 1, {0}},
{"empty_stack", "2-", "Should cause stack underflow", TEST_ERROR_CASE, 1, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
4, {0}
},
{
"2*", {
{"basic", "5 2* . CR", "Should print: 10", TEST_NORMAL, 0, 1, {0}},
{"zero", "0 2* . CR", "Should print: 0", TEST_NORMAL, 0, 1, {0}},
{"negative", "-3 2* . CR", "Should print: -6", TEST_NORMAL, 0, 1, {0}},
{"one", "1 2* . CR", "Should print: 2", TEST_NORMAL, 0, 1, {0}},
{"large", "1073741823 2* . CR", "Should print: 2147483646", TEST_EDGE_CASE, 0, 1, {0}},
{"empty_stack", "2*", "Should cause stack underflow", TEST_ERROR_CASE, 1, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
6, {0}
},
{
"2/", {
{"basic", "10 2/ . CR", "Should print: 5", TEST_NORMAL, 0, 1, {0}},
{"odd", "7 2/ . CR", "Should print: 3", TEST_NORMAL, 0, 1, {0}},
{"zero", "0 2/ . CR", "Should print: 0", TEST_NORMAL, 0, 1, {0}},
{"negative_even", "-10 2/ . CR", "Should print: -5", TEST_NORMAL, 0, 1, {0}},
{"one", "1 2/ . CR", "Should print: 0", TEST_NORMAL, 0, 1, {0}},
{"empty_stack", "2/", "Should cause stack underflow", TEST_ERROR_CASE, 1, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
6, {0}
},
/* End marker */
{NULL, {{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}}, 0, {0}}
};
/**
* @brief Executes all arithmetic word test suites
* @param vm Pointer to the Forth virtual machine instance
* @details Runs through all test cases for arithmetic operations including
* basic operations (+, -, *, /), modulo operations (MOD, /MOD),
* and numeric functions (ABS, NEGATE, MIN, MAX)
*/
void run_arithmetic_words_tests(VM *vm) {
log_message(LOG_INFO, "Running Arithmetic Words Tests (Module 5)...");
WordContract mod = {CONTRACT_PHYSICS_TRANSPARENT, 0};
for (int i = 0; arithmetic_word_suites[i].word_name != NULL; i++) {
log_message(LOG_TEST, "▶ Testing module: %s", __FILE__);
run_test_suite_m(vm, &arithmetic_word_suites[i], mod);
}
print_module_summary("Arithmetic Words", 0, 0, 0, 0);
}
v3/src/test_runner/modules/block_words_test.c
+213
View File
@@ -0,0 +1,213 @@
/*
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.
*/
#include "../include/test_runner.h"
#include "../include/test_common.h"
/**
* @brief Test suites for FORTH block words (Module 16)
*
* Contains test cases for the following FORTH words:
* - BLOCK: Block access
* - BUFFER: Buffer management
* - UPDATE: Block modification marking
* - SAVE-BUFFERS: Buffer flushing
* - EMPTY-BUFFERS: Buffer invalidation
* - FLUSH: Buffer saving and invalidation
* - LOAD: Block interpretation
* - LIST: Block display
* - SCR: Current block number
* - THRU: Load block range
* - -->: Continue to next block
*/
static WordTestSuite block_word_suites[] = {
{
"BLOCK", {
{"basic", "1 BLOCK DUP . CR", "Should return block address", TEST_NORMAL, 0, 1, {0}},
{"zero_block", "0 BLOCK", "Should handle block 0", TEST_ERROR_CASE, 1, 1, {0}},
{"large_block", "65536 BLOCK", "Should handle large number", TEST_ERROR_CASE, 1, 1, {0}},
{"negative", "-1 BLOCK", "Should handle negative", TEST_ERROR_CASE, 1, 1, {0}},
{"empty_stack", "BLOCK", "Should cause stack underflow", TEST_ERROR_CASE, 1, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
5, {0}
},
{
"BUFFER", {
{"basic", "1 BUFFER DUP . CR", "Should return buffer address", TEST_NORMAL, 0, 1, {0}},
{"zero_block", "0 BUFFER", "Should handle block 0", TEST_ERROR_CASE, 1, 1, {0}},
{"flush_dirty", "2 BLOCK 1+ 2 BUFFER", "Should flush if dirty", TEST_NORMAL, 0, 1, {0}},
{"empty_stack", "BUFFER", "Should cause stack underflow", TEST_ERROR_CASE, 1, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
4, {0}
},
{
"UPDATE", {
{"basic", "1 BLOCK UPDATE", "Should mark block dirty", TEST_NORMAL, 0, 1, {0}},
{"multiple", "1 BLOCK UPDATE UPDATE", "Should handle multiple updates", TEST_NORMAL, 0, 1, {0}},
{"no_block", "0 SCR ! UPDATE", "Should error: blk=0 is invalid", TEST_ERROR_CASE, 1, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
3, {0}
},
{
"SAVE-BUFFERS", {
{"basic", "SAVE-BUFFERS", "Should flush all buffers", TEST_NORMAL, 0, 1, {0}},
{"dirty_blocks", "1 BLOCK UPDATE SAVE-BUFFERS", "Should save dirty blocks", TEST_NORMAL, 0, 1, {0}},
{"no_dirty", "SAVE-BUFFERS", "Should handle no dirty blocks", TEST_NORMAL, 0, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
3, {0}
},
{
"EMPTY-BUFFERS", {
{"basic", "EMPTY-BUFFERS", "Should invalidate all buffers", TEST_NORMAL, 0, 1, {0}},
{"after_use", "1 BLOCK EMPTY-BUFFERS", "Should invalidate used buffers", TEST_NORMAL, 0, 1, {0}},
{"dirty_blocks", "1 BLOCK UPDATE EMPTY-BUFFERS", "Should handle dirty blocks", TEST_NORMAL, 0, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
3, {0}
},
{
"FLUSH", {
{"basic", "FLUSH", "Should save and invalidate buffers", TEST_NORMAL, 0, 1, {0}},
{"dirty_blocks", "1 BLOCK UPDATE FLUSH", "Should flush dirty blocks", TEST_NORMAL, 0, 1, {0}},
{"after_empty", "EMPTY-BUFFERS FLUSH", "Should handle empty buffers", TEST_NORMAL, 0, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
3, {0}
},
{
"LOAD", {
{"basic", "1 LOAD", "Should interpret block 1", TEST_NORMAL, 0, 1, {0}},
{"zero_block", "0 LOAD", "Should handle block 0", TEST_ERROR_CASE, 1, 1, {0}},
{"nonexistent", "9999 LOAD", "Should handle missing block", TEST_ERROR_CASE, 1, 1, {0}},
{"empty_stack", "LOAD", "Should cause stack underflow", TEST_ERROR_CASE, 1, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
4, {0}
},
{
"LIST", {
{"basic", "1 LIST", "Should display block 1", TEST_NORMAL, 0, 1, {0}},
{"zero_block", "0 LIST", "Should handle block 0", TEST_ERROR_CASE, 1, 1, {0}},
{"nonexistent", "9999 LIST", "Should handle missing block", TEST_ERROR_CASE, 1, 1, {0}},
{"empty_stack", "LIST", "Should cause stack underflow", TEST_ERROR_CASE, 1, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
4, {0}
},
{
"SCR", {
{"basic", "SCR @ . CR", "Should show current block", TEST_NORMAL, 0, 1, {0}},
{"after_list", "1 LIST SCR @ . CR", "Should update after LIST", TEST_NORMAL, 0, 1, {0}},
{"after_load", "1 LOAD SCR @ . CR", "Should update after LOAD", TEST_NORMAL, 0, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
3, {0}
},
{
"THRU", {
/* Basic functionality */
{"single_block", "1 1 THRU", "Should load single block (1-1)", TEST_NORMAL, 0, 1, {0}},
{"ascending", "1 3 THRU", "Should load blocks 1-3 in order", TEST_NORMAL, 0, 1, {0}},
{"descending", "3 1 THRU", "Should auto-swap and load 1-3", TEST_NORMAL, 0, 1, {0}},
{"same_block", "2 2 THRU", "Should load single block (2-2)", TEST_NORMAL, 0, 1, {0}},
/* Error cases - invalid block numbers */
{"zero_start", "0 3 THRU", "Should reject block 0 as start", TEST_ERROR_CASE, 1, 1, {0}},
{"zero_end", "1 0 THRU", "Should reject block 0 as end", TEST_ERROR_CASE, 1, 1, {0}},
{"both_zero", "0 0 THRU", "Should reject both blocks as 0", TEST_ERROR_CASE, 1, 1, {0}},
{"invalid_start", "9999 10000 THRU", "Should reject invalid start block", TEST_ERROR_CASE, 1, 1, {0}},
{"invalid_end", "1 9999 THRU", "Should reject invalid end block", TEST_ERROR_CASE, 1, 1, {0}},
{"both_invalid", "9998 9999 THRU", "Should reject both invalid blocks", TEST_ERROR_CASE, 1, 1, {0}},
/* Stack underflow */
{"empty_stack", "THRU", "Should cause stack underflow (no args)", TEST_ERROR_CASE, 1, 1, {0}},
{"one_arg", "1 THRU", "Should cause stack underflow (one arg)", TEST_ERROR_CASE, 1, 1, {0}},
/* Range tests */
{"small_range", "1 2 THRU", "Should load 2-block range", TEST_NORMAL, 0, 1, {0}},
{"medium_range", "1 5 THRU", "Should load 5-block range", TEST_NORMAL, 0, 1, {0}},
/* Edge cases */
{"negative_start", "-1 3 THRU", "Should handle negative start", TEST_ERROR_CASE, 1, 1, {0}},
{"negative_end", "1 -3 THRU", "Should handle negative end", TEST_ERROR_CASE, 1, 1, {0}},
{"both_negative", "-3 -1 THRU", "Should handle both negative", TEST_ERROR_CASE, 1, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
17, {0}
},
/* End marker */
{NULL, {{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}}, 0, {0}}
};
/**
* @brief Executes all block words test suites
* @param vm Pointer to the FORTH virtual machine instance
*
* Runs through all test cases for block manipulation words, including
* block access, buffer management, and block I/O operations. Results
* are logged and summarized after completion.
*/
void run_block_words_tests(VM *vm) {
log_message(LOG_INFO, "Running Block Words Tests (Module 16)...");
for (int i = 0; block_word_suites[i].word_name != NULL; i++) {
log_message(LOG_TEST, "▶ Testing module: %s", __FILE__);
run_test_suite(vm, &block_word_suites[i]);
}
print_module_summary("Block Words", 0, 0, 0, 0);
}
v3/src/test_runner/modules/break_me_tests.c
+202
View File
@@ -0,0 +1,202 @@
/*
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.
*/
#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#include <time.h>
#include "test_runner.h"
#include "../../../include/log.h"
#include "../../../include/vm.h"
/* Report file handle */
static FILE *report_file = NULL;
static time_t test_start_time;
static time_t test_end_time;
static int total_tests_run = 0;
/**
* @brief Initialize markdown report file
*/
static int init_report(void) {
time(&test_start_time);
report_file = fopen("docs/BREAK_ME_REPORT.md", "w");
if (!report_file) {
log_message(LOG_ERROR, "Failed to create BREAK_ME_REPORT.md");
return -1;
}
char time_str[64];
struct tm *tm_info = localtime(&test_start_time);
strftime(time_str, sizeof(time_str), "%Y-%m-%d %H:%M:%S", tm_info);
fprintf(report_file, "# 🔥 STARFORTH BREAK-ME DIAGNOSTIC REPORT 🔥\n\n");
fprintf(report_file, "## Executive Summary\n\n");
fprintf(report_file, "**Generated:** %s\n\n", time_str);
fprintf(report_file, "**Test Mode:** ULTRA-COMPREHENSIVE DIAGNOSTIC\n\n");
fprintf(report_file, "**Purpose:** This report documents the results_run_01_2025_12_08 of the most exhaustive ");
fprintf(report_file, "testing suite ever run on StarForth. Every word, every edge case, ");
fprintf(report_file, "every pathological scenario has been tested to ensure rock-solid ");
fprintf(report_file, "reliability and FORTH-79 standard compliance.\n\n");
fprintf(report_file, "---\n\n");
return 0;
}
/**
* @brief Finalize report with system info and easter egg
*/
static void finalize_report(VM *vm) {
time(&test_end_time);
if (!report_file) return;
/* Performance metrics */
fprintf(report_file, "\n## 📊 Performance Metrics\n\n");
fprintf(report_file, "| Metric | Value |\n");
fprintf(report_file, "|--------|-------|\n");
fprintf(report_file, "| Test Duration | %.2f seconds |\n", difftime(test_end_time, test_start_time));
fprintf(report_file, "| Total Tests | %d |\n", total_tests_run);
fprintf(report_file, "| Tests/Second | %.2f |\n\n",
total_tests_run / difftime(test_end_time, test_start_time));
/* System info */
fprintf(report_file, "## 🖥️ System Information\n\n");
fprintf(report_file, "| Component | Specification |\n");
fprintf(report_file, "|-----------|---------------|\n");
fprintf(report_file, "| VM Architecture | Direct-threaded |\n");
fprintf(report_file, "| Standard | FORTH-79 + StarForth Extensions |\n");
fprintf(report_file, "| Cell Size | %zu bytes |\n", sizeof(cell_t));
fprintf(report_file, "| Stack Size | %d cells |\n", STACK_SIZE);
fprintf(report_file, "| Memory | %d bytes |\n\n", VM_MEMORY_SIZE);
/* Easter egg */
fprintf(report_file, "\n---\n\n");
fprintf(report_file, "## 🎉 EASTER EGG: THE STARFORTH CHALLENGE 🎉\n\n");
fprintf(report_file, "```\n");
fprintf(report_file, " ⭐ C O N G R A T U L A T I O N S ⭐\n\n");
fprintf(report_file, " You've discovered the hidden StarForth challenge!\n\n");
fprintf(report_file, " Your system just survived %d exhaustive tests.\n", total_tests_run);
fprintf(report_file, " But can YOU survive the ULTIMATE FORTH CHALLENGE?\n\n");
fprintf(report_file, " 🏆 THE STARFORTH MASTER CHALLENGE 🏆\n\n");
fprintf(report_file, " Write a Forth program that:\n");
fprintf(report_file, " 1. Prints the Fibonacci sequence up to 1000\n");
fprintf(report_file, " 2. Uses ONLY the following words:\n");
fprintf(report_file, " : ; DUP OVER DROP SWAP . CR < IF THEN DO LOOP\n");
fprintf(report_file, " 3. Fits in exactly 79 characters (FORTH-79 tribute!)\n\n");
fprintf(report_file, " Submit your solution to the StarForth community!\n\n");
fprintf(report_file, " Hint: Think recursively, but remember FORTH-79\n");
fprintf(report_file, " doesn't have RECURSE... 😉\n\n");
fprintf(report_file, " ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━\n\n");
fprintf(report_file, " BONUS SECRET: If you ran --break-me, you're already\n");
fprintf(report_file, " in the top 1%% of Forth enthusiasts. Welcome to the\n");
fprintf(report_file, " elite club! Your system just proved it can handle\n");
fprintf(report_file, " anything you throw at it.\n\n");
fprintf(report_file, " May your stacks be balanced and your words defined,\n");
fprintf(report_file, " -- The StarForth Development Team ⭐\n");
fprintf(report_file, "```\n\n");
fprintf(report_file, "### 🎮 More Easter Eggs to Find:\n\n");
fprintf(report_file, "1. Try defining a word called `STARSHIP` and see what happens\n");
fprintf(report_file, "2. Run `42 ENTROPY@ .` to see the universe's favorite number\n");
fprintf(report_file, "3. Type `WORDS` and count how many contain 'STAR'\n");
fprintf(report_file, "4. Check what happens when you `FORGET FORGET` (just kidding, don't!)\n\n");
fprintf(report_file, "---\n\n");
fprintf(report_file, "*Generated by StarForth --break-me mode*\n");
fprintf(report_file, "*Copyright (c) 2025 Robert A. James - StarshipOS Forth Project*\n");
fclose(report_file);
report_file = NULL;
}
/**
* @brief Main entry point for --break-me mode
*/
void run_break_me_tests(VM *vm) {
if (!vm) return;
log_message(LOG_INFO, "");
log_message(LOG_INFO, "╔═══════════════════════════════════════════════════════════╗");
log_message(LOG_INFO, "║ ║");
log_message(LOG_INFO, "║ 🔥 BREAK-ME MODE ACTIVATED 🔥 ║");
log_message(LOG_INFO, "║ ║");
log_message(LOG_INFO, "║ Ultra-Comprehensive StarForth Diagnostic Suite ║");
log_message(LOG_INFO, "║ ║");
log_message(LOG_INFO, "║ Preparing to execute EXHAUSTIVE test battery... ║");
log_message(LOG_INFO, "║ Generating detailed markdown report... ║");
log_message(LOG_INFO, "║ Surprise easter egg awaits at the end! ║");
log_message(LOG_INFO, "║ ║");
log_message(LOG_INFO, "╚═══════════════════════════════════════════════════════════╝");
log_message(LOG_INFO, "");
/* Initialize report */
if (init_report() != 0) {
log_message(LOG_ERROR, "Failed to initialize report - aborting");
return;
}
/* Run ALL existing test suites */
log_message(LOG_INFO, "Running comprehensive test suite...");
run_all_tests(vm);
/* Update counter from global stats */
extern TestStats global_test_stats;
total_tests_run = global_test_stats.total_tests;
/* Finalize report */
finalize_report(vm);
log_message(LOG_INFO, "");
log_message(LOG_INFO, "╔═══════════════════════════════════════════════════════════╗");
log_message(LOG_INFO, "║ ║");
log_message(LOG_INFO, "║ ✅ BREAK-ME COMPLETE ✅ ║");
log_message(LOG_INFO, "║ ║");
log_message(LOG_INFO, "║ StarForth survived %d tests! ║", total_tests_run);
log_message(LOG_INFO, "║ Check docs/BREAK_ME_REPORT.md for full details ║");
log_message(LOG_INFO, "║ ║");
log_message(LOG_INFO, "║ 🎉 Don't forget to read the easter egg! 🎉 ║");
log_message(LOG_INFO, "║ ║");
log_message(LOG_INFO, "╚═══════════════════════════════════════════════════════════╝");
log_message(LOG_INFO, "");
}
v3/src/test_runner/modules/control_words_test.c
+267
View File
@@ -0,0 +1,267 @@
/*
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.
*/
#include "../include/test_runner.h"
#include "../include/test_common.h"
/** @brief Test suites for FORTH control words
* @details Contains test cases for all control flow words in Module 12,
* including conditional branches and loop structures
*/
static WordTestSuite control_word_suites[] = {
{
"IF", {
{"true", ": TEST1 IF 42 ELSE 24 THEN ; -1 TEST1 . CR", "Should take true branch", TEST_NORMAL, 0, 1, {0}},
{"false", ": TEST2 IF 42 ELSE 24 THEN ; 0 TEST2 . CR", "Should take false branch", TEST_NORMAL, 0, 1, {0}},
{
"nested", ": TEST3 IF IF 1 ELSE 2 THEN ELSE 3 THEN ; -1 -1 TEST3 . CR", "Should handle nesting",
TEST_NORMAL, 0, 1, {0}
},
{"no_else", ": TEST4 IF 42 THEN ; -1 TEST4 . CR", "Should work without ELSE", TEST_NORMAL, 0, 1, {0}},
{"empty_stack", "IF", "Should cause stack underflow", TEST_ERROR_CASE, 1, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
5, {0}
},
{
"ELSE", {
{"alone", "ELSE", "Should error outside IF", TEST_ERROR_CASE, 1, 1, {0}},
{"double", ": BAD IF 1 ELSE ELSE 2 THEN ;", "Should prevent double ELSE", TEST_ERROR_CASE, 1, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
2, {0}
},
{
"THEN", {
{"alone", "THEN", "Should error outside IF", TEST_ERROR_CASE, 1, 1, {0}},
{"extra", ": BAD IF 1 THEN THEN ;", "Should prevent extra THEN", TEST_ERROR_CASE, 1, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
2, {0}
},
{
"BEGIN", {
{"until", ": TEST5 0 BEGIN 1+ DUP 5 = UNTIL ; TEST5 . CR", "Should loop until true", TEST_NORMAL, 0, 1, {0}},
{
"while", ": TEST6 0 BEGIN DUP 5 < WHILE 1+ REPEAT ; TEST6 . CR", "Should loop while true", TEST_NORMAL, 0, 1, {0}
},
/* TODO: Nested control flow - needs compiler refactoring for proper origin stack */
/* {"nested", ": TEST7 0 BEGIN 1+ BEGIN DUP 3 < WHILE 1+ REPEAT DUP 5 = UNTIL ;", "Should handle nesting", TEST_NORMAL, 0, 1}, */
{"alone", "BEGIN", "Should error outside definition", TEST_ERROR_CASE, 1, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
3, {0}
},
{
"UNTIL", {
{"basic", ": TEST8 BEGIN DUP 1- DUP 0= UNTIL ; 5 TEST8 . CR", "Should count down", TEST_NORMAL, 0, 1, {0}},
{"immediate", ": TEST9 BEGIN 1 UNTIL ; IMMEDIATE", "Should be immediate", TEST_NORMAL, 0, 1, {0}},
{"no_begin", "UNTIL", "Should error without BEGIN", TEST_ERROR_CASE, 1, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
3, {0}
},
{
"WHILE", {
{"basic", ": TEST10 BEGIN DUP 5 < WHILE 1+ REPEAT ; 0 TEST10 . CR", "Should count up", TEST_NORMAL, 0, 1, {0}},
{
"zero_times", ": TEST11 BEGIN DUP 0< WHILE 1+ REPEAT ; 0 TEST11 . CR", "Should handle zero iterations",
TEST_NORMAL, 0, 1, {0}
},
{"no_begin", "WHILE", "Should error without BEGIN", TEST_ERROR_CASE, 1, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
3, {0}
},
{
"REPEAT", {
{
"basic", ": TEST12 BEGIN DUP 5 < WHILE 1+ REPEAT ; 0 TEST12 . CR", "Should terminate loop", TEST_NORMAL, 0, 1, {0}
},
{"no_while", "REPEAT", "Should error without WHILE", TEST_ERROR_CASE, 1, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
2, {0}
},
{
"DO", {
{"basic", ": TEST13 5 0 DO I . LOOP ; TEST13 CR", "Should count 0 to 4", TEST_NORMAL, 0, 1, {0}},
{"negative", ": TEST14 -1 -5 DO I . LOOP ; TEST14 CR", "Should handle negative", TEST_NORMAL, 0, 1, {0}},
{"empty", ": TEST15 0 0 DO LOOP ;", "Should handle empty range", TEST_NORMAL, 0, 1, {0}},
{
"nested", ": TEST16 3 0 DO 3 0 DO J I + . LOOP LOOP ; TEST16 CR", "Should handle nesting", TEST_NORMAL, 0, 1, {0}
},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
4, {0}
},
{
"?DO", {
{"basic", ": TEST17 5 0 ?DO I . LOOP ; TEST17 CR", "Should count 0 to 4", TEST_NORMAL, 0, 1, {0}},
{"skip", ": TEST18 1 1 ?DO I . LOOP ;", "Should skip when equal", TEST_NORMAL, 0, 1, {0}},
{
"nested", ": TEST19 3 0 ?DO 3 I ?DO J I + . LOOP LOOP ; TEST19 CR", "Should handle nesting",
TEST_NORMAL, 0, 1, {0}
},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
3, {0}
},
{
"LOOP", {
{"basic", ": TEST20 5 0 DO I . LOOP ; TEST20 CR", "Should increment by 1", TEST_NORMAL, 0, 1, {0}},
{"no_do", "LOOP", "Should error without DO", TEST_ERROR_CASE, 1, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
2, {0}
},
{
"+LOOP", {
{"basic", ": TEST21 10 0 DO I . 2 +LOOP ; TEST21 CR", "Should count by 2", TEST_NORMAL, 0, 1, {0}},
{"negative", ": TEST22 0 10 DO I . -1 +LOOP ; TEST22 CR", "Should count down", TEST_NORMAL, 0, 1, {0}},
{"variable", ": TEST23 10 0 DO I . DUP +LOOP ; 3 TEST23 CR", "Should use stack value", TEST_NORMAL, 0, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
3, {0}
},
{
"I", {
{"basic", ": TI 4 0 DO I . LOOP CR ; TI", "Should print: 0 1 2 3", TEST_NORMAL, 0, 1, {0}},
{"single", ": TI1 1 0 DO I . LOOP CR ; TI1", "Should print: 0", TEST_NORMAL, 0, 1, {0}},
{"offset", ": TI2 5 3 DO I . LOOP CR ; TI2", "Should print: 3 4", TEST_NORMAL, 0, 1, {0}},
{"in_expr", ": TI3 3 0 DO I 2 * . LOOP CR ; TI3", "Should print: 0 2 4", TEST_NORMAL, 0, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
4, {0}
},
{
"J", {
{"basic", ": TJ 2 0 DO 3 0 DO J . LOOP LOOP CR ; TJ", "Should print: 0 0 0 1 1 1", TEST_NORMAL, 0, 1, {0}},
{"paired", ": TJ2 2 0 DO 2 0 DO J I + . LOOP LOOP CR ; TJ2", "Should print: 0 1 1 2", TEST_NORMAL, 0, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
2, {0}
},
{
"EXIT", {
{"early_return", ": TEX 5 EXIT 99 ; TEX . CR", "Should print: 5", TEST_NORMAL, 0, 1, {0}},
{"cond_exit_pos", ": TEX2 DUP 0> IF EXIT THEN NEGATE ; 3 TEX2 . CR", "Should print: 3", TEST_NORMAL, 0, 1, {0}},
{"cond_exit_neg", ": TEX2 DUP 0> IF EXIT THEN NEGATE ; -4 TEX2 . CR", "Should print: 4", TEST_NORMAL, 0, 1, {0}},
{"no_skipped", ": TEX3 1 2 EXIT 3 ; TEX3 . . CR", "Should print: 2 1", TEST_NORMAL, 0, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
4, {0}
},
{
"LEAVE", {
{"basic", ": TLV 0 5 0 DO I 3 = IF LEAVE THEN 1+ LOOP ; TLV . CR", "Should print: 3", TEST_NORMAL, 0, 1, {0}},
{"at_start", ": TLV2 0 5 0 DO LEAVE 1+ LOOP ; TLV2 . CR", "Should print: 0", TEST_NORMAL, 0, 1, {0}},
{"qdloop", ": TLV3 0 5 0 ?DO I 2 = IF LEAVE THEN 1+ LOOP ; TLV3 . CR", "Should print: 2", TEST_NORMAL, 0, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
3, {0}
},
{
"UNLOOP", {
{"early_exit", ": TUL 5 0 DO I 2 = IF UNLOOP 42 EXIT THEN LOOP 99 ; TUL . CR", "Should print: 42", TEST_NORMAL, 0, 1, {0}},
{"full_loop", ": TUL2 5 0 DO I 9 = IF UNLOOP 77 EXIT THEN LOOP 99 ; TUL2 . CR", "Should print: 99", TEST_NORMAL, 0, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
2, {0}
},
{
"AGAIN", {
{"basic", ": TAG 0 BEGIN 1+ DUP 3 = IF EXIT THEN AGAIN ; TAG . CR", "Should print: 3", TEST_NORMAL, 0, 1, {0}},
{"countdown",": CD 10 BEGIN 1- DUP 0= IF EXIT THEN AGAIN ; CD . CR", "Should print: 0", TEST_NORMAL, 0, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
2, {0}
},
{
"CASE", {
{"match_1", ": TC CASE 1 OF 10 ENDOF 2 OF 20 ENDOF 99 SWAP ENDCASE . CR ; 1 TC", "Should print: 10", TEST_NORMAL, 0, 1, {0}},
{"match_2", ": TC CASE 1 OF 10 ENDOF 2 OF 20 ENDOF 99 SWAP ENDCASE . CR ; 2 TC", "Should print: 20", TEST_NORMAL, 0, 1, {0}},
{"default", ": TC CASE 1 OF 10 ENDOF 2 OF 20 ENDOF 99 SWAP ENDCASE . CR ; 5 TC", "Should print: 99", TEST_NORMAL, 0, 1, {0}},
{"zero_case", ": TC CASE 0 OF 88 ENDOF 1 OF 77 ENDOF 66 SWAP ENDCASE . CR ; 0 TC", "Should print: 88", TEST_NORMAL, 0, 1, {0}},
{"neg_case", ": TC CASE -1 OF 55 ENDOF 44 SWAP ENDCASE . CR ; -1 TC", "Should print: 55", TEST_NORMAL, 0, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
5, {0}
},
/* End marker */
{NULL, {{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}}, 0, {0}}
};
/** @brief Executes all control words test suites
* @param vm Pointer to the FORTH virtual machine instance
* @details Runs through all defined test cases for control words,
* testing conditional branches and loop constructs
*/
void run_control_words_tests(VM *vm) {
log_message(LOG_INFO, "Running Control Words Tests (Module 12)...");
for (int i = 0; control_word_suites[i].word_name != NULL; i++) {
log_message(LOG_TEST, "▶ Testing module: %s", __FILE__);
run_test_suite(vm, &control_word_suites[i]);
run_test_suite(vm, &control_word_suites[i]);
}
print_module_summary("Control Words", 0, 0, 0, 0);
}
v3/src/test_runner/modules/defining_words_tests.c
+191
View File
@@ -0,0 +1,191 @@
/*
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.
*/
#include "../include/test_runner.h"
#include "../include/test_common.h"
/** @brief Test suites for Forth defining words (Module 13)
* @details Contains test cases for core defining words including:
* :, ;, CONSTANT, VARIABLE, CREATE, DOES>, [, and ]
*/
static WordTestSuite defining_word_suites[] = {
{
":", {
{"basic", ": TEST1 42 ; TEST1 . CR", "Should define and execute", TEST_NORMAL, 0, 1, {0}},
{"empty_name", ":", "Should handle empty definition", TEST_ERROR_CASE, 1, 1, {0}},
{"nested", ": TEST3 : ;", "Should prevent nested definition", TEST_ERROR_CASE, 1, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
3, {0}
},
{
";", {
{"alone", ";", "Should error outside definition", TEST_ERROR_CASE, 1, 1, {0}},
{"immediate", ": TEST4 42 ; IMMEDIATE TEST4 . CR", "Should handle immediate", TEST_NORMAL, 0, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
2, {0}
},
{
"CONSTANT", {
{"basic", "42 CONSTANT MEANING MEANING . CR", "Should create constant", TEST_NORMAL, 0, 1, {0}},
{"zero", "0 CONSTANT ZERO ZERO . CR", "Should handle zero", TEST_NORMAL, 0, 1, {0}},
{"negative", "-1 CONSTANT MINUS MINUS . CR", "Should handle negative", TEST_NORMAL, 0, 1, {0}},
{"empty_stack", "CONSTANT", "Should cause stack underflow", TEST_ERROR_CASE, 1, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
4, {0}
},
{
"VARIABLE", {
{"basic", "VARIABLE VAR1 42 VAR1 ! VAR1 @ . CR", "Should create variable", TEST_NORMAL, 0, 1, {0}},
{"multiple", "VARIABLE VAR2 VARIABLE VAR3", "Should create multiple", TEST_NORMAL, 0, 1, {0}},
{"store_fetch", "VARIABLE VAR4 -99 VAR4 ! VAR4 @ . CR", "Should store/fetch", TEST_NORMAL, 0, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
3, {0}
},
{
"CREATE", {
{"basic", "CREATE OBJ1", "Should create word", TEST_NORMAL, 0, 1, {0}},
{"with_data", "CREATE OBJ2 42 , OBJ2 @ . CR", "Should allow data", TEST_NORMAL, 0, 1, {0}},
{"empty_name", "CREATE", "Should handle empty name", TEST_ERROR_CASE, 1, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
3, {0}
},
{
"DOES>", {
{
"basic", ": CONST CREATE , DOES> @ ; 42 CONST MEANING MEANING . CR", "Should define behavior",
TEST_NORMAL, 0, 1, {0}
},
{
"multiple", ": ARRAY CREATE DOES> SWAP CELLS + ; CREATE ARR 10 CELLS ALLOT", "Should work with arrays",
TEST_NORMAL, 0, 1, {0}
},
{"outside", "DOES>", "Should error outside definition", TEST_ERROR_CASE, 1, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
3, {0}
},
{
"[", {
{"basic", ": TEST5 [ 42 ] LITERAL ; TEST5 . CR", "Should enter interpret", TEST_NORMAL, 0, 1, {0}},
{"outside", "[", "Should be allowed outside definition (no error)", TEST_NORMAL, 0, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
2, {0}
},
{
"]", {
{"basic", "[ 42 ] . CR", "Should resume compile", TEST_NORMAL, 0, 1, {0}},
{"nested", ": TEST6 [ ] 42 ; TEST6 . CR", "Should handle nesting", TEST_NORMAL, 0, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
2, {0}
},
{
"DEFER", {
{"basic", "DEFER DF1 : DF1W 42 . CR ; ' DF1W IS DF1 DF1", "Should print: 42", TEST_NORMAL, 0, 1, {0}},
{"uninit", "DEFER DF2 DF2", "Should error: uninitialized deferred word", TEST_ERROR_CASE, 1, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
2, {0}
},
{
"IS", {
{"basic", "DEFER IS1 : IS1W 99 . CR ; ' IS1W IS IS1 IS1", "Should print: 99", TEST_NORMAL, 0, 1, {0}},
{"not_defer", "42 IS DUP", "Should error: DUP is not a DEFER word", TEST_ERROR_CASE, 1, 1, {0}},
{"not_found", "42 IS NOSUCH", "Should error: word not found", TEST_ERROR_CASE, 1, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
3, {0}
},
{
"DEFER@", {
{"basic", "DEFER DFA1 : DFA1W 7 . CR ; ' DFA1W IS DFA1 DEFER@ DFA1 0<> . CR", "Should print: -1", TEST_NORMAL, 0, 1, {0}},
{"not_found", "DEFER@ NOSUCH2", "Should error: word not found", TEST_ERROR_CASE, 1, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
2, {0}
},
{
"[']", {
{"compile_xt", ": BKT1 ['] DUP ; 77 BKT1 EXECUTE . . CR", "Should print: 77 77", TEST_NORMAL, 0, 1, {0}},
{"pin_like", ": BKT2 ['] DROP ; 1 2 BKT2 EXECUTE . CR", "Should print: 1", TEST_NORMAL, 0, 1, {0}},
{"not_found", ": BKT3 ['] NOSUCHWORD ;", "Should error: word not found", TEST_ERROR_CASE, 1, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
3, {0}
},
/* End marker */
{NULL, {{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}}, 0, {0}}
};
/** @brief Executes all test suites for Forth defining words
* @param vm Pointer to the Forth virtual machine instance
* @details Runs through each test suite in defining_word_suites array,
* executing individual test cases and logging results_run_01_2025_12_08
*/
void run_defining_words_tests(VM *vm) {
log_message(LOG_INFO, "Running Defining Words Tests (Module 13)...");
for (int i = 0; defining_word_suites[i].word_name != NULL; i++) {
log_message(LOG_TEST, "▶ Testing module: %s", __FILE__);
run_test_suite(vm, &defining_word_suites[i]);
}
print_module_summary("Defining Words", 0, 0, 0, 0);
}
v3/src/test_runner/modules/dictionary_manipulation_words_test.c
+194
View File
@@ -0,0 +1,194 @@
/*
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.
*/
#include "../include/test_runner.h"
#include "../include/test_common.h"
/* Dictionary Manipulation Words Test Suites - Module 14 */
static WordTestSuite dict_manip_word_suites[] = {
{
"CREATE", {
{"basic", "CREATE test1 42 , test1 @ . CR", "Should create and store", TEST_NORMAL, 0, 1, {0}},
{"empty_name", "CREATE", "Should handle empty name", TEST_ERROR_CASE, 1, 1, {0}},
{
"redefine_shadows", "CREATE T 1 , CREATE T 2 , T @ . CR", "Newest definition should win (prints 2)",
TEST_NORMAL, 0, 1, {0}
},
{"duplicate", "CREATE test2 CREATE test2", "Should allow redefinition (latest shadows)", TEST_NORMAL, 0, 1, {0}},
{"long_name", "CREATE abcdefghijklmnopqrstuvwxyz", "Should handle long name", TEST_EDGE_CASE, 1, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
4, {0}
},
{
"FORGET", {
{"basic", "CREATE temp1 FORGET temp1", "Should forget word", TEST_NORMAL, 0, 1, {0}},
{"nonexistent", "FORGET nonexistent", "Should handle missing word", TEST_ERROR_CASE, 1, 1, {0}},
{"protected", "FORGET FORGET", "Should protect system words", TEST_ERROR_CASE, 1, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
3, {0}
},
{
/* FENCE ( -- ): raises the FORGET boundary to the current dictionary
* top. Added alongside a real bug fix in FORGET itself, caught while
* building this word -- forgetting the single newest word used to
* incorrectly destroy every other word back to the fence too (a
* use-after-free in the relink logic, not just an off-by-one), a
* SIGSEGV in the worst case. "forget_latest_keeps_predecessor" below
* is exactly the regression case that fix addresses. */
"FENCE", {
{
"basic", "CREATE fnc1 FENCE CREATE fnc2 FORGET fnc2",
"Should forget a word defined after FENCE", TEST_NORMAL, 0, 1, {0}
},
{
"protects_older", "CREATE fnc3 CREATE fnc4 FENCE FORGET fnc3",
"Should refuse to forget a word defined before FENCE", TEST_ERROR_CASE, 1, 1, {0}
},
{
"forget_latest_keeps_predecessor",
"CREATE fnc5 FENCE CREATE fnc6 CREATE fnc7 FORGET fnc7 fnc6 DROP",
"Forgetting the newest word must not disturb an older one still above FENCE",
TEST_NORMAL, 0, 1, {0}
},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
3, {0}
},
{
"IMMEDIATE", {
{"basic", ": test3 42 ; IMMEDIATE test3 . CR", "Should execute immediately", TEST_NORMAL, 0, 1, {0}},
{
"already_immediate", ": test4 43 ; IMMEDIATE IMMEDIATE", "Should handle double immediate", TEST_NORMAL, 0, 1, {0}
},
/* TODO: IMMEDIATE outside definition - requires compile-state tracking in IMMEDIATE */
/* {"outside_def", "IMMEDIATE", "Should error outside definition", TEST_ERROR_CASE, 1, 1}, */
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
2, {0}
},
{
"FIND", {
{"existing", "FIND DUP . CR", "Should find system word", TEST_NORMAL, 0, 1, {0}},
{"user_word", ": test5 44 ; FIND test5 . CR", "Should find user word", TEST_NORMAL, 0, 1, {0}},
{"nonexistent", "FIND nonexistent . CR", "Should return 0", TEST_NORMAL, 0, 1, {0}},
{"empty", "FIND", "Should error (no token)", TEST_ERROR_CASE, 1, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
4, {0}
},
{
"DEFINITIONS", {
{"basic", "FORTH DEFINITIONS", "Should set current to context", TEST_NORMAL, 0, 1, {0}},
{"multiple", "FORTH DEFINITIONS DEFINITIONS", "Should be idempotent", TEST_NORMAL, 0, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
2, {0}
},
{
"SMUDGE", {
{"during_def", ": test6 SMUDGE 45 ;", "Should hide incomplete def", TEST_NORMAL, 0, 1, {0}},
{"outside_def", "SMUDGE", "Should error outside def", TEST_ERROR_CASE, 1, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
2, {0}
},
{
"LATEST", {
{"basic", "LATEST @ . CR", "Should show latest word", TEST_NORMAL, 0, 1, {0}},
{"after_def", ": test7 46 ; LATEST @ . CR", "Should update after def", TEST_NORMAL, 0, 1, {0}},
{
"after_forget", "CREATE test8 FORGET test8 LATEST @ . CR", "Should update after forget", TEST_NORMAL, 0,
1, {0}
},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
3, {0}
},
{
">BODY", {
{"basic", "CREATE test9 ' test9 >BODY . CR", "Should get param field", TEST_NORMAL, 0, 1, {0}},
{"variable", "VARIABLE var1 ' var1 >BODY . CR", "Should get var storage", TEST_NORMAL, 0, 1, {0}},
{"nonexistent", "' NONEXISTENT >BODY", "Should handle missing word", TEST_ERROR_CASE, 1, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
3, {0}
},
{
"HIDDEN", {
{"basic", ": test10 HIDDEN 47 ;", "Should hide word", TEST_NORMAL, 0, 1, {0}},
{"outside_def", "HIDDEN", "Should error outside def", TEST_ERROR_CASE, 1, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
2, {0}
},
/* End marker */
{NULL, {{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}}, 0, {0}}
};
/**
* @brief Executes all dictionary manipulation words test suites
* @param vm Pointer to the Forth virtual machine instance
* @details Runs through all test cases for CREATE, FORGET, IMMEDIATE, FIND,
* DEFINITIONS, SMUDGE, LATEST, >BODY, and HIDDEN words
*/
void run_dictionary_manipulation_words_tests(VM *vm) {
log_message(LOG_INFO, "Running Dictionary Manipulation Words Tests (Module 14)...");
for (int i = 0; dict_manip_word_suites[i].word_name != NULL; i++) {
log_message(LOG_TEST, "▶ Testing module: %s", __FILE__);
run_test_suite(vm, &dict_manip_word_suites[i]);
}
print_module_summary("Dictionary Manipulation Words", 0, 0, 0, 0);
}
v3/src/test_runner/modules/dictionary_words_test.c
+216
View File
@@ -0,0 +1,216 @@
/*
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.
*/
#include "../include/test_runner.h"
#include "../include/test_common.h"
/* Dictionary Words Test Suites - Module 4 */
static WordTestSuite dictionary_word_suites[] = {
{
"HERE", {
{"basic", "HERE HERE = . CR", "Should print: -1", TEST_NORMAL, 0, 1, {0}},
{"after_comma", "HERE 42 , HERE SWAP - 1 CELLS = 0 SWAP /", "Asserts HERE advances by exactly 1 CELLS (8 bytes on 64-bit)", TEST_NORMAL, 0, 1, {0}},
{"after_c_comma", "HERE 65 C, HERE SWAP - . CR", "Should print: 1", TEST_NORMAL, 0, 1, {0}},
{"after_allot", "HERE 10 ALLOT HERE SWAP - . CR", "Should print: 10", TEST_NORMAL, 0, 1, {0}},
{"stability", "HERE DUP HERE = . CR", "Should be stable", TEST_NORMAL, 0, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
5, {0}
},
{
"ALLOT", {
{"basic", "HERE 10 ALLOT HERE SWAP - . CR", "Should print: 10", TEST_NORMAL, 0, 1, {0}},
{"zero", "HERE 0 ALLOT HERE SWAP - . CR", "Should print: 0", TEST_NORMAL, 0, 1, {0}},
{"negative", "HERE -4 ALLOT HERE SWAP - . CR", "Should print: -4", TEST_NORMAL, 0, 1, {0}},
{"large", "HERE 100 ALLOT HERE SWAP - . CR", "Should print: 100", TEST_NORMAL, 0, 1, {0}},
{"after_use", "ALIGN HERE 10 ALLOT 42 OVER ! @ . CR", "Should store and retrieve", TEST_NORMAL, 0, 1, {0}},
{"empty_stack", "ALLOT", "Should cause stack underflow", TEST_ERROR_CASE, 1, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
6, {0}
},
{
",", {
{"basic", "42 , HERE 1 CELLS - @ . CR", "Should compile 42", TEST_NORMAL, 0, 1, {0}},
{"negative", "-999 , HERE 1 CELLS - @ . CR", "Should compile -999", TEST_NORMAL, 0, 1, {0}},
{"zero", "0 , HERE 1 CELLS - @ . CR", "Should compile 0", TEST_NORMAL, 0, 1, {0}},
{"max_int", "2147483647 , HERE 1 CELLS - @ . CR", "Should compile max int", TEST_EDGE_CASE, 0, 1, {0}},
{"min_int", "-2147483648 , HERE 1 CELLS - @ . CR", "Should compile min int", TEST_EDGE_CASE, 0, 1, {0}},
{"multiple", "10 , 20 , HERE 1 CELLS - @ . HERE 1 CELLS - @ . CR", "Should compile multiple", TEST_NORMAL, 0, 1, {0}},
{"empty_stack", ",", "Should cause stack underflow", TEST_ERROR_CASE, 1, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
7, {0}
},
{
"C,", {
{"basic", "65 C, HERE 1 - C@ . CR", "Should compile byte 65", TEST_NORMAL, 0, 1, {0}},
{"zero", "0 C, HERE 1 - C@ . CR", "Should compile byte 0", TEST_NORMAL, 0, 1, {0}},
{"high_byte", "255 C, HERE 1 - C@ . CR", "Should compile byte 255", TEST_NORMAL, 0, 1, {0}},
{"truncation", "256 C, HERE 1 - C@ . CR", "Should truncate to 0", TEST_NORMAL, 0, 1, {0}},
{"negative", "-1 C, HERE 1 - C@ . CR", "Should handle negative", TEST_NORMAL, 0, 1, {0}},
{"multiple", "65 C, 66 C, HERE 2 - C@ . HERE 1 - C@ . CR", "Should compile multiple", TEST_NORMAL, 0, 1, {0}},
{"empty_stack", "C,", "Should cause stack underflow", TEST_ERROR_CASE, 1, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
7, {0}
},
{
"2,", {
{"basic", "12345 67890 2, HERE 2 CELLS - 2@ . . CR", "Should compile double", TEST_NORMAL, 0, 1, {0}},
{"zero", "0 0 2, HERE 2 CELLS - 2@ . . CR", "Should compile zero double", TEST_NORMAL, 0, 1, {0}},
{"negative", "-1000 -2000 2, HERE 2 CELLS - 2@ . . CR", "Should compile negative double", TEST_NORMAL, 0, 1, {0}},
{"large", "2147483647 -1 2, HERE 2 CELLS - 2@ . . CR", "Should compile large double", TEST_EDGE_CASE, 0, 1, {0}},
{"one_item", "42 2,", "Should cause stack underflow", TEST_ERROR_CASE, 1, 1, {0}},
{"empty_stack", "2,", "Should cause stack underflow", TEST_ERROR_CASE, 1, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
6, {0}
},
{
"PAD", {
{"basic", "PAD PAD = . CR", "Should print: -1", TEST_NORMAL, 0, 1, {0}},
{"different_from_here", "PAD HERE = . CR", "Should print: 0", TEST_NORMAL, 0, 1, {0}},
{"stability", "PAD DUP PAD = . CR", "Should be stable", TEST_NORMAL, 0, 1, {0}},
{"usable", "PAD 42 OVER ! @ . CR", "Should be usable memory", TEST_NORMAL, 0, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
4, {0}
},
{
"SP@", {
// DISABLED: flaky on some architectures, non-deterministic
{"basic", "SP@ SP@ = . CR", "Should print: 0 (different after push)", TEST_NORMAL, 0, 0, {0}},
{"depth_effect", "42 SP@ SWAP DROP SP@ = . CR", "Should show stack effect", TEST_NORMAL, 0, 1, {0}},
{"empty_stack", "DEPTH 0= SP@ AND . CR", "Should work on empty stack", TEST_NORMAL, 0, 1, {0}},
{
"multiple_items", "1 2 3 SP@ SWAP DROP SWAP DROP SWAP DROP SP@ = . CR", "Should track changes",
TEST_NORMAL, 0, 1, {0}
},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
4, {0}
},
{
"SP!", {
{"basic_restore", "1 2 3 SP@ 4 5 6 DROP DROP DROP SP! DEPTH .", "Should restore stack", TEST_NORMAL, 0, 1, {0}},
{"invalid_addr", "0 SP!", "Should cause error", TEST_ERROR_CASE, 1, 1, {0}},
{"empty_stack", "SP!", "Should cause stack underflow", TEST_ERROR_CASE, 1, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
3, {0}
},
{
"LATEST", {
{"basic", "LATEST LATEST = . CR", "Should print: -1", TEST_NORMAL, 0, 1, {0}},
{"stability", "LATEST DUP LATEST = . CR", "Should be stable", TEST_NORMAL, 0, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
2, {0}
},
{
"COMPILATION", {
{
"here_comma_sequence", "HERE 10 , 20 , 30 , HERE SWAP - 12 = . CR", "Should advance HERE by 12",
TEST_NORMAL, 0, 1, {0}
},
{
"mixed_compilation", "HERE 42 , 65 C, 100 200 2, HERE SWAP - 13 = . CR", "Should advance correctly",
TEST_NORMAL, 0, 1, {0}
}, // MAY FAIL on non-4-byte platforms
{
"allot_comma_combo", "HERE 10 ALLOT 99 , HERE SWAP - 14 = . CR", "Should combine allot and comma",
TEST_NORMAL, 0, 1, {0}
},
{"pad_isolation", "PAD 999 OVER ! HERE 42 , PAD @ 999 = . CR", "PAD should be isolated", TEST_NORMAL, 0, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
4, {0}
},
{
"STACK_MGMT", {
{"sp_round_trip", "42 43 SP@ >R 44 45 R> SP! . . CR", "Should print: 43 42", TEST_NORMAL, 0, 1, {0}},
{
"depth_preservation", "1 2 3 DEPTH >R SP@ >R 4 5 6 R> SP! R> DEPTH = . CR", "Should preserve depth",
TEST_NORMAL, 0, 1, {0}
},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
3, {0}
},
{NULL, {{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}}, 0, {0}}
};
/**
* @brief Executes all dictionary word test suites
*
* @param vm Pointer to the FORTH virtual machine instance
*
* This function runs through all dictionary word test suites, including tests for:
* - HERE (dictionary pointer)
* - ALLOT (memory allocation)
* - Comma operations (, C, 2,)
* - PAD (scratch pad area)
* - Stack pointer operations (SP@ SP!)
* - LATEST (most recent dictionary entry)
* - Compilation sequences
* - Stack management operations
*/
void run_dictionary_words_tests(VM *vm) {
log_message(LOG_INFO, "Running Dictionary Words Tests (Module 4)...");
for (int i = 0; dictionary_word_suites[i].word_name != NULL; i++) {
run_test_suite(vm, &dictionary_word_suites[i]);
}
print_module_summary("Dictionary Words", 0, 0, 0, 0);
}
v3/src/test_runner/modules/double_words_test.c
+346
View File
@@ -0,0 +1,346 @@
/*
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.
*/
#include "../include/test_runner.h"
#include "../include/test_common.h"
/* Double Number Words Test Suites - Module 6 */
static WordTestSuite double_word_suites[] = {
{
"2DROP", {
{"basic", "1 2 3 4 2DROP . . CR", "Should print: 1 2", TEST_NORMAL, 0, 1, {0}},
{"zeros", "0 0 42 99 2DROP . . CR", "Should print: 0 0", TEST_NORMAL, 0, 1, {0}},
{"negative", "-1 -2 100 200 2DROP . . CR", "Should print: -1 -2", TEST_NORMAL, 0, 1, {0}},
{"exact_four", "10 20 30 40 2DROP DEPTH . CR", "Should print: 2", TEST_NORMAL, 0, 1, {0}},
{"empty_stack", "2DROP", "Should cause stack underflow", TEST_ERROR_CASE, 1, 1, {0}},
{"one_item", "42 2DROP", "Should cause stack underflow", TEST_ERROR_CASE, 1, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
6, {0}
},
{
"2DUP", {
{"basic", "100 200 2DUP . . . . CR", "Should print: 100 200 100 200", TEST_NORMAL, 0, 1, {0}},
{"zeros", "0 0 2DUP . . . . CR", "Should print: 0 0 0 0", TEST_NORMAL, 0, 1, {0}},
{"negative", "-100 -200 2DUP . . . . CR", "Should duplicate negatives", TEST_NORMAL, 0, 1, {0}},
{"depth_check", "10 20 2DUP DEPTH . CR", "Should print: 4", TEST_NORMAL, 0, 1, {0}},
{"empty_stack", "2DUP", "Should cause stack underflow", TEST_ERROR_CASE, 1, 1, {0}},
{"one_item", "42 2DUP", "Should cause stack underflow", TEST_ERROR_CASE, 1, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
6, {0}
},
{
"2OVER", {
{"basic", "10 20 30 40 2OVER . . . . . . CR", "Should print: 10 20 30 40 10 20", TEST_NORMAL, 0, 1, {0}},
{"zeros", "0 0 99 88 2OVER . . . . . . CR", "Should print: 0 0 99 88 0 0", TEST_NORMAL, 0, 1, {0}},
{"mixed", "-1 2 -3 4 2OVER . . . . . . CR", "Should handle mixed signs", TEST_NORMAL, 0, 1, {0}},
{"depth_check", "1 2 3 4 2OVER DEPTH . CR", "Should print: 6", TEST_NORMAL, 0, 1, {0}},
{"three_items", "1 2 3 2OVER", "Should cause stack underflow", TEST_ERROR_CASE, 1, 1, {0}},
{"empty_stack", "2OVER", "Should cause stack underflow", TEST_ERROR_CASE, 1, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
6, {0}
},
{
"2SWAP", {
{"basic", "10 20 30 40 2SWAP . . . . CR", "Should print: 30 40 10 20", TEST_NORMAL, 0, 1, {0}},
{"zeros", "0 0 99 88 2SWAP . . . . CR", "Should print: 99 88 0 0", TEST_NORMAL, 0, 1, {0}},
{"same_pairs", "42 42 42 42 2SWAP . . . . CR", "Should print: 42 42 42 42", TEST_NORMAL, 0, 1, {0}},
{"negative", "-10 -20 30 40 2SWAP . . . . CR", "Should print: 30 40 -10 -20", TEST_NORMAL, 0, 1, {0}},
{"depth_check", "1 2 3 4 2SWAP DEPTH . CR", "Should print: 4", TEST_NORMAL, 0, 1, {0}},
{"three_items", "1 2 3 2SWAP", "Should cause stack underflow", TEST_ERROR_CASE, 1, 1, {0}},
{"empty_stack", "2SWAP", "Should cause stack underflow", TEST_ERROR_CASE, 1, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
7, {0}
},
{
"2ROT", {
{"basic", "10 20 30 40 50 60 2ROT . . . . . . CR", "Should print: 30 40 50 60 10 20", TEST_NORMAL, 0, 1, {0}},
{"zeros", "0 0 1 1 2 2 2ROT . . . . . . CR", "Should rotate with zeros", TEST_NORMAL, 0, 1, {0}},
{"negative", "-1 -2 3 4 -5 -6 2ROT . . . . . . CR", "Should handle negatives", TEST_NORMAL, 0, 1, {0}},
{"depth_check", "1 2 3 4 5 6 2ROT DEPTH . CR", "Should print: 6", TEST_NORMAL, 0, 1, {0}},
{"five_items", "1 2 3 4 5 2ROT", "Should cause stack underflow", TEST_ERROR_CASE, 1, 1, {0}},
{"empty_stack", "2ROT", "Should cause stack underflow", TEST_ERROR_CASE, 1, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
6, {0}
},
{
"D+", {
{"basic", "100 200 300 400 D+ . . CR", "Should print: 400 600", TEST_NORMAL, 0, 1, {0}},
{"zero_add", "42 99 0 0 D+ . . CR", "Should print: 42 99", TEST_NORMAL, 0, 1, {0}},
{"negative", "-100 -200 50 75 D+ . . CR", "Should handle negatives", TEST_NORMAL, 0, 1, {0}},
{"carry", "2147483647 0 1 0 D+ . . CR", "Should handle carry", TEST_EDGE_CASE, 0, 1, {0}},
{"both_negative", "-100 -200 -300 -400 D+ . . CR", "Should add negatives", TEST_NORMAL, 0, 1, {0}},
{"three_items", "1 2 3 D+", "Should cause stack underflow", TEST_ERROR_CASE, 1, 1, {0}},
{"empty_stack", "D+", "Should cause stack underflow", TEST_ERROR_CASE, 1, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
7, {0}
},
{
"D-", {
{"basic", "500 600 100 200 D- . . CR", "Should print: 400 400", TEST_NORMAL, 0, 1, {0}},
{"zero_sub", "42 99 0 0 D- . . CR", "Should print: 42 99", TEST_NORMAL, 0, 1, {0}},
{"from_zero", "0 0 100 200 D- . . CR", "Should print: -100 -200", TEST_NORMAL, 0, 1, {0}},
{"negative", "100 200 -50 -75 D- . . CR", "Should handle negatives", TEST_NORMAL, 0, 1, {0}},
{"borrow", "0 0 1 0 D- . . CR", "Should handle borrow", TEST_EDGE_CASE, 0, 1, {0}},
{"same_values", "100 200 100 200 D- . . CR", "Should print: 0 0", TEST_NORMAL, 0, 1, {0}},
{"three_items", "1 2 3 D-", "Should cause stack underflow", TEST_ERROR_CASE, 1, 1, {0}},
{"empty_stack", "D-", "Should cause stack underflow", TEST_ERROR_CASE, 1, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
8, {0}
},
{
"DNEGATE", {
{"positive", "100 200 DNEGATE . . CR", "Should negate positive double", TEST_NORMAL, 0, 1, {0}},
{"negative", "-100 -200 DNEGATE . . CR", "Should negate negative double", TEST_NORMAL, 0, 1, {0}},
{"zero", "0 0 DNEGATE . . CR", "Should print: 0 0", TEST_NORMAL, 0, 1, {0}},
{"max_positive", "2147483647 0 DNEGATE . . CR", "Should negate max positive", TEST_EDGE_CASE, 0, 1, {0}},
{"one_item", "42 DNEGATE", "Should cause stack underflow", TEST_ERROR_CASE, 1, 1, {0}},
{"empty_stack", "DNEGATE", "Should cause stack underflow", TEST_ERROR_CASE, 1, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
6, {0}
},
{
"DABS", {
{"positive", "100 200 DABS . . CR", "Should print: 100 200", TEST_NORMAL, 0, 1, {0}},
{"negative", "-100 -200 DABS . . CR", "Should print: 100 200", TEST_NORMAL, 0, 1, {0}},
{"zero", "0 0 DABS . . CR", "Should print: 0 0", TEST_NORMAL, 0, 1, {0}},
{"mixed_sign", "100 -1 DABS . . CR", "Should handle mixed sign", TEST_NORMAL, 0, 1, {0}},
{"min_double", "-2147483648 -1 DABS . . CR", "Should handle min double", TEST_EDGE_CASE, 0, 1, {0}},
{"one_item", "42 DABS", "Should cause stack underflow", TEST_ERROR_CASE, 1, 1, {0}},
{"empty_stack", "DABS", "Should cause stack underflow", TEST_ERROR_CASE, 1, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
7, {0}
},
{
"DMIN", {
{"basic", "100 200 300 400 DMIN . . CR", "Should print: 100 200", TEST_NORMAL, 0, 1, {0}},
{"equal", "42 99 42 99 DMIN . . CR", "Should print: 42 99", TEST_NORMAL, 0, 1, {0}},
{"negative", "-100 -200 -50 -75 DMIN . . CR", "Should find min negative", TEST_NORMAL, 0, 1, {0}},
{"mixed", "-100 -1 100 0 DMIN . . CR", "Should handle mixed signs", TEST_NORMAL, 0, 1, {0}},
{"three_items", "1 2 3 DMIN", "Should cause stack underflow", TEST_ERROR_CASE, 1, 1, {0}},
{"empty_stack", "DMIN", "Should cause stack underflow", TEST_ERROR_CASE, 1, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
6, {0}
},
{
"DMAX", {
{"basic", "100 200 300 400 DMAX . . CR", "Should print: 300 400", TEST_NORMAL, 0, 1, {0}},
{"equal", "42 99 42 99 DMAX . . CR", "Should print: 42 99", TEST_NORMAL, 0, 1, {0}},
{"negative", "-300 -400 -100 -200 DMAX . . CR", "Should find max negative", TEST_NORMAL, 0, 1, {0}},
{"mixed", "-100 -1 100 0 DMAX . . CR", "Should handle mixed signs", TEST_NORMAL, 0, 1, {0}},
{"three_items", "1 2 3 DMAX", "Should cause stack underflow", TEST_ERROR_CASE, 1, 1, {0}},
{"empty_stack", "DMAX", "Should cause stack underflow", TEST_ERROR_CASE, 1, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
6, {0}
},
{
"D=", {
{"equal", "100 200 100 200 D= . CR", "Should print: -1", TEST_NORMAL, 0, 1, {0}},
{"not_equal_low", "100 200 101 200 D= . CR", "Should print: 0", TEST_NORMAL, 0, 1, {0}},
{"not_equal_high", "100 200 100 201 D= . CR", "Should print: 0", TEST_NORMAL, 0, 1, {0}},
{"zero_equal", "0 0 0 0 D= . CR", "Should print: -1", TEST_NORMAL, 0, 1, {0}},
{"negative_equal", "-100 -200 -100 -200 D= . CR", "Should print: -1", TEST_NORMAL, 0, 1, {0}},
{"three_items", "1 2 3 D=", "Should cause stack underflow", TEST_ERROR_CASE, 1, 1, {0}},
{"empty_stack", "D=", "Should cause stack underflow", TEST_ERROR_CASE, 1, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
7, {0}
},
{
"D<", {
{"less_than", "100 200 300 400 D< . CR", "Should print: -1", TEST_NORMAL, 0, 1, {0}},
{"greater_than", "300 400 100 200 D< . CR", "Should print: 0", TEST_NORMAL, 0, 1, {0}},
{"equal", "100 200 100 200 D< . CR", "Should print: 0", TEST_NORMAL, 0, 1, {0}},
{"negative_positive", "-100 -1 100 0 D< . CR", "Should print: -1", TEST_NORMAL, 0, 1, {0}},
{"negative_negative", "-300 -1 -100 -1 D< . CR", "Should compare negatives", TEST_NORMAL, 0, 1, {0}},
{"high_word_diff", "100 200 100 300 D< . CR", "Should print: -1", TEST_NORMAL, 0, 1, {0}},
{"three_items", "1 2 3 D<", "Should cause stack underflow", TEST_ERROR_CASE, 1, 1, {0}},
{"empty_stack", "D<", "Should cause stack underflow", TEST_ERROR_CASE, 1, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
8, {0}
},
{
"D0=", {
{"zero", "0 0 D0= . CR", "Should print: -1", TEST_NORMAL, 0, 1, {0}},
{"positive", "100 200 D0= . CR", "Should print: 0", TEST_NORMAL, 0, 1, {0}},
{"negative", "-100 -200 D0= . CR", "Should print: 0", TEST_NORMAL, 0, 1, {0}},
{"zero_high", "0 100 D0= . CR", "Should print: 0", TEST_NORMAL, 0, 1, {0}},
{"zero_low", "100 0 D0= . CR", "Should print: 0", TEST_NORMAL, 0, 1, {0}},
{"one_item", "42 D0=", "Should cause stack underflow", TEST_ERROR_CASE, 1, 1, {0}},
{"empty_stack", "D0=", "Should cause stack underflow", TEST_ERROR_CASE, 1, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
7, {0}
},
{
"D0<", {
{"negative", "-100 -1 D0< . CR", "Should print: -1", TEST_NORMAL, 0, 1, {0}},
{"zero", "0 0 D0< . CR", "Should print: 0", TEST_NORMAL, 0, 1, {0}},
{"positive", "100 0 D0< . CR", "Should print: 0", TEST_NORMAL, 0, 1, {0}},
{"negative_high_only", "100 -1 D0< . CR", "Should print: -1", TEST_NORMAL, 0, 1, {0}},
{"large_negative", "-1 -1 D0< . CR", "Should print: -1", TEST_NORMAL, 0, 1, {0}},
{"one_item", "42 D0<", "Should cause stack underflow", TEST_ERROR_CASE, 1, 1, {0}},
{"empty_stack", "D0<", "Should cause stack underflow", TEST_ERROR_CASE, 1, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
7, {0}
},
{
"S>D", {
{"positive", "5 S>D . . CR", "Should sign-extend positive: 0 5", TEST_NORMAL, 0, 1, {0}},
{"negative", "-5 S>D . . CR", "Should sign-extend negative: -1 -5", TEST_NORMAL, 0, 1, {0}},
{"zero", "0 S>D . . CR", "Should sign-extend zero: 0 0", TEST_NORMAL, 0, 1, {0}},
{"max_int", "2147483647 S>D . . CR", "Should extend max int: 0 2147483647", TEST_EDGE_CASE, 0, 1, {0}},
{"min_int", "-2147483648 S>D . . CR","Should extend min int: -1 -2147483648", TEST_EDGE_CASE, 0, 1, {0}},
{"empty_stack", "S>D", "Should cause stack underflow", TEST_ERROR_CASE, 1, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
6, {0}
},
{
"D2*", {
{"basic", "5 0 D2* . . CR", "Should double 5: 0 10", TEST_NORMAL, 0, 1, {0}},
{"zero", "0 0 D2* . . CR", "Should double zero: 0 0", TEST_NORMAL, 0, 1, {0}},
{"negative", "-1 -1 D2* . . CR", "Should double -1: -1 -2", TEST_NORMAL, 0, 1, {0}},
{"carry", "0 1 D2* . . CR", "Should shift high cell: 0 2", TEST_EDGE_CASE, 0, 1, {0}},
{"empty_stack", "D2*", "Should cause stack underflow", TEST_ERROR_CASE, 1, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
5, {0}
},
{
"D2/", {
{"basic", "10 0 D2/ . . CR", "Should halve 10: 0 5", TEST_NORMAL, 0, 1, {0}},
{"negative", "-2 -1 D2/ . . CR", "Should halve -2: -1 -1", TEST_NORMAL, 0, 1, {0}},
{"zero", "0 0 D2/ . . CR", "Should halve zero: 0 0", TEST_NORMAL, 0, 1, {0}},
{"odd", "3 0 D2/ . . CR", "Should truncate toward zero: 0 1", TEST_EDGE_CASE, 0, 1, {0}},
{"empty_stack", "D2/", "Should cause stack underflow", TEST_ERROR_CASE, 1, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
5, {0}
},
{
/* NOTE: 2>R/2R>/2R@ are tested at REPL level (not inside compiled words).
* The execution loop stores the IP in return_stack[rsp]; if 2>R were called
* inside a colon definition, it would increment rsp and the loop would
* dereference the pushed data value as a pointer — same model as >R tests. */
"2>R", {
{"roundtrip", "10 20 2>R 2R> . . CR", "Should store and retrieve: 20 10", TEST_NORMAL, 0, 1, {0}},
{"depth_after", "1 2 2>R DEPTH . 2R> DROP DROP CR", "Should empty data stack: 0", TEST_NORMAL, 0, 1, {0}},
{"empty_stack", "2>R", "Should cause stack underflow", TEST_ERROR_CASE, 1, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
3, {0}
},
{
"2R>", {
{"roundtrip", "5 6 2>R 2R> . . CR", "Should retrieve double: 6 5", TEST_NORMAL, 0, 1, {0}},
{"depth", "9 8 2>R 2R> DEPTH . CR", "Should push 2 items to data stack: 2", TEST_NORMAL, 0, 1, {0}},
{"empty_rstack","2R>", "Should cause return stack underflow", TEST_ERROR_CASE, 1, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
3, {0}
},
{
"2R@", {
{"peek", "3 4 2>R 2R@ . . 2R> DROP DROP CR", "Should peek: 4 3", TEST_NORMAL, 0, 1, {0}},
{"non_destructive", "7 8 2>R 2R@ DROP DROP 2R> . . CR", "Should leave rstack intact", TEST_NORMAL, 0, 1, {0}},
{"empty_rstack", "2R@", "Should cause return stack underflow", TEST_ERROR_CASE, 1, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
3, {0}
},
/* End marker */
{NULL, {{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}}, 0, {0}}
};
/**
* @brief Executes all test suites for double number words
*
* This function runs comprehensive tests for all double number word operations,
* including stack manipulation (2DROP, 2DUP, etc.), arithmetic operations (D+, D-, etc.),
* and comparison operations (D=, D<, etc.).
*
* @param vm Pointer to the virtual machine instance where tests will be executed
*/
void run_double_words_tests(VM *vm) {
log_message(LOG_INFO, "Running Double Number Words Tests (Module 6)...");
for (int i = 0; double_word_suites[i].word_name != NULL; i++) {
log_message(LOG_TEST, "▶ Testing module: %s", __FILE__);
run_test_suite(vm, &double_word_suites[i]);
}
print_module_summary("Double Number Words", 0, 0, 0, 0);
}
v3/src/test_runner/modules/format_words_test.c
+170
View File
@@ -0,0 +1,170 @@
/*
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.
*/
#include "../include/test_runner.h"
#include "../include/test_common.h"
/**
* @brief Test suites for format words (Module 10)
* Contains test cases for number base conversion and formatting operations
*/
static WordTestSuite format_word_suites[] = {
{
"BASE", {
{"decimal", "DECIMAL 42 . CR", "Should print: 42", TEST_NORMAL, 0, 1, {0}},
{"hex", "HEX FF . CR", "Should print: FF", TEST_NORMAL, 0, 1, {0}},
{"octal", "OCTAL 52 . CR", "Should print: 52", TEST_NORMAL, 0, 1, {0}},
{"base_store", "16 BASE ! 255 . CR", "Should print: FF", TEST_NORMAL, 0, 1, {0}},
{"base_fetch", "BASE @ . CR", "Should print current base", TEST_NORMAL, 0, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
5, {0}
},
{
"DECIMAL", {
{"from_hex", "HEX FF DECIMAL . CR", "Should print: 255", TEST_NORMAL, 0, 1, {0}},
{"from_octal", "OCTAL 52 DECIMAL . CR", "Should print: 42", TEST_NORMAL, 0, 1, {0}},
{"state_persist", "DECIMAL 42 . CR 42 . CR HEX 42 . CR", "Should maintain base", TEST_NORMAL, 0, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
3, {0}
},
{
"HEX", {
{"from_decimal", "DECIMAL 255 HEX . CR", "Should print: FF", TEST_NORMAL, 0, 1, {0}},
{"from_octal", "OCTAL 52 HEX . CR", "Should print: 2A", TEST_NORMAL, 0, 1, {0}},
{"state_persist", "HEX FF . CR DECIMAL 255 . CR", "Should maintain base", TEST_NORMAL, 0, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
3, {0}
},
{
"OCTAL", {
{"from_decimal", "DECIMAL 42 OCTAL . CR", "Should print: 52", TEST_NORMAL, 0, 1, {0}},
{"from_hex", "HEX 2A OCTAL . CR", "Should print: 52", TEST_NORMAL, 0, 1, {0}},
{"state_persist", "DECIMAL 42 . CR OCTAL 52 . CR", "Should maintain base", TEST_NORMAL, 0, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
3, {0}
},
{
"<#", {
{"basic", "DECIMAL 42 S>D <# #S #> TYPE CR", "Should format number", TEST_NORMAL, 0, 1, {0}},
{"empty", "0 <# #> TYPE CR", "Should handle zero", TEST_NORMAL, 0, 1, {0}},
{"negative", "-42 <# #S #> TYPE CR", "Should handle negative", TEST_NORMAL, 0, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
3, {0}
},
{
"#", {
{"single_digit", "15 <# # #> TYPE CR", "Should print rightmost digit", TEST_NORMAL, 0, 1, {0}},
{"multiple", "15 <# # # #> TYPE CR", "Should print digits right to left", TEST_NORMAL, 0, 1, {0}},
{"zero_pad", "5 <# # 0 # #> TYPE CR", "Should handle zero padding", TEST_NORMAL, 0, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
3, {0}
},
{
"#S", {
{"basic", "42 <# #S #> TYPE CR", "Should convert all digits", TEST_NORMAL, 0, 1, {0}},
{"zero", "0 <# #S #> TYPE CR", "Should handle zero", TEST_NORMAL, 0, 1, {0}},
{"large", "1234567890 <# #S #> TYPE CR", "Should handle large numbers", TEST_NORMAL, 0, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
3, {0}
},
{
"SIGN", {
{"negative", "-42 ABS <# #S SIGN #> TYPE CR", "Should add minus", TEST_NORMAL, 0, 1, {0}},
{"positive", "42 <# #S SIGN #> TYPE CR", "Should not add sign", TEST_NORMAL, 0, 1, {0}},
{"zero", "0 <# #S SIGN #> TYPE CR", "Should handle zero", TEST_NORMAL, 0, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
3, {0}
},
{
"#>", {
{"normal", "42 <# #S #> TYPE CR", "Should terminate formatting", TEST_NORMAL, 0, 1, {0}},
{"empty", "0 <# #> TYPE CR", "Should handle empty format", TEST_NORMAL, 0, 1, {0}},
{"stack_effect", "42 <# #S #> SWAP . . CR", "Should leave addr u", TEST_NORMAL, 0, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
3, {0}
},
{
"HOLD", {
{"basic", "42 <# 46 HOLD #S #> TYPE CR", "Should insert dot", TEST_NORMAL, 0, 1, {0}},
{"overflow", "<# 257 HOLD #>", "Should handle overflow", TEST_ERROR_CASE, 1, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
2, {0}
},
/* End marker */
{NULL, {{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}}, 0, {0}}
};
/**
* @brief Executes all format words test suites
* @param vm Pointer to the Forth virtual machine instance
* @details Runs through all test cases for number base manipulation and formatting words
*/
void run_format_words_tests(VM *vm) {
log_message(LOG_INFO, "Running Format Words Tests (Module 10)...");
for (int i = 0; format_word_suites[i].word_name != NULL; i++) {
log_message(LOG_TEST, "▶ Testing module: %s", __FILE__);
run_test_suite(vm, &format_word_suites[i]);
}
print_module_summary("Format Words", 0, 0, 0, 0);
}
v3/src/test_runner/modules/inference_words_test.c
+139
View File
@@ -0,0 +1,139 @@
/*
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.
*/
/*
* inference_words_test.c — POST tests for the SSM inference engine's
* proof-covered accessor/primitive words (Module 26)
*
* inference_words.c registers 20 words; only 8 are proof-covered per
* proof/COVERAGE.md ("5 accessors full; rest guard/shape") — this file
* covers exactly those 8, not the L8 Jacquard / Bayesian-posterior words,
* which COVERAGE.md does not claim coverage for. No test file existed for
* any word in this module before.
*
* The three array-based primitives (Q.VARIANCE/INFER-DECAY-SLOPE/
* INFER-WINDOW-WIDTH) need real data in VM memory — HERE is used as
* scratch, matching the idiom memory_words_test.c already uses. The four
* *-@ accessors and INFER-RUN are exercised in one suite (INFER-WINDOW@)
* that runs INFER-RUN first, since the accessors just read
* vm->last_inference_outputs and INFER-RUN is what populates it.
*/
#include "../include/test_runner.h"
#include "../include/test_common.h"
/* Inference Engine Words Test Suites - Module 26 */
static WordTestSuite inference_word_suites[] = {
{
"Q.VARIANCE", {
{"three_cells", "100 HERE ! 200 HERE 8 + ! 300 HERE 16 + ! HERE 3 Q.VARIANCE Q.TO-INT . CR",
"Should print population variance of {100,200,300} (no error)", TEST_NORMAL, 0, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
1, {0}
},
{
"INFER-DECAY-SLOPE", {
{"three_cells", "300 HERE ! 200 HERE 8 + ! 100 HERE 16 + ! HERE 3 INFER-DECAY-SLOPE Q.TO-INT . CR",
"Should print decay slope for a decreasing trajectory (no error)", TEST_NORMAL, 0, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
1, {0}
},
{
"INFER-WINDOW-WIDTH", {
{"three_cells", "100 HERE ! 200 HERE 8 + ! 300 HERE 16 + ! HERE 3 INFER-WINDOW-WIDTH . CR",
"Should print an inferred window width (no error)", TEST_NORMAL, 0, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
1, {0}
},
{
"INFER-RUN", {
{"basic", "INFER-RUN", "Should run without error", TEST_NORMAL, 0, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
1, {0}
},
{
"INFER-WINDOW@", {
{"after_run", "INFER-RUN INFER-WINDOW@ . CR", "Should print last adaptive_window_width (no error)", TEST_NORMAL, 0, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
1, {0}
},
{
"INFER-DECAY@", {
{"after_run", "INFER-RUN INFER-DECAY@ Q.TO-INT . CR", "Should print last adaptive_decay_slope (no error)", TEST_NORMAL, 0, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
1, {0}
},
{
"INFER-VARIANCE@", {
{"after_run", "INFER-RUN INFER-VARIANCE@ Q.TO-INT . CR", "Should print last window_variance_q48 (no error)", TEST_NORMAL, 0, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
1, {0}
},
{
"INFER-FIT@", {
{"after_run", "INFER-RUN INFER-FIT@ Q.TO-INT . CR", "Should print last slope_fit_quality_q48 (no error)", TEST_NORMAL, 0, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
1, {0}
},
{
"INFER-EARLY-EXIT@", {
{"after_run", "INFER-RUN INFER-EARLY-EXIT@ . CR", "Should print 0 or 1 (no error)", TEST_NORMAL, 0, 1, {0}},
{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}
},
1, {0}
},
{NULL, {{NULL, NULL, NULL, TEST_NORMAL, 0, 0, {0}}}, 0, {0}}
};
/**
* @brief Executes the proof-covered subset of inference-engine word test suites
* @param vm Pointer to the Forth virtual machine instance
* @details Covers the 8 words proof/COVERAGE.md marks as proof-covered in
* inference_words.c: the three array-based primitives (Q.VARIANCE,
* INFER-DECAY-SLOPE, INFER-WINDOW-WIDTH), INFER-RUN, and the four
* *-@ output accessors (INFER-WINDOW@/DECAY@/VARIANCE@/FIT@) plus
* INFER-EARLY-EXIT@. Does not cover the L8 Jacquard or Bayesian
* posterior words in the same file — not claimed as proof-covered.
*/
void run_inference_words_tests(VM *vm) {
log_message(LOG_INFO, "Running Inference Engine Words Tests (Module 26)...");
/* CONTRACT_NONE, not CONTRACT_PHYSICS_TRANSPARENT: these words read
* physics state (rolling window, dictionary heat) by design -- A4'
* transparency is a property they deliberately do not have. */
WordContract mod = {CONTRACT_NONE, 0};
for (int i = 0; inference_word_suites[i].word_name != NULL; i++) {
log_message(LOG_TEST, "▶ Testing module: %s", __FILE__);
run_test_suite_m(vm, &inference_word_suites[i], mod);
}
print_module_summary("Inference Engine Words", 0, 0, 0, 0);
}

Some files were not shown because too many files have changed in this diff Show More