akbasic/src/runtime_machine.c

/**
 * @file runtime_machine.c
 * @brief The group J verbs: FETCH, STASH and SYS.
 *
 * Machine-level verbs on a machine that is not a Commodore 128. `POKE`, `PEEK`
 * and `POINTER` already treat a BASIC integer as a real address in this
 * process's memory -- that decision was made when they were ported -- and these
 * follow it, because a `FETCH` that meant something different from the `PEEK`
 * beside it would be worse than either answer on its own.
 *
 * `SYS` does not follow it, and the difference is the point: reading and writing
 * a byte is something this process can do, and jumping to one is not.
 */

#include <inttypes.h>
#include <stdio.h>
#include <string.h>

#include <akerror.h>

#include <akbasic/args.h>
#include <akbasic/error.h>
#include <akbasic/runtime.h>

#include "verbs.h"

/* Most verbs answer "did something happen"; this is that answer. */
#define SUCCEED_TRUE(__obj, __dest)			\
    do {						\
	*(__dest) = &(__obj)->staticTrueValue;		\
    } while ( 0 )

/**
 * @brief The copy behind both FETCH and STASH.
 *
 * On a C128 the two differ by which side is expansion RAM: `STASH` writes out to
 * the RAM Expansion Unit and `FETCH` reads back from it. There is no expansion
 * unit here and no banks, so both are the same byte copy and the only honest
 * thing to do is say so rather than invent a distinction.
 *
 * @param obj Runtime to evaluate against.
 * @param expr The command leaf.
 * @param verb Name to use in a diagnostic.
 * @return `NULL` on success, otherwise an error context owned by the caller.
 */
static akerr_ErrorContext *copy_bytes(akbasic_Runtime *obj, akbasic_ASTLeaf *expr, const char *verb)
{
    PREPARE_ERROR(errctx);
    double args[4];
    int count = 0;
    int64_t length = 0;

    PASS(errctx, akbasic_args_numbers(obj, expr, verb, args, 4, &count));
    FAIL_ZERO_RETURN(errctx, (count >= 3), AKBASIC_ERR_SYNTAX,
		     "Expected %s (count), (source address), (destination address)", verb);
    length = (int64_t)args[0];
    FAIL_ZERO_RETURN(errctx, (length >= 0), AKBASIC_ERR_VALUE,
		     "%s cannot copy a negative number of bytes", verb);
    FAIL_ZERO_RETURN(errctx, (args[1] != 0.0 && args[2] != 0.0), AKBASIC_ERR_VALUE,
		     "%s will not touch address zero", verb);
    if ( length == 0 ) {
	SUCCEED_RETURN(errctx);
    }
    /*
     * memmove rather than memcpy: a program shifting a buffer along by a few
     * bytes overlaps its own source, and that is a normal thing to ask for.
     *
     * There is no bounds check, and there cannot be one -- the same is true of
     * POKE and PEEK. A BASIC integer here is a real address, so a wrong one is a
     * segmentation fault rather than an error message. See TODO.md section 5.
     */
    memmove((void *)(uintptr_t)args[2], (const void *)(uintptr_t)args[1], (size_t)length);
    SUCCEED_RETURN(errctx);
}

akerr_ErrorContext *akbasic_cmd_fetch(akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest)
{
    PREPARE_ERROR(errctx);

    (void)lval; (void)rval;
    FAIL_ZERO_RETURN(errctx, (obj != NULL && dest != NULL), AKERR_NULLPOINTER,
		     "NULL argument in FETCH");
    PASS(errctx, copy_bytes(obj, expr, "FETCH"));
    SUCCEED_TRUE(obj, dest);
    SUCCEED_RETURN(errctx);
}

akerr_ErrorContext *akbasic_cmd_stash(akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest)
{
    PREPARE_ERROR(errctx);

    (void)lval; (void)rval;
    FAIL_ZERO_RETURN(errctx, (obj != NULL && dest != NULL), AKERR_NULLPOINTER,
		     "NULL argument in STASH");
    PASS(errctx, copy_bytes(obj, expr, "STASH"));
    SUCCEED_TRUE(obj, dest);
    SUCCEED_RETURN(errctx);
}

akerr_ErrorContext *akbasic_cmd_sys(akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest)
{
    PREPARE_ERROR(errctx);
    double args[4];
    int count = 0;

    (void)lval; (void)rval;
    FAIL_ZERO_RETURN(errctx, (obj != NULL && dest != NULL), AKERR_NULLPOINTER,
		     "NULL argument in SYS");
    /*
     * Parsed, then refused. Parsing first is deliberate: a program is told that
     * SYS is not implemented rather than that its arguments are wrong, and a
     * listing containing SYS still LISTs and still RENUMBERs.
     */
    PASS(errctx, akbasic_args_numbers(obj, expr, "SYS", args, 4, &count));
    FAIL_ZERO_RETURN(errctx, (count >= 1), AKBASIC_ERR_SYNTAX, "Expected SYS (address)");

    /*
     * There is no 6502. SYS calls machine code at an address, and the machine
     * code a C128 program would call is ROM that does not exist here -- so there
     * is nothing to jump to and nothing sensible to emulate. Jumping to a real
     * address in this process would be a way to crash it on purpose.
     *
     * Refused by name rather than ignored, because a program whose SYS silently
     * did nothing would carry on as though it had worked. This is the same
     * reasoning BANK, FAST and MONITOR are out of scope on, with one difference:
     * those are refused at the table and this one has a handler, because SYS is
     * common enough in published listings to be worth a specific message.
     */
    FAIL_RETURN(errctx, AKBASIC_ERR_DEVICE,
		"SYS %d: there is no 6502 here, and no ROM to call. Machine code cannot be run by this interpreter",
		(int)args[0]);
}