LithosAnanke/src/word_source/memory_words.c

/*
  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/memory_words.h"
#include "../../include/word_registry.h"
#include "vm.h"
#include "../../include/log.h"
#include "include/block_words.h" /* blk_vm_is_cross_device_copy() -- Phase 8 v3 */
#include <string.h>


/**
 * @brief Implements FORTH word '@' - Fetch cell from VM memory
 * 
 * Stack effect: ( addr -- n )
 * Fetches a cell value from the given memory address in VM memory.
 *
 * @param vm Pointer to the VM structure
 */
void memory_word_fetch(VM *vm) {
    if (vm->dsp < 0) {
        vm->error = 1;
        return;
    }
    vaddr_t addr = VM_ADDR(vm_pop(vm));
    if (!vm_addr_ok(vm, addr, sizeof(cell_t))) {
        vm->error = 1;
        return;
    }
    cell_t value = vm_load_cell(vm, addr);
    vm_push(vm, value);
}

/**
 * @brief Implements FORTH word '!' - Store cell into VM memory
 *
 * Stack effect: ( n addr -- )
 * Stores a cell value at the given memory address in VM memory.
 *
 * @param vm Pointer to the VM structure
 */
void memory_word_store(VM *vm) {
    if (vm->dsp < 1) {
        vm->error = 1;
        return;
    }
    vaddr_t addr = VM_ADDR(vm_pop(vm));
    cell_t value = vm_pop(vm);
    if (!vm_addr_ok(vm, addr, sizeof(cell_t))) {
        vm->error = 1;
        return;
    }
    vm_store_cell(vm, addr, value);
}

/**
 * @brief Implements FORTH word 'C@' - Fetch byte from VM memory
 *
 * Stack effect: ( addr -- c )
 * Fetches a byte value from the given memory address in VM memory.
 *
 * @param vm Pointer to the VM structure
 */
void memory_word_cfetch(VM *vm) {
    if (vm->dsp < 0) {
        vm->error = 1;
        return;
    }
    vaddr_t addr = VM_ADDR(vm_pop(vm));
    if (!vm_addr_ok(vm, addr, 1)) {
        vm->error = 1;
        return;
    }
    uint8_t value = vm_load_u8(vm, addr);
    vm_push(vm, (cell_t) value);
}

/**
 * @brief Implements FORTH word 'C!' - Store byte into VM memory
 *
 * Stack effect: ( c addr -- )
 * Stores a byte value at the given memory address in VM memory.
 *
 * @param vm Pointer to the VM structure
 */
void memory_word_cstore(VM *vm) {
    if (vm->dsp < 1) {
        vm->error = 1;
        return;
    }
    vaddr_t addr = VM_ADDR(vm_pop(vm));
    cell_t value = vm_pop(vm);
    if (!vm_addr_ok(vm, addr, 1)) {
        vm->error = 1;
        return;
    }
    vm_store_u8(vm, addr, (uint8_t)(value & 0xFF));
}

/**
 * @brief Implements FORTH word '+!' - Add to contents of cell
 *
 * Stack effect: ( n addr -- )
 * Adds n to the contents of the cell at the given address.
 *
 * @param vm Pointer to the VM structure
 */
void memory_word_plus_store(VM *vm) {
    if (vm->dsp < 1) {
        vm->error = 1;
        return;
    }
    vaddr_t addr = VM_ADDR(vm_pop(vm));
    cell_t n = vm_pop(vm);
    if (!vm_addr_ok(vm, addr, sizeof(cell_t))) {
        vm->error = 1;
        return;
    }
    cell_t current = vm_load_cell(vm, addr);
    vm_store_cell(vm, addr, current + n);
}

/**
 * @brief Implements FORTH word '-!' - Subtract from contents of cell
 *
 * Stack effect: ( n addr -- )
 * Subtracts n from the contents of the cell at the given address.
 *
 * @param vm Pointer to the VM structure
 */
void memory_word_minus_store(VM *vm) {
    if (vm->dsp < 1) {
        vm->error = 1;
        return;
    }
    vaddr_t addr = VM_ADDR(vm_pop(vm));
    cell_t n = vm_pop(vm);
    if (!vm_addr_ok(vm, addr, sizeof(cell_t))) {
        vm->error = 1;
        return;
    }
    cell_t current = vm_load_cell(vm, addr);
    vm_store_cell(vm, addr, current - n);
}

/**
 * @brief Implements FORTH word 'FILL' - Fill memory with byte value
 *
 * Stack effect: ( addr len c -- )
 * Fills len bytes of memory starting at addr with the value c.
 *
 * @param vm Pointer to the VM structure
 */
void memory_word_fill(VM *vm) {
    if (vm->dsp < 2) {
        vm->error = 1;
        return;
    }
    cell_t c_val = vm_pop(vm);
    size_t len = (size_t) vm_pop(vm);
    cell_t addr_cell = vm_pop(vm);

    /* Try VM address first */
    vaddr_t addr = VM_ADDR(addr_cell);
    if (vm_addr_ok(vm, addr, len)) {
        /* It's a valid VM address, use vm_ptr */
        uint8_t *ptr = vm_ptr(vm, addr);
        memset(ptr, (int) (c_val & 0xFF), len);
    } else {
        /* It's an external pointer (from BLOCK/BUFFER), use it directly */
        uint8_t *ptr = (uint8_t *) (uintptr_t) addr_cell;
        memset(ptr, (int) (c_val & 0xFF), len);
    }
}

/**
 * @brief Implements FORTH word 'MOVE' - Copy memory region
 *
 * Stack effect: ( addr1 addr2 len -- )
 * Copies len bytes from addr1 to addr2, handling overlapping regions correctly.
 *
 * @param vm Pointer to the VM structure
 */
void memory_word_move(VM *vm) {
    if (vm->dsp < 2) {
        vm->error = 1;
        return;
    }
    size_t len = (size_t) vm_pop(vm);
    vaddr_t addr2 = VM_ADDR(vm_pop(vm));
    vaddr_t addr1 = VM_ADDR(vm_pop(vm));
    if (!vm_addr_ok(vm, addr1, len) || !vm_addr_ok(vm, addr2, len)) {
        vm->error = 1;
        return;
    }
    /* Phase 8 v3 (2026-09-23): refuse a same-VM, cross-device raw block
     * copy -- see blk_vm_is_cross_device_copy()'s own doc comment. */
    if (blk_vm_is_cross_device_copy(vm, addr1, addr2)) {
        vm->error = 1;
        return;
    }
    uint8_t *src = vm_ptr(vm, addr1);
    uint8_t *dst = vm_ptr(vm, addr2);
    memmove(dst, src, len);
}

/**
 * @brief Implements FORTH word 'ERASE' - Zero memory region
 *
 * Stack effect: ( addr len -- )
 * Sets len bytes to zero starting at addr.
 *
 * @param vm Pointer to the VM structure
 */
void memory_word_erase(VM *vm) {
    if (vm->dsp < 1) {
        vm->error = 1;
        return;
    }
    size_t len = (size_t) vm_pop(vm);
    vaddr_t addr = VM_ADDR(vm_pop(vm));
    if (!vm_addr_ok(vm, addr, len)) {
        vm->error = 1;
        return;
    }
    uint8_t *ptr = vm_ptr(vm, addr);
    memset(ptr, 0, len);
}

/**
 * @brief Implements FORTH word '2@' - Fetch double cell
 *
 * Stack effect: ( addr -- x_low x_high )
 * Fetches two consecutive cells from memory, pushing low cell then high cell.
 *
 * @param vm Pointer to the VM structure
 */
void memory_word_2fetch(VM *vm) {
    if (vm->dsp < 0) {
        vm->error = 1;
        return;
    }
    vaddr_t addr = VM_ADDR(vm_pop(vm));

    const size_t sz = sizeof(cell_t);
    /* need room for two cells starting at addr */
    if (!vm_addr_ok(vm, addr, sz) || !vm_addr_ok(vm, addr + (vaddr_t) sz, sz)) {
        vm->error = 1;
        return;
    }

    cell_t low = vm_load_cell(vm, addr);
    cell_t high = vm_load_cell(vm, addr + (vaddr_t) sz);

    /* Push order: low first, high second (so high ends up on top) */
    vm_push(vm, low);
    vm_push(vm, high);
}

/**
 * @brief Implements FORTH word '2!' - Store double cell
 *
 * Stack effect: ( x_low x_high addr -- )
 * Stores two consecutive cells to memory, low cell at addr, high cell at addr+cell.
 *
 * @param vm Pointer to the VM structure
 */
void memory_word_2store(VM *vm) {
    if (vm->dsp < 2) {
        vm->error = 1;
        return;
    }

    vaddr_t addr = VM_ADDR(vm_pop(vm)); /* top of stack: addr */
    cell_t high = vm_pop(vm); /* next: high part */
    cell_t low = vm_pop(vm); /* next: low part */

    const size_t sz = sizeof(cell_t);
    if (!vm_addr_ok(vm, addr, sz) || !vm_addr_ok(vm, addr + (vaddr_t) sz, sz)) {
        vm->error = 1;
        return;
    }

    vm_store_cell(vm, addr, low);
    vm_store_cell(vm, addr + (vaddr_t) sz, high);
}

/* CELLS ( n -- n' )  Multiply by cell size (bytes per cell). */
/**
 * @brief Implements FORTH word 'CELLS' - Scale by cell size
 *
 * Stack effect: ( n -- n' )
 * Multiplies top of stack by cell size in bytes.
 *
 * @param vm Pointer to the VM structure
 */
static void memory_word_cells(VM *vm) {
    if (!vm) return;
    if (vm->dsp < 0) {
        vm->error = 1;
        log_message(LOG_ERROR, "CELLS: stack underflow");
        return;
    }
    cell_t n = vm_pop(vm);
    vm_push(vm, n * (cell_t) sizeof(cell_t));
}


/**
 * @brief Register all memory manipulation words with the VM
 *
 * Registers all standard memory words (@, !, C@, C!, etc.) with the VM's word dictionary.
 *
 * @param vm Pointer to the VM structure
 */
void register_memory_words(VM *vm) {
    register_word(vm, "@", memory_word_fetch);
    register_word(vm, "!", memory_word_store);
    register_word(vm, "C@", memory_word_cfetch);
    register_word(vm, "C!", memory_word_cstore);
    register_word(vm, "+!", memory_word_plus_store);
    register_word(vm, "-!", memory_word_minus_store);
    register_word(vm, "2@", memory_word_2fetch);
    register_word(vm, "2!", memory_word_2store);
    register_word(vm, "FILL", memory_word_fill);
    register_word(vm, "MOVE", memory_word_move);
    register_word(vm, "ERASE", memory_word_erase);
    register_word(vm, "CELLS", memory_word_cells);
}