/* 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_api.h" #include "../include/vm.h" // internal details, not re-exposed to word modules #include /** @name Stack Operations * @{ */ /** @brief Push value onto data stack * @param vm VM instance * @param v Value to push */ void vm_api_push(VM *vm, intptr_t v) { vm_push(vm, v); } /** @brief Pop value from data stack * @param vm VM instance * @return Popped value */ intptr_t vm_api_pop(VM *vm) { return vm_pop(vm); } /** @brief Push value onto return stack * @param vm VM instance * @param v Value to push */ void vm_api_rpush(VM *vm, intptr_t v) { vm_rpush(vm, v); } /** @brief Pop value from return stack * @param vm VM instance * @return Popped value */ intptr_t vm_api_rpop(VM *vm) { return vm_rpop(vm); } /** @} */ /** @name Dictionary Operations * @{ */ /** @brief Create new word in dictionary * @param vm VM instance * @param n Word name * @param len Name length * @param fn Word implementation function * @return Pointer to created dictionary entry */ void *vm_api_create_word(VM *vm, const char *n, size_t len, word_func_t fn) { return (void *) vm_create_word(vm, n, len, (void(*)(struct VM *)) fn); } /** @brief Find word in dictionary * @param vm VM instance * @param n Word name to find * @param len Name length * @return Pointer to found dictionary entry or NULL */ void *vm_api_find_word(VM *vm, const char *n, size_t len) { return (void *) vm_find_word(vm, n, len); } /** @brief Hide last defined word * @param vm VM instance */ void vm_api_hide_word(VM *vm) { vm_hide_word(vm); } /** @brief Toggle smudge bit of last word * @param vm VM instance */ void vm_api_smudge_word(VM *vm) { vm_smudge_word(vm); } /** @} */ /** @brief Ensure input buffers are allocated * @param vm VM instance * @return 0 on success, 1 on error * @details Allocates TIB buffer and input variables if not already allocated */ int vm_input_ensure(VM *vm) { if (!vm) return 1; if (!vm->tib_buf) { vm->tib_buf = (unsigned char *) vm_allot(vm, INPUT_BUFFER_SIZE); if (!vm->tib_buf) { vm->error = 1; return 1; } vm->tib_cap = INPUT_BUFFER_SIZE; memset(vm->tib_buf, 0, vm->tib_cap); } if (!vm->in_var) { /* INPUT_BUFFER_SIZE (1025) is not a cell multiple; align here->here before * allocating cell-sized variables so their addresses pass the @ alignment check */ vm_align(vm); vm->in_var = (cell_t *) vm_allot(vm, sizeof(cell_t)); if (!vm->in_var) { vm->error = 1; return 1; } *vm->in_var = 0; } if (!vm->span_var) { vm->span_var = (cell_t *) vm_allot(vm, sizeof(cell_t)); if (!vm->span_var) { vm->error = 1; return 1; } *vm->span_var = 0; } return 0; } /** @brief Get pointer to terminal input buffer (TIB) * @param vm VM instance * @return Pointer to TIB or NULL on error * @details Returns pointer to VM's terminal input buffer after ensuring it exists */ unsigned char *vm_input_tib(VM *vm) { if (vm_input_ensure(vm)) return NULL; return vm->tib_buf; /* VM address */ } /** @brief Get pointer to input offset variable * @param vm VM instance * @return Pointer to input offset or NULL on error * @details Returns pointer to VM's input offset variable after ensuring it exists */ cell_t *vm_input_in(VM *vm) { if (vm_input_ensure(vm)) return NULL; return vm->in_var; /* VM address */ } /** @brief Get pointer to input span variable * @param vm VM instance * @return Pointer to span variable or NULL on error * @details Returns pointer to VM's input span variable after ensuring it exists */ cell_t *vm_input_span(VM *vm) { if (vm_input_ensure(vm)) return NULL; return vm->span_var; /* VM address */ } /** @brief Load input line into TIB * @param vm VM instance * @param src Source string to load * @param n Number of characters to load * @details Loads up to n characters from src into TIB, zero-pads remainder * Resets input offset and updates span. Handles NULL src gracefully. */ void vm_input_load_line(VM *vm, const char *src, size_t n) { if (vm_input_ensure(vm)) return; if (!src) { *vm->span_var = 0; *vm->in_var = 0; return; } size_t nclamp = n; if (nclamp > vm->tib_cap) nclamp = vm->tib_cap; memcpy(vm->tib_buf, src, nclamp); if (nclamp < vm->tib_cap) memset(vm->tib_buf + nclamp, 0, vm->tib_cap - nclamp); *vm->span_var = (cell_t) nclamp; *vm->in_var = 0; } /** @brief Get current input source buffer info * @param vm VM instance * @param out_addr Output parameter for buffer address * @param out_len Output parameter for buffer length * @details Returns current input buffer address and length through parameters * Both parameters are optional (can be NULL) */ void vm_input_source(VM *vm, cell_t *out_addr, cell_t *out_len) { if (vm_input_ensure(vm)) { if (out_addr) *out_addr = 0; if (out_len) *out_len = 0; return; } if (out_addr) *out_addr = (cell_t)(uintptr_t) vm->tib_buf; if (out_len) *out_len = (*vm->span_var < 0) ? 0 : *vm->span_var; } /** @name Memory Operations * @{ */ /** @brief Convert native pointer to Forth memory address * @param vm VM instance * @param p Native pointer to convert * @return Forth memory address (offset from VM memory base) * @details Converts a native C pointer to a Forth memory address by calculating * offset from VM memory base. Returns 0 for invalid pointers. */ cell_t vm_addr_from_ptr(VM *vm, void *p) { if (!vm || !p) return 0; #if defined(VM_STRICT_PTR) && VM_STRICT_PTR /* Forth addresses are real pointers */ return (cell_t)(uintptr_t)p; #else /* Forth addresses are offsets into vm->memory */ if (!vm->memory) return 0; unsigned long base = (unsigned long) vm->memory; unsigned long addr = (unsigned long) p; if (addr < base) return 0; return (cell_t)(addr - base); #endif } /** @} */