/* StarForth — Steady-State Virtual Machine Runtime Copyright (c) 2023–2025 Robert A. James All rights reserved. Licensed under the StarForth License, Version 1.0 */ /* log_words.c — FORTH words for log level control and string emission */ #include "include/log_words.h" #include "../../include/word_registry.h" #include "../../include/log.h" #include #ifdef __STARKERNEL__ #include "starkernel/log_region.h" #include "starkernel/log_attrib.h" /* vm_log_attributed_vm() */ #include "starkernel/capsule_birth.h" /* capsule_vm_registry_get, VMRegistryEntry */ #include "starkernel/console.h" /* console_println() -- (LOG-APPEND-RAW) diagnostics */ #include "starkernel/doe_region.h" /* doe_region_append() -- DOE-PERSIST-TRIAL */ #include "starkernel/capsule_vm_physics.h" /* vm_physics_fleet_heat_sum(), vm_physics_conserved() */ #include "starkernel/capsule_vm_switch_signal.h" /* sk_vm_switch_signal_switch_count() */ #include /* strlen */ #endif /* ── Level constants ─────────────────────────────────────────────────── */ /** @brief LOG-ERROR ( -- n ) Push the @c LOG_ERROR level constant. */ static void log_word_error(VM *vm) { vm_push(vm, (cell_t)LOG_ERROR); } /** @brief LOG-WARN ( -- n ) Push the @c LOG_WARN level constant. */ static void log_word_warn (VM *vm) { vm_push(vm, (cell_t)LOG_WARN); } /** @brief LOG-INFO ( -- n ) Push the @c LOG_INFO level constant. */ static void log_word_info (VM *vm) { vm_push(vm, (cell_t)LOG_INFO); } /** @brief LOG-TEST ( -- n ) Push the @c LOG_TEST level constant. */ static void log_word_test (VM *vm) { vm_push(vm, (cell_t)LOG_TEST); } /** @brief LOG-DEBUG ( -- n ) Push the @c LOG_DEBUG level constant. */ static void log_word_debug(VM *vm) { vm_push(vm, (cell_t)LOG_DEBUG); } /* ── LOG-LEVEL! ( n -- ) ─────────────────────────────────────────────── */ /** * @brief LOG-LEVEL! ( n -- ) * * Pops @c n from the stack and calls @c log_set_level() to update the active * log filter. Values below @c LOG_ERROR are clamped to @c LOG_ERROR; values * above @c LOG_DEBUG are clamped to @c LOG_DEBUG. */ static void log_word_set_level(VM *vm) { if (vm->dsp < 0) { log_message(LOG_ERROR, "LOG-LEVEL!: stack underflow"); vm->error = 1; return; } cell_t n = vm_pop(vm); if (n < (cell_t)LOG_ERROR) n = (cell_t)LOG_ERROR; if (n > (cell_t)LOG_DEBUG) n = (cell_t)LOG_DEBUG; log_set_level((LogLevel)n); } /* ── LOG-LEVEL@ ( -- n ) ─────────────────────────────────────────────── */ /** * @brief LOG-LEVEL@ ( -- n ) * * Pushes the current log level onto the stack. */ static void log_word_get_level(VM *vm) { vm_push(vm, (cell_t)log_get_level()); } /* ── (do-log-*) runtime words ────────────────────────────────────────── */ /* * Called at runtime when a compiled LOG-INFO" etc. executes. * Reads the inline counted string from the threaded-code stream (same * layout as (do-string)) and routes it through log_message(). * * Inline layout: [1 length byte][n string bytes][padding to cell boundary] */ static void log_do_emit(VM *vm, LogLevel level) { if (vm->rsp < 0) { log_message(LOG_ERROR, "(do-log-*): return-stack underflow"); vm->error = 1; return; } uint8_t *data = (uint8_t *)(uintptr_t)vm->return_stack[vm->rsp]; if (!data) { log_message(LOG_ERROR, "(do-log-*): NULL inline-string pointer"); vm->error = 1; return; } uint8_t n = data[0]; /* advance IP before emitting so re-entrant calls see correct state */ size_t skip = 1 + (size_t)n; size_t padded = (skip + (sizeof(cell_t) - 1)) & ~(sizeof(cell_t) - 1); vm->return_stack[vm->rsp] = (cell_t)(uintptr_t)(data + padded); log_message(level, "%.*s", (int)n, (const char *)(data + 1)); } static void log_do_error(VM *vm) { log_do_emit(vm, LOG_ERROR); } static void log_do_warn (VM *vm) { log_do_emit(vm, LOG_WARN); } static void log_do_info (VM *vm) { log_do_emit(vm, LOG_INFO); } static void log_do_test (VM *vm) { log_do_emit(vm, LOG_TEST); } static void log_do_debug(VM *vm) { log_do_emit(vm, LOG_DEBUG); } /* ── Shared parse/compile helper ─────────────────────────────────────── */ /* * Parses a string literal "ccc" from the input stream (skipping an optional * leading space, consuming up to the closing double-quote). In interpret * mode emits directly via log_message(). In compile mode emits the named * runtime word followed by the inline counted string block. */ static void log_emit_string(VM *vm, LogLevel level, const char *rt_name, int rt_nlen) { const char *src = vm->input_buffer; size_t pos = vm->input_pos; size_t end = vm->input_length; if (!src || pos > end) { log_message(LOG_ERROR, "LOG-*\": no input buffer"); vm->error = 1; return; } if (pos < end && src[pos] == ' ') pos++; size_t start = pos; while (pos < end && src[pos] != '"') pos++; if (pos >= end) { log_message(LOG_ERROR, "LOG-*\": unterminated string literal"); vm->error = 1; return; } size_t n = pos - start; if (n > 255) n = 255; vm->input_pos = pos + 1; if (vm->mode == MODE_INTERPRET) { log_message(level, "%.*s", (int)n, src + start); return; } /* Compilation: emit runtime word then inline [len][chars][pad] */ DictEntry *rt = vm_find_word(vm, rt_name, (size_t)rt_nlen); if (!rt) { log_message(LOG_ERROR, "LOG-*\": runtime word '%.*s' not found", rt_nlen, rt_name); vm->error = 1; return; } vm_compile_word(vm, rt); size_t skip = 1 + n; size_t padded = (skip + (sizeof(cell_t) - 1)) & ~(sizeof(cell_t) - 1); uint8_t *raw = (uint8_t *)vm_allot(vm, padded); if (!raw) { log_message(LOG_ERROR, "LOG-*\": vm_allot failed"); vm->error = 1; return; } raw[0] = (uint8_t)n; for (size_t i = 0; i < n; i++) raw[1 + i] = (uint8_t)src[start + i]; for (size_t i = 1 + n; i < padded; i++) raw[i] = 0; } /* ── LOG-ERROR" LOG-WARN" LOG-INFO" LOG-TEST" LOG-DEBUG" (IMMEDIATE) ── */ /** @brief LOG-ERROR" ( "ccc" -- ) Log string at ERROR level. IMMEDIATE. */ static void log_word_error_quote(VM *vm) { log_emit_string(vm, LOG_ERROR, "(do-log-error)", 14); } /** @brief LOG-WARN" ( "ccc" -- ) Log string at WARN level. IMMEDIATE. */ static void log_word_warn_quote(VM *vm) { log_emit_string(vm, LOG_WARN, "(do-log-warn)", 13); } /** @brief LOG-INFO" ( "ccc" -- ) Log string at INFO level. IMMEDIATE. */ static void log_word_info_quote(VM *vm) { log_emit_string(vm, LOG_INFO, "(do-log-info)", 13); } /** @brief LOG-TEST" ( "ccc" -- ) Log string at TEST level. IMMEDIATE. */ static void log_word_test_quote(VM *vm) { log_emit_string(vm, LOG_TEST, "(do-log-test)", 13); } /** @brief LOG-DEBUG" ( "ccc" -- ) Log string at DEBUG level. IMMEDIATE. */ static void log_word_debug_quote(VM *vm) { log_emit_string(vm, LOG_DEBUG, "(do-log-debug)", 14); } /* ── LOG-*-STR ( c-addr u -- ) ──────────────────────────────────────── */ /* * Stack-consuming variants: take a counted string from the stack (as * produced by S") and route it through log_message() at the named level. * addr is a VM byte offset into vm->memory, identical to how TYPE works. */ static void log_str_emit(VM *vm, LogLevel level) { if (vm->dsp < 1) { log_message(LOG_ERROR, "LOG-*-STR: stack underflow"); vm->error = 1; return; } cell_t u = vm_pop(vm); cell_t addr = vm_pop(vm); if (u <= 0) return; if (addr < 0 || (addr + u) > (cell_t)VM_MEMORY_SIZE) { log_message(LOG_ERROR, "LOG-*-STR: address out of range"); vm->error = 1; return; } if (u > LOG_LINE_MAX - 1) u = LOG_LINE_MAX - 1; log_message(level, "%.*s", (int)u, (const char *)&vm->memory[addr]); } /** @brief LOG-ERROR-STR ( c-addr u -- ) Log string from stack at ERROR level. */ static void log_word_error_str(VM *vm) { log_str_emit(vm, LOG_ERROR); } /** @brief LOG-WARN-STR ( c-addr u -- ) Log string from stack at WARN level. */ static void log_word_warn_str (VM *vm) { log_str_emit(vm, LOG_WARN); } /** @brief LOG-INFO-STR ( c-addr u -- ) Log string from stack at INFO level. */ static void log_word_info_str (VM *vm) { log_str_emit(vm, LOG_INFO); } /** @brief LOG-TEST-STR ( c-addr u -- ) Log string from stack at TEST level. */ static void log_word_test_str (VM *vm) { log_str_emit(vm, LOG_TEST); } /** @brief LOG-DEBUG-STR ( c-addr u -- ) Log string from stack at DEBUG level. */ static void log_word_debug_str(VM *vm) { log_str_emit(vm, LOG_DEBUG); } /* ── (LOG-APPEND-RAW) ( level timestamp msg-addr msg-u -- ) ── */ /* * Kernel-only. Writes one record directly to Artemis's on-disk log ring * (log_region.c) -- the primitive LOG-APPEND (capsules/artemis/init.4th) * wraps this with the FORTH-level word name callers actually use. * Deliberately does NOT call log_message() anywhere in this path (see * log_region.c's own doc comment on why) -- errors are reported back via * vm->error, never logged. * * Source is NOT a caller-supplied parameter -- an earlier revision took * source-addr/source-u off the stack, which let any caller claim to be * any source. It is derived from vm_log_attributed_vm() (log_attrib.h) * instead: the real VM currently executing, looked up by name via the * VM registry, or the fixed "HADES" pseudo-source when no VM is attributed * (matching log_attrib.h's own documented convention). */ #ifdef __STARKERNEL__ static void log_word_append_raw(VM *vm) { /* Diagnostics here go via console_println(), not log_message() -- this * function's own doc comment above forbids log_message() (recursion * into the log ring it writes to); console_println() carries no such * risk and covers the "by hand at the console for a smoke test" case * that same comment names (FABRIC-3.md §XXXII.6). */ if (vm->dsp < 3) { console_println("(LOG-APPEND-RAW): stack underflow"); vm->error = 1; return; } cell_t msg_u = vm_pop(vm); cell_t msg_addr = vm_pop(vm); cell_t timestamp = vm_pop(vm); cell_t level = vm_pop(vm); if (msg_u < 0) { console_println("(LOG-APPEND-RAW): negative message length"); vm->error = 1; return; } if (msg_addr < 0 || (msg_addr + msg_u) > (cell_t)VM_MEMORY_SIZE) { console_println("(LOG-APPEND-RAW): message address out of range"); vm->error = 1; return; } const char *msg = (const char *)&vm->memory[msg_addr]; char source[VM_NAME_MAX]; VM *attrib = vm_log_attributed_vm(); VMRegistryEntry entry; if (attrib && capsule_vm_registry_get(attrib->stadium_vm_id, &entry) == 0) { size_t i = 0; for (; i < sizeof(source) - 1 && entry.name[i]; i++) source[i] = entry.name[i]; source[i] = '\0'; } else { const char *hades = "HADES"; size_t i = 0; for (; i < sizeof(source) - 1 && hades[i]; i++) source[i] = hades[i]; source[i] = '\0'; } /* log_region_append()'s return is three-valued (see log_region.h): * 0 success, 1 dropped by design (protected a higher-priority record, * not a fault -- no vm->error), -1 a genuine write failure. */ if (log_region_append((uint8_t)level, (uint64_t)timestamp, source, (uint32_t)strlen(source), msg, (uint32_t)msg_u) < 0) { vm->error = 1; } } #endif /* ── DOE-PERSIST-TRIAL ( run cfg rep nw mode fail isa-addr isa-u -- ) ── */ /* * Kernel-only. Writes one trial-summary record to Artemis's on-disk DoE * ring (doe_region.c), FABRIC-3.md §XXXV.3/.4. Called from * MU-EMIT-TRIAL-MARKER (multiuser-doe.4th / per-isa-doe.4th) right * alongside the existing console print, so a campaign's data survives * past the QEMU serial log without needing a live host tail. * * fleet_k_q48/fleet_conserved/switch_count_cumulative are NOT caller- * supplied -- read directly here via vm_physics_fleet_heat_sum(), * vm_physics_conserved(), sk_vm_switch_signal_switch_count(), same * discipline (LOG-APPEND-RAW) uses for its own source attribution: a * trial-end snapshot no FORTH caller could spoof or get stale by passing * the wrong value. */ #ifdef __STARKERNEL__ static void log_word_doe_persist_trial(VM *vm) { if (vm->dsp < 7) { console_println("DOE-PERSIST-TRIAL: stack underflow"); vm->error = 1; return; } cell_t isa_u = vm_pop(vm); cell_t isa_addr = vm_pop(vm); cell_t fail = vm_pop(vm); cell_t mode = vm_pop(vm); cell_t nw = vm_pop(vm); cell_t rep = vm_pop(vm); cell_t cfg = vm_pop(vm); cell_t run = vm_pop(vm); if (isa_u < 0 || isa_addr < 0 || (isa_addr + isa_u) > (cell_t)VM_MEMORY_SIZE) { console_println("DOE-PERSIST-TRIAL: isa string address out of range"); vm->error = 1; return; } const char *isa = (const char *)&vm->memory[isa_addr]; uint64_t fleet_k_q48 = vm_physics_fleet_heat_sum(); unsigned fleet_conserved = vm_physics_conserved() ? 1u : 0u; uint64_t switch_count = sk_vm_switch_signal_switch_count(); if (doe_region_append((uint32_t)run, (uint32_t)cfg, (uint32_t)rep, (uint32_t)nw, (uint32_t)mode, (uint32_t)fail, fleet_k_q48, fleet_conserved, switch_count, isa, (uint32_t)isa_u) != 0) { vm->error = 1; } } #endif /* ── DOE-RESUME-COUNT ( isa-addr isa-u -- n ) ── */ /* * Kernel-only. §XXXV.12 campaign crash-resume: counts CRC-valid, live * records in Artemis's DoE ring matching the given ISA tag. Called by * each RUN-*-CAMPAIGN entry word (per-isa-doe.4th) before MU-EXEC- * CAMPAIGN, so a re-boot after a crash resumes at the first trial that * doesn't already have a good persisted record, instead of restarting * the whole campaign from trial 0. */ #ifdef __STARKERNEL__ static void log_word_doe_resume_count(VM *vm) { if (vm->dsp < 1) { console_println("DOE-RESUME-COUNT: stack underflow"); vm->error = 1; return; } cell_t isa_u = vm_pop(vm); cell_t isa_addr = vm_pop(vm); if (isa_u < 0 || isa_addr < 0 || (isa_addr + isa_u) > (cell_t)VM_MEMORY_SIZE) { console_println("DOE-RESUME-COUNT: isa string address out of range"); vm->error = 1; vm_push(vm, 0); return; } const char *isa = (const char *)&vm->memory[isa_addr]; uint32_t n = doe_region_count_for_isa(isa, (uint32_t)isa_u); vm_push(vm, (cell_t)n); } #endif /* ── Registration ────────────────────────────────────────────────────── */ /** * @brief Register all log words with the VM dictionary. * * Level constants: LOG-ERROR LOG-WARN LOG-INFO LOG-TEST LOG-DEBUG * Level control: LOG-LEVEL! LOG-LEVEL@ * Runtime (hidden): (do-log-error) (do-log-warn) (do-log-info) * (do-log-test) (do-log-debug) * String literals: LOG-ERROR" LOG-WARN" LOG-INFO" LOG-TEST" LOG-DEBUG" * Stack string: LOG-ERROR-STR LOG-WARN-STR LOG-INFO-STR * LOG-TEST-STR LOG-DEBUG-STR * Kernel-only: (LOG-APPEND-RAW) DOE-PERSIST-TRIAL DOE-RESUME-COUNT */ void register_log_words(VM *vm) { /* Level constants (unchanged) */ register_word(vm, "LOG-ERROR", log_word_error); register_word(vm, "LOG-WARN", log_word_warn); register_word(vm, "LOG-INFO", log_word_info); register_word(vm, "LOG-TEST", log_word_test); register_word(vm, "LOG-DEBUG", log_word_debug); register_word(vm, "LOG-LEVEL!", log_word_set_level); register_word(vm, "LOG-LEVEL@", log_word_get_level); /* Runtime words for compiled LOG-*" — registered before the immediates * that reference them so vm_find_word() can locate them at compile time */ register_word(vm, "(do-log-error)", log_do_error); register_word(vm, "(do-log-warn)", log_do_warn); register_word(vm, "(do-log-info)", log_do_info); register_word(vm, "(do-log-test)", log_do_test); register_word(vm, "(do-log-debug)", log_do_debug); /* String-literal LOG-*" words — IMMEDIATE */ register_word(vm, "LOG-ERROR\"", log_word_error_quote); vm_make_immediate(vm); register_word(vm, "LOG-WARN\"", log_word_warn_quote); vm_make_immediate(vm); register_word(vm, "LOG-INFO\"", log_word_info_quote); vm_make_immediate(vm); register_word(vm, "LOG-TEST\"", log_word_test_quote); vm_make_immediate(vm); register_word(vm, "LOG-DEBUG\"", log_word_debug_quote); vm_make_immediate(vm); /* Stack-consuming LOG-*-STR words */ register_word(vm, "LOG-ERROR-STR", log_word_error_str); register_word(vm, "LOG-WARN-STR", log_word_warn_str); register_word(vm, "LOG-INFO-STR", log_word_info_str); register_word(vm, "LOG-TEST-STR", log_word_test_str); register_word(vm, "LOG-DEBUG-STR", log_word_debug_str); #ifdef __STARKERNEL__ register_word(vm, "(LOG-APPEND-RAW)", log_word_append_raw); register_word(vm, "DOE-PERSIST-TRIAL", log_word_doe_persist_trial); register_word(vm, "DOE-RESUME-COUNT", log_word_doe_resume_count); #endif }