Reorganize source tree: kernel/, v3/, v4/ split and board infrastructure
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
@@ -0,0 +1,880 @@
|
||||
/*
|
||||
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/starforth_words.h"
|
||||
#include "include/vocabulary_words.h"
|
||||
#include "../../include/word_registry.h"
|
||||
#include "../../include/log.h"
|
||||
#include "../../include/vm.h"
|
||||
#ifdef __STARKERNEL__
|
||||
#include "starkernel/vm/arena.h"
|
||||
#endif
|
||||
#include "include/vocabulary_words.h"
|
||||
#include "../../include/version.h"
|
||||
#include "../../include/physics_metadata.h"
|
||||
#include "../../include/platform_time.h"
|
||||
#include "../../include/profiler.h"
|
||||
#include "../../include/block_subsystem.h"
|
||||
#include <string.h>
|
||||
#include <stdio.h>
|
||||
#include <stdlib.h>
|
||||
#include <errno.h>
|
||||
|
||||
#ifdef __STARKERNEL__
|
||||
#define STARFORTH_CHECK_ARENA(tag) sk_vm_arena_assert_guards(tag)
|
||||
#else
|
||||
#define STARFORTH_CHECK_ARENA(tag) ((void)0)
|
||||
#endif
|
||||
|
||||
/* ============================================================================
|
||||
* PRNG State - Linear Congruential Generator (Numerical Recipes constants)
|
||||
* ============================================================================ */
|
||||
static uint64_t g_prng_state = 1;
|
||||
|
||||
/*
|
||||
* @brief Get execution heat count for word at dictionary address
|
||||
*
|
||||
* Stack effect: ( addr -- n )
|
||||
* Returns the execution frequency (execution_heat counter) for a word.
|
||||
* Note: Exposed as ENTROPY@ for FORTH compatibility, but measures execution heat.
|
||||
* @param vm Pointer to the VM instance
|
||||
*/
|
||||
void starforth_word_execution_heat_fetch(VM* vm)
|
||||
{
|
||||
if (vm->dsp < 0)
|
||||
{
|
||||
vm->error = 1;
|
||||
log_message(LOG_ERROR, "ENTROPY@: data stack underflow");
|
||||
return;
|
||||
}
|
||||
|
||||
cell_t addr = vm_pop(vm);
|
||||
DictEntry* entry = (DictEntry*)(uintptr_t)addr;
|
||||
|
||||
if (!entry)
|
||||
{
|
||||
vm->error = 1;
|
||||
log_message(LOG_ERROR, "ENTROPY@: null dictionary entry");
|
||||
return;
|
||||
}
|
||||
|
||||
/* Guardrail: Validate the pointer is actually a DictEntry */
|
||||
if (!vm_dict_entry_ok(vm, entry))
|
||||
{
|
||||
vm->error = 1;
|
||||
log_message(LOG_ERROR, "ENTROPY@: invalid dictionary entry address %p (not in dictionary)", (void*)entry);
|
||||
return;
|
||||
}
|
||||
|
||||
vm_push(vm, entry->execution_heat);
|
||||
log_message(LOG_DEBUG, "ENTROPY@: word execution heat = %ld", (long)entry->execution_heat);
|
||||
}
|
||||
|
||||
/**
|
||||
* @brief Set execution heat count for word at dictionary address
|
||||
*
|
||||
* Stack effect: ( n addr -- )
|
||||
* Note: Exposed as ENTROPY! for FORTH compatibility, but sets execution heat.
|
||||
* @param vm Pointer to the VM instance
|
||||
*/
|
||||
void starforth_word_execution_heat_store(VM* vm)
|
||||
{
|
||||
if (vm->dsp < 1)
|
||||
{
|
||||
vm->error = 1;
|
||||
log_message(LOG_ERROR, "ENTROPY!: data stack underflow");
|
||||
return;
|
||||
}
|
||||
|
||||
cell_t addr = vm_pop(vm);
|
||||
cell_t value = vm_pop(vm);
|
||||
DictEntry* entry = (DictEntry*)(uintptr_t)addr;
|
||||
|
||||
if (!entry)
|
||||
{
|
||||
vm->error = 1;
|
||||
log_message(LOG_ERROR, "ENTROPY!: null dictionary entry");
|
||||
return;
|
||||
}
|
||||
|
||||
/* Guardrail: Validate the pointer is actually a DictEntry */
|
||||
if (!vm_dict_entry_ok(vm, entry))
|
||||
{
|
||||
vm->error = 1;
|
||||
log_message(LOG_ERROR, "ENTROPY!: invalid dictionary entry address %p (not in dictionary)", (void*)entry);
|
||||
return;
|
||||
}
|
||||
|
||||
entry->execution_heat = value;
|
||||
log_message(LOG_DEBUG, "ENTROPY!: set word execution heat to %ld", (long)value);
|
||||
}
|
||||
|
||||
/**
|
||||
* @brief Display execution heat statistics for all words in dictionary
|
||||
*
|
||||
* Stack effect: ( -- )
|
||||
* Shows execution frequency (execution_heat) for each word.
|
||||
* @param vm Pointer to the VM instance
|
||||
*/
|
||||
void starforth_word_word_execution_heat(VM* vm)
|
||||
{
|
||||
printf("Word Usage Statistics (Execution Heat Counts):\n");
|
||||
printf("=============================================\n");
|
||||
|
||||
cell_t total_heat = 0;
|
||||
int word_count = 0;
|
||||
|
||||
for (DictEntry* entry = vm->latest; entry; entry = entry->link)
|
||||
{
|
||||
if (entry->execution_heat > 0)
|
||||
{
|
||||
printf("%.*s: %ld\n", (int)entry->name_len, entry->name, (long)entry->execution_heat);
|
||||
total_heat += entry->execution_heat;
|
||||
}
|
||||
word_count++;
|
||||
}
|
||||
|
||||
printf("-------------------------------------\n");
|
||||
printf("Total executions: %ld\n", (long)total_heat);
|
||||
printf("Total words: %d\n", word_count);
|
||||
if (total_heat > 0)
|
||||
{
|
||||
printf("Average executions per word: %ld\n", (long)(total_heat / word_count));
|
||||
}
|
||||
}
|
||||
|
||||
/**
|
||||
* @brief Reset all execution heat counters to zero
|
||||
*
|
||||
* Stack effect: ( -- )
|
||||
* @param vm Pointer to the VM instance
|
||||
*/
|
||||
void starforth_word_reset_execution_heat(VM* vm)
|
||||
{
|
||||
for (DictEntry* entry = vm->latest; entry; entry = entry->link)
|
||||
{
|
||||
if (entry->execution_heat > 0)
|
||||
{
|
||||
entry->execution_heat = 0;
|
||||
entry->physics.temperature_q8 = 0;
|
||||
entry->physics.avg_latency_ns = 0;
|
||||
entry->physics.last_active_ns = 0;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
/**
|
||||
* @brief Display the N most frequently used words
|
||||
*
|
||||
* Stack effect: ( n -- )
|
||||
* @param vm Pointer to the VM instance
|
||||
*/
|
||||
void starforth_word_top_words(VM* vm)
|
||||
{
|
||||
if (vm->dsp < 0)
|
||||
{
|
||||
vm->error = 1;
|
||||
log_message(LOG_ERROR, "TOP-WORDS: data stack underflow");
|
||||
return;
|
||||
}
|
||||
|
||||
cell_t n = vm_pop(vm);
|
||||
if (n <= 0)
|
||||
{
|
||||
printf("TOP-WORDS: invalid count %ld\n", (long)n);
|
||||
return;
|
||||
}
|
||||
|
||||
/* Simple implementation: just show words with execution_heat > 0, sorted by execution_heat */
|
||||
printf("Top %ld most frequently used words:\n", (long)n);
|
||||
printf("==================================\n");
|
||||
|
||||
/* Collect all words with execution_heat > 0 (static: avoids large kernel stack frame) */
|
||||
static DictEntry* words_with_heat[1000];
|
||||
int word_count = 0;
|
||||
|
||||
for (DictEntry* entry = vm->latest; entry && word_count < 1000; entry = entry->link)
|
||||
{
|
||||
if (entry->execution_heat > 0)
|
||||
{
|
||||
words_with_heat[word_count++] = entry;
|
||||
}
|
||||
}
|
||||
|
||||
/* Simple bubble sort by execution_heat (descending) */
|
||||
for (int i = 0; i < word_count - 1; i++)
|
||||
{
|
||||
for (int j = 0; j < word_count - i - 1; j++)
|
||||
{
|
||||
if (words_with_heat[j]->execution_heat < words_with_heat[j + 1]->execution_heat)
|
||||
{
|
||||
DictEntry* temp = words_with_heat[j];
|
||||
words_with_heat[j] = words_with_heat[j + 1];
|
||||
words_with_heat[j + 1] = temp;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
/* Display top N */
|
||||
int display_count = (word_count < n) ? word_count : (int)n;
|
||||
for (int i = 0; i < display_count; i++)
|
||||
{
|
||||
DictEntry* entry = words_with_heat[i];
|
||||
printf("%d. %.*s: %ld\n", i + 1, (int)entry->name_len, entry->name, (long)entry->execution_heat);
|
||||
}
|
||||
}
|
||||
|
||||
/**
|
||||
* @brief Shebang-style comment word for init.4th metadata
|
||||
*
|
||||
* Starts with "(- " and consumes input until closing ")"
|
||||
* Used for marking blocks that should be extracted to init.4th
|
||||
* Stack effect: ( -- )
|
||||
* @param vm Pointer to the VM instance
|
||||
*/
|
||||
void starforth_word_paren_dash(VM* vm)
|
||||
{
|
||||
/* Consume input until we find closing ")" */
|
||||
int depth = 1;
|
||||
|
||||
while (vm->input_pos < vm->input_length && depth > 0)
|
||||
{
|
||||
char c = vm->input_buffer[vm->input_pos++];
|
||||
if (c == '(')
|
||||
{
|
||||
depth++;
|
||||
}
|
||||
else if (c == ')')
|
||||
{
|
||||
depth--;
|
||||
}
|
||||
}
|
||||
|
||||
if (depth > 0)
|
||||
{
|
||||
log_message(LOG_WARN, "(- comment not terminated");
|
||||
}
|
||||
|
||||
/* This is a comment - no stack effect, just consume input */
|
||||
log_message(LOG_DEBUG, "(- comment parsed (init.4th metadata marker)");
|
||||
}
|
||||
|
||||
/**
|
||||
* @brief Initialize system from init.4th configuration file
|
||||
*
|
||||
* Reads ./capsules/core/init.4th, parses Block headers,
|
||||
* copies blocks sequentially starting at block 1, then executes them.
|
||||
* Stack effect: ( -- )
|
||||
* @param vm Pointer to the VM instance
|
||||
*/
|
||||
void starforth_word_init(VM* vm)
|
||||
{
|
||||
log_message(LOG_INFO, "INIT: Starting system initialization from init.4th");
|
||||
|
||||
/* Read init.4th file */
|
||||
char* file_content = NULL;
|
||||
size_t file_size = 0;
|
||||
|
||||
/* HISTORICAL: an L4RE_TARGET branch here read init.4th from ROMFS
|
||||
* (never implemented -- it just logged an error and halted). L4Re
|
||||
* support has been removed as an active target.
|
||||
* #ifdef L4RE_TARGET
|
||||
* log_message(LOG_ERROR, "INIT: L4Re ROMFS not yet implemented");
|
||||
* vm->error = 1;
|
||||
* vm->halted = 1;
|
||||
* return;
|
||||
* #else
|
||||
*/
|
||||
/* Linux/POSIX: read from filesystem */
|
||||
const char* init_path = "./capsules/core/init.4th";
|
||||
FILE* fp = fopen(init_path, "r");
|
||||
if (!fp)
|
||||
{
|
||||
if (errno == ENOENT)
|
||||
{
|
||||
log_message(LOG_INFO, "INIT: %s not found — skipping", init_path);
|
||||
return;
|
||||
}
|
||||
log_message(LOG_ERROR, "INIT: Failed to open %s: %s", init_path, strerror(errno));
|
||||
vm->error = 1;
|
||||
vm->halted = 1;
|
||||
return;
|
||||
}
|
||||
|
||||
/* Get file size */
|
||||
fseek(fp, 0, SEEK_END);
|
||||
file_size = (size_t)ftell(fp);
|
||||
fseek(fp, 0, SEEK_SET);
|
||||
|
||||
/* Allocate buffer */
|
||||
file_content = (char*)malloc(file_size + 1);
|
||||
if (!file_content)
|
||||
{
|
||||
log_message(LOG_ERROR, "INIT: Failed to allocate memory for init.4th (%zu bytes)", file_size);
|
||||
fclose(fp);
|
||||
vm->error = 1;
|
||||
vm->halted = 1;
|
||||
return;
|
||||
}
|
||||
|
||||
/* Read entire file */
|
||||
size_t bytes_read = fread(file_content, 1, file_size, fp);
|
||||
fclose(fp);
|
||||
|
||||
if (bytes_read != file_size)
|
||||
{
|
||||
log_message(LOG_ERROR, "INIT: Failed to read init.4th (expected %zu, got %zu bytes)", file_size, bytes_read);
|
||||
free(file_content);
|
||||
vm->error = 1;
|
||||
vm->halted = 1;
|
||||
return;
|
||||
}
|
||||
file_content[file_size] = '\0';
|
||||
log_message(LOG_DEBUG, "INIT: Read %zu bytes from %s", file_size, init_path);
|
||||
/* #endif -- matches the commented-out #ifdef L4RE_TARGET above */
|
||||
|
||||
/* First pass: build mapping of original block numbers to sequential numbers */
|
||||
typedef struct
|
||||
{
|
||||
int original;
|
||||
int sequential;
|
||||
} BlockMapping;
|
||||
|
||||
BlockMapping block_map[256]; /* Support up to 256 init blocks */
|
||||
int block_count = 0;
|
||||
|
||||
char* scan_start = file_content;
|
||||
for (size_t i = 0; i <= file_size; i++)
|
||||
{
|
||||
char c = (i < file_size) ? file_content[i] : '\n';
|
||||
|
||||
if (c == '\n' || i == file_size)
|
||||
{
|
||||
size_t line_len = (size_t)(&file_content[i] - scan_start);
|
||||
|
||||
/* Check if this line starts with "Block " */
|
||||
if (line_len >= 6 && strncmp(scan_start, "Block ", 6) == 0)
|
||||
{
|
||||
/* Parse the block number */
|
||||
int orig_block_num = 0;
|
||||
if (sscanf(scan_start + 6, "%d", &orig_block_num) == 1)
|
||||
{
|
||||
if (block_count < 256)
|
||||
{
|
||||
block_map[block_count].original = orig_block_num;
|
||||
block_map[block_count].sequential = block_count + 1;
|
||||
log_message(LOG_DEBUG, "INIT: Block mapping: %d -> %d",
|
||||
orig_block_num, block_count + 1);
|
||||
block_count++;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
scan_start = &file_content[i + 1];
|
||||
}
|
||||
}
|
||||
|
||||
/* Second pass: copy blocks with LOAD reference rewriting */
|
||||
int current_dest_block = 1;
|
||||
char* line_start = file_content;
|
||||
char* block_content_start = NULL;
|
||||
int in_block = 0;
|
||||
|
||||
for (size_t i = 0; i <= file_size; i++)
|
||||
{
|
||||
char c = (i < file_size) ? file_content[i] : '\n';
|
||||
|
||||
/* End of line or end of file */
|
||||
if (c == '\n' || i == file_size)
|
||||
{
|
||||
size_t line_len = (size_t)(&file_content[i] - line_start);
|
||||
|
||||
/* Check if this line starts with "Block " */
|
||||
if (line_len >= 6 && strncmp(line_start, "Block ", 6) == 0)
|
||||
{
|
||||
/* If we were already in a block, write the previous block */
|
||||
if (in_block && block_content_start)
|
||||
{
|
||||
size_t block_len = (size_t)(line_start - block_content_start);
|
||||
|
||||
/* Get buffer for destination block */
|
||||
uint8_t* buf = blk_get_buffer((uint32_t)current_dest_block, 1);
|
||||
if (!buf)
|
||||
{
|
||||
log_message(LOG_ERROR, "INIT: Failed to get buffer for block %d", current_dest_block);
|
||||
free(file_content);
|
||||
vm->error = 1;
|
||||
vm->halted = 1;
|
||||
return;
|
||||
}
|
||||
|
||||
/* Clear block and copy with LOAD rewriting */
|
||||
memset(buf, 0, 1024);
|
||||
size_t copy_len = (block_len > 1024) ? 1024 : block_len;
|
||||
|
||||
/* Simple approach: scan and replace "NNNN LOAD" patterns */
|
||||
size_t src = 0, dst = 0;
|
||||
while (src < copy_len && dst < 1024)
|
||||
{
|
||||
/* Check for digit start */
|
||||
if (block_content_start[src] >= '0' && block_content_start[src] <= '9')
|
||||
{
|
||||
/* Parse number */
|
||||
int num = 0;
|
||||
size_t num_start = src;
|
||||
while (src < copy_len && block_content_start[src] >= '0' &&
|
||||
block_content_start[src] <= '9')
|
||||
{
|
||||
num = num * 10 + (block_content_start[src++] - '0');
|
||||
}
|
||||
|
||||
/* Check for whitespace + LOAD */
|
||||
size_t ws_start = src;
|
||||
while (src < copy_len && (block_content_start[src] == ' ' ||
|
||||
block_content_start[src] == '\t'))
|
||||
{
|
||||
src++;
|
||||
}
|
||||
|
||||
if (src + 4 <= copy_len && strncmp(&block_content_start[src], "LOAD", 4) == 0)
|
||||
{
|
||||
/* Remap block number */
|
||||
int new_num = num;
|
||||
for (int m = 0; m < block_count; m++)
|
||||
{
|
||||
if (block_map[m].original == num)
|
||||
{
|
||||
new_num = block_map[m].sequential;
|
||||
log_message(LOG_INFO, "INIT: Rewrote %d LOAD -> %d LOAD", num, new_num);
|
||||
break;
|
||||
}
|
||||
}
|
||||
|
||||
/* Write remapped number + whitespace + LOAD */
|
||||
char rewrite[32];
|
||||
int rewrite_len = snprintf(rewrite, sizeof(rewrite), "%d", new_num);
|
||||
if (dst + rewrite_len < 1024)
|
||||
{
|
||||
memcpy(&buf[dst], rewrite, rewrite_len);
|
||||
dst += rewrite_len;
|
||||
}
|
||||
|
||||
/* Copy whitespace */
|
||||
size_t ws_len = src - ws_start;
|
||||
if (dst + ws_len < 1024)
|
||||
{
|
||||
memcpy(&buf[dst], &block_content_start[ws_start], ws_len);
|
||||
dst += ws_len;
|
||||
}
|
||||
|
||||
/* Copy LOAD */
|
||||
if (dst + 4 < 1024)
|
||||
{
|
||||
memcpy(&buf[dst], "LOAD", 4);
|
||||
dst += 4;
|
||||
}
|
||||
src += 4;
|
||||
}
|
||||
else
|
||||
{
|
||||
/* Not LOAD, copy number as-is */
|
||||
size_t num_len = src - num_start;
|
||||
if (dst + num_len < 1024)
|
||||
{
|
||||
memcpy(&buf[dst], &block_content_start[num_start], num_len);
|
||||
dst += num_len;
|
||||
}
|
||||
}
|
||||
}
|
||||
else
|
||||
{
|
||||
/* Regular char */
|
||||
buf[dst++] = block_content_start[src++];
|
||||
}
|
||||
}
|
||||
|
||||
log_message(LOG_INFO, "INIT: Copied block content to block %d (%zu bytes)",
|
||||
current_dest_block, dst);
|
||||
current_dest_block++;
|
||||
}
|
||||
|
||||
/* Start new block - content begins on next line */
|
||||
in_block = 1;
|
||||
block_content_start = &file_content[i + 1];
|
||||
}
|
||||
|
||||
line_start = &file_content[i + 1];
|
||||
}
|
||||
}
|
||||
|
||||
/* Write final block if we were in one */
|
||||
if (in_block && block_content_start)
|
||||
{
|
||||
size_t block_len = (size_t)(&file_content[file_size] - block_content_start);
|
||||
|
||||
uint8_t* buf = blk_get_buffer((uint32_t)current_dest_block, 1);
|
||||
if (!buf)
|
||||
{
|
||||
log_message(LOG_ERROR, "INIT: Failed to get buffer for final block %d", current_dest_block);
|
||||
free(file_content);
|
||||
vm->error = 1;
|
||||
vm->halted = 1;
|
||||
return;
|
||||
}
|
||||
|
||||
memset(buf, 0, 1024);
|
||||
size_t copy_len = (block_len > 1024) ? 1024 : block_len;
|
||||
memcpy(buf, block_content_start, copy_len);
|
||||
|
||||
log_message(LOG_INFO, "INIT: Copied block content to block %d (%zu bytes)",
|
||||
current_dest_block, copy_len);
|
||||
current_dest_block++;
|
||||
}
|
||||
|
||||
free(file_content);
|
||||
|
||||
int total_blocks = current_dest_block - 1;
|
||||
log_message(LOG_INFO, "INIT: Loaded %d blocks from init.4th", total_blocks);
|
||||
|
||||
/* Execute all blocks sequentially */
|
||||
log_message(LOG_INFO, "INIT: Executing initialization blocks...");
|
||||
for (int i = 1; i < current_dest_block; i++)
|
||||
{
|
||||
log_message(LOG_DEBUG, "INIT: Executing block %d (LOAD)", i);
|
||||
|
||||
/* Push block number and execute LOAD */
|
||||
vm_push(vm, (cell_t)i);
|
||||
|
||||
/* Find and execute LOAD word */
|
||||
DictEntry* load_word = vm_find_word(vm, "LOAD", 4);
|
||||
if (!load_word)
|
||||
{
|
||||
log_message(LOG_ERROR, "INIT: LOAD word not found in dictionary");
|
||||
vm->error = 1;
|
||||
vm->halted = 1;
|
||||
return;
|
||||
}
|
||||
|
||||
vm->current_executing_entry = load_word;
|
||||
physics_execution_heat_increment(load_word);
|
||||
profiler_word_count(load_word);
|
||||
profiler_word_enter(load_word);
|
||||
load_word->func(vm);
|
||||
physics_metadata_touch(load_word, load_word->execution_heat, sf_monotonic_ns());
|
||||
profiler_word_exit(load_word);
|
||||
vm->current_executing_entry = NULL;
|
||||
|
||||
/* Check for errors after each block */
|
||||
if (vm->error)
|
||||
{
|
||||
log_message(LOG_ERROR, "INIT: Error executing block %d - system halted", i);
|
||||
vm->halted = 1;
|
||||
return;
|
||||
}
|
||||
}
|
||||
|
||||
/* Switch back to FORTH vocabulary */
|
||||
log_message(LOG_INFO, "INIT: Switching to FORTH vocabulary");
|
||||
vm_interpret(vm, "FORTH DEFINITIONS");
|
||||
if (vm->error)
|
||||
{
|
||||
log_message(LOG_ERROR, "INIT: Failed to switch to FORTH vocabulary - system halted");
|
||||
vm->halted = 1;
|
||||
return;
|
||||
}
|
||||
|
||||
/* Zero all init blocks to free them for userspace */
|
||||
log_message(LOG_INFO, "INIT: Zeroing %d init blocks for userspace use", total_blocks);
|
||||
for (int i = 1; i < current_dest_block; i++)
|
||||
{
|
||||
uint8_t* buf = blk_get_buffer((uint32_t)i, 1);
|
||||
if (buf)
|
||||
{
|
||||
memset(buf, 0, 1024);
|
||||
log_message(LOG_DEBUG, "INIT: Zeroed block %d", i);
|
||||
}
|
||||
else
|
||||
{
|
||||
log_message(LOG_WARN, "INIT: Failed to zero block %d (non-critical)", i);
|
||||
}
|
||||
}
|
||||
|
||||
log_message(LOG_INFO, "INIT: System initialization complete - blocks freed, FORTH context active");
|
||||
}
|
||||
|
||||
/* ============================================================================
|
||||
* PRNG / Utility Words
|
||||
* ============================================================================ */
|
||||
|
||||
/**
|
||||
* @brief Internal PRNG step using Linear Congruential Generator
|
||||
*
|
||||
* Uses Numerical Recipes LCG constants for good statistical properties.
|
||||
* @return Next pseudo-random 64-bit value
|
||||
*/
|
||||
static uint64_t prng_next(void)
|
||||
{
|
||||
/* LCG: state = (a * state + c) mod m, where m = 2^64 (implicit) */
|
||||
g_prng_state = g_prng_state * 6364136223846793005ULL + 1442695040888963407ULL;
|
||||
return g_prng_state;
|
||||
}
|
||||
|
||||
/**
|
||||
* @brief Set the PRNG seed
|
||||
*
|
||||
* Stack effect: ( n -- )
|
||||
* Sets the internal PRNG state for reproducible random sequences.
|
||||
* @param vm Pointer to the VM instance
|
||||
*/
|
||||
void starforth_word_seed(VM* vm)
|
||||
{
|
||||
if (vm->dsp < 0)
|
||||
{
|
||||
vm->error = 1;
|
||||
log_message(LOG_ERROR, "SEED: data stack underflow");
|
||||
return;
|
||||
}
|
||||
|
||||
cell_t seed = vm_pop(vm);
|
||||
g_prng_state = (uint64_t)seed;
|
||||
|
||||
/* Ensure non-zero state (LCG weakness) */
|
||||
if (g_prng_state == 0)
|
||||
{
|
||||
g_prng_state = 1;
|
||||
}
|
||||
|
||||
log_message(LOG_DEBUG, "SEED: PRNG seeded with %lu", (unsigned long)g_prng_state);
|
||||
}
|
||||
|
||||
/*
|
||||
* @brief Generate bounded random number
|
||||
*
|
||||
* Stack effect: ( lo hi -- n )
|
||||
* Returns a pseudo-random number in the inclusive range [lo, hi].
|
||||
* @param vm Pointer to the VM instance
|
||||
*/
|
||||
void starforth_word_random(VM* vm)
|
||||
{
|
||||
if (vm->dsp < 1)
|
||||
{
|
||||
vm->error = 1;
|
||||
log_message(LOG_ERROR, "RANDOM: data stack underflow (need lo hi)");
|
||||
return;
|
||||
}
|
||||
|
||||
cell_t hi = vm_pop(vm);
|
||||
cell_t lo = vm_pop(vm);
|
||||
|
||||
/* Handle inverted range */
|
||||
if (lo > hi)
|
||||
{
|
||||
cell_t tmp = lo;
|
||||
lo = hi;
|
||||
hi = tmp;
|
||||
}
|
||||
|
||||
/* Generate random value in range [lo, hi] inclusive */
|
||||
uint64_t range = (uint64_t)(hi - lo) + 1;
|
||||
uint64_t raw = prng_next();
|
||||
|
||||
/* Modulo bias reduction: use upper bits which have better randomness in LCG */
|
||||
cell_t result = lo + (cell_t)((raw >> 16) % range);
|
||||
|
||||
vm_push(vm, result);
|
||||
log_message(LOG_DEBUG, "RANDOM: [%ld, %ld] -> %ld", (long)lo, (long)hi, (long)result);
|
||||
}
|
||||
|
||||
/**
|
||||
* @brief Wait for specified number of heartbeat ticks
|
||||
*
|
||||
* Stack effect: ( n -- )
|
||||
* Counts n heartbeat ticks by calling vm_tick() n times.
|
||||
* Time is relative — we count heartbeats, not wall-clock milliseconds.
|
||||
* This is architecture-independent: works on amd64, aarch64, riscv64
|
||||
* without depending on any platform timer.
|
||||
* @param vm Pointer to the VM instance
|
||||
*/
|
||||
void starforth_word_wait(VM* vm)
|
||||
{
|
||||
if (vm->dsp < 0)
|
||||
{
|
||||
vm->error = 1;
|
||||
log_message(LOG_ERROR, "WAIT: stack underflow");
|
||||
return;
|
||||
}
|
||||
|
||||
cell_t ticks = vm_pop(vm);
|
||||
cell_t i;
|
||||
|
||||
if (ticks <= 0)
|
||||
return;
|
||||
|
||||
for (i = 0; i < ticks; i++)
|
||||
vm_tick(vm);
|
||||
}
|
||||
|
||||
/**
|
||||
* @brief Print StarForth version information (compliance)
|
||||
*
|
||||
* Prints: StarForth v<version> <architecture> <variant> <timestamp>
|
||||
* Stack effect: ( -- )
|
||||
* @param vm Pointer to the VM instance
|
||||
*/
|
||||
void starforth_word_version(VM* vm)
|
||||
{
|
||||
(void)vm; /* Unused parameter */
|
||||
printf("%s\n", STARFORTH_VERSION_FULL);
|
||||
}
|
||||
|
||||
/* ZUSE-AUTHENTICATE ( -- ) Sets zuse_session=1; C-only write; god-mode bypass */
|
||||
static void starforth_word_zuse_authenticate(VM *vm)
|
||||
{
|
||||
vm->zuse_session = 1;
|
||||
}
|
||||
|
||||
/* ZUSE-SESSION? ( -- flag ) Read-only diagnostic (FABRIC-2.md §F.21,
|
||||
* added 2026-08-28): confirms whether ZUSE-AUTHENTICATE has actually run
|
||||
* this boot. No corresponding write access -- matches ZUSE-PUBKEY@'s own
|
||||
* read-only-window convention. */
|
||||
static void starforth_word_zuse_session(VM *vm)
|
||||
{
|
||||
vm_push(vm, vm->zuse_session ? -1 : 0);
|
||||
}
|
||||
|
||||
/* ZUSE-PUBKEY@ ( i -- u ) Read-only: fetch 8-byte little-endian chunk i
|
||||
* (0..3) of Zuse's 32-byte Ed25519 public key as one cell. Out-of-range i
|
||||
* pushes 0 and sets vm->error rather than faulting. No FORTH word can
|
||||
* write these bytes or read the seed -- the cert is written exactly once,
|
||||
* in C, via vm_zuse_cert_install(); this is a read-only window onto the
|
||||
* PUBLIC half only. */
|
||||
static void starforth_word_zuse_pubkey_fetch(VM *vm)
|
||||
{
|
||||
if (vm->dsp < 0) {
|
||||
log_message(LOG_ERROR, "ZUSE-PUBKEY@: stack underflow");
|
||||
vm->error = 1;
|
||||
return;
|
||||
}
|
||||
cell_t i = vm_pop(vm);
|
||||
if (i < 0 || i > 3) {
|
||||
vm_push(vm, 0);
|
||||
vm->error = 1;
|
||||
return;
|
||||
}
|
||||
const uint8_t *p = &vm->zuse_cert_pubkey[i * 8];
|
||||
cell_t chunk = 0;
|
||||
for (int b = 7; b >= 0; b--) {
|
||||
chunk = (chunk << 8) | (cell_t)p[b];
|
||||
}
|
||||
vm_push(vm, chunk);
|
||||
}
|
||||
|
||||
/* ZUSE-CERT-INSTALLED? ( -- flag ) -1 if the one-time cert fuse has been
|
||||
* blown (vm_zuse_cert_install() has succeeded), 0 otherwise. */
|
||||
static void starforth_word_zuse_cert_installed_query(VM *vm)
|
||||
{
|
||||
vm_push(vm, vm->zuse_cert_installed ? -1 : 0);
|
||||
}
|
||||
|
||||
/**
|
||||
* @brief Read-only accessor for the canonical heartbeat tick counter
|
||||
*
|
||||
* Stack effect: ( -- n )
|
||||
* Pushes vm->heartbeat.tick_count -- Loop #7 "Adaptive Heartrate", the one
|
||||
* clock this project's timing measurements are supposed to read, not host
|
||||
* wall-clock. Read-only: no corresponding store word exists or should exist.
|
||||
* @param vm Pointer to the VM instance
|
||||
*/
|
||||
static void starforth_word_heartbeat_ticks(VM* vm)
|
||||
{
|
||||
vm_push(vm, (cell_t)vm->heartbeat.tick_count);
|
||||
}
|
||||
|
||||
/**
|
||||
* @brief Register StarForth vocabulary words with the VM
|
||||
*
|
||||
* Registers all StarForth-specific words and creates the STARFORTH vocabulary
|
||||
* @param vm Pointer to the VM instance
|
||||
*/
|
||||
void register_starforth_words(VM* vm)
|
||||
{
|
||||
STARFORTH_CHECK_ARENA("register_starforth_words:entry");
|
||||
register_word(vm, "WORD-ENTROPY", starforth_word_word_execution_heat);
|
||||
register_word(vm, "RESET-ENTROPY", starforth_word_reset_execution_heat);
|
||||
register_word(vm, "TOP-WORDS", starforth_word_top_words);
|
||||
register_word(vm, "(-", starforth_word_paren_dash);
|
||||
register_word(vm, "INIT", starforth_word_init);
|
||||
register_word(vm, "VERSION", starforth_word_version);
|
||||
register_word(vm, "SEED", starforth_word_seed);
|
||||
register_word(vm, "RANDOM", starforth_word_random);
|
||||
register_word(vm, "WAIT", starforth_word_wait);
|
||||
register_word(vm, "ZUSE-AUTHENTICATE", starforth_word_zuse_authenticate);
|
||||
register_word(vm, "ZUSE-SESSION?", starforth_word_zuse_session);
|
||||
register_word(vm, "ZUSE-PUBKEY@", starforth_word_zuse_pubkey_fetch);
|
||||
register_word(vm, "ZUSE-CERT-INSTALLED?", starforth_word_zuse_cert_installed_query);
|
||||
register_word(vm, "HEARTBEAT-TICKS@", starforth_word_heartbeat_ticks);
|
||||
|
||||
vm_bootstrap_root_vocabulary(vm, "STARFORTH");
|
||||
STARFORTH_CHECK_ARENA("register_starforth_words:post-root");
|
||||
|
||||
/* Re-register the words in the STARFORTH vocabulary context */
|
||||
register_word(vm, "ENTROPY@", starforth_word_execution_heat_fetch);
|
||||
register_word(vm, "ENTROPY!", starforth_word_execution_heat_store);
|
||||
register_word(vm, "WORD-ENTROPY", starforth_word_word_execution_heat);
|
||||
register_word(vm, "RESET-ENTROPY", starforth_word_reset_execution_heat);
|
||||
register_word(vm, "TOP-WORDS", starforth_word_top_words);
|
||||
register_word(vm, "(-", starforth_word_paren_dash);
|
||||
register_word(vm, "INIT", starforth_word_init);
|
||||
register_word(vm, "VERSION", starforth_word_version);
|
||||
register_word(vm, "SEED", starforth_word_seed);
|
||||
register_word(vm, "RANDOM", starforth_word_random);
|
||||
register_word(vm, "WAIT", starforth_word_wait);
|
||||
register_word(vm, "ZUSE-AUTHENTICATE", starforth_word_zuse_authenticate);
|
||||
register_word(vm, "ZUSE-SESSION?", starforth_word_zuse_session);
|
||||
register_word(vm, "ZUSE-PUBKEY@", starforth_word_zuse_pubkey_fetch);
|
||||
register_word(vm, "ZUSE-CERT-INSTALLED?", starforth_word_zuse_cert_installed_query);
|
||||
register_word(vm, "HEARTBEAT-TICKS@", starforth_word_heartbeat_ticks);
|
||||
|
||||
vocabulary_word_forth(vm);
|
||||
vocabulary_word_definitions(vm);
|
||||
STARFORTH_CHECK_ARENA("register_starforth_words:exit");
|
||||
}
|
||||
Reference in New Issue
Block a user