akbasic/src/runtime_housekeeping.c

/**
 * @file runtime_housekeeping.c
 * @brief The housekeeping verbs: NEW, CLR, CONT, TRON, TROFF, SWAP and HELP.
 *
 * TODO.md section 4 group B. None of these is in the Go reference -- they are
 * on its own "What Isn't Implemented" list -- so what they mean here is a
 * decision rather than a transcription, and each decision is recorded at its
 * verb. Where a C128's answer needs machine state this interpreter does not
 * have, the verb does the part that means something and says so.
 *
 * None of them needs a device, and none is in the golden corpus's way: they all
 * act on interpreter state a program can see through PRINT.
 */

#include <inttypes.h>

#include <akerror.h>
#include <akstdlib.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 Drop every variable and function, and hand their storage back.
 *
 * Shared by NEW and CLR, which differ only in whether the program text goes
 * too. The value pool is a bump allocator (see akbasic_ValuePool), so this is
 * the only place anything it handed out ever comes back -- re-initializing the
 * pool is what makes `CLR` in a loop viable where re-DIMming in one is not.
 */
static akerr_ErrorContext AKERR_NOIGNORE *clear_variables(akbasic_Runtime *obj)
{
    PREPARE_ERROR(errctx);
    akbasic_Environment *root = NULL;
    int i = 0;

    for ( i = 0; i < AKBASIC_MAX_VARIABLES; i++ ) {
	obj->variables[i].used = false;
    }
    for ( i = 0; i < AKBASIC_MAX_FUNCTIONS; i++ ) {
	obj->functions[i].used = false;
    }
    PASS(errctx, akbasic_valuepool_init(&obj->valuepool));

    /*
     * Unwind to the root before emptying its symbol tables. A CLR inside a
     * GOSUB would otherwise leave child environments holding pointers into the
     * variable pool it just released, and the parent chain is the only handle
     * on them.
     */
    while ( obj->environment != NULL && obj->environment->parent != NULL ) {
	PASS(errctx, akbasic_runtime_prev_environment(obj));
    }
    /*
     * That unwind may have released the environment an interrupt handler was
     * running in. Leaving the pointer behind would wedge interrupts off for the
     * rest of the session, since nothing would ever pop the environment it
     * compares against again.
     */
    obj->handlerenv = NULL;
    root = obj->environment;
    FAIL_ZERO_RETURN(errctx, (root != NULL), AKERR_NULLPOINTER, "Runtime has no root environment");
    PASS(errctx, akbasic_symtab_init(&root->variables, AKBASIC_MAX_VARIABLES));
    PASS(errctx, akbasic_symtab_init(&root->functions, AKBASIC_MAX_FUNCTIONS));
    /*
     * Put the reserved globals back. They were in the table this just emptied,
     * and the `TRAP` dispatch relies on never having to create them -- so a CLR
     * that left them gone would reopen item 33 for the rest of the session.
     */
    PASS(errctx, akbasic_runtime_reserve_globals(obj));
    SUCCEED_RETURN(errctx);
}

/* ----------------------------------------------------------------- NEW --- */

akerr_ErrorContext *akbasic_cmd_new(akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest)
{
    PREPARE_ERROR(errctx);
    int64_t i = 0;

    (void)expr; (void)lval; (void)rval;
    FAIL_ZERO_RETURN(errctx, (obj != NULL && dest != NULL), AKERR_NULLPOINTER, "NULL argument in NEW");

    for ( i = 0; i < AKBASIC_MAX_SOURCE_LINES; i++ ) {
	obj->source[i].code[0] = '\0';
	obj->source[i].lineno = 0;
	obj->source[i].numbered = false;
    }
    PASS(errctx, clear_variables(obj));
    PASS(errctx, akbasic_symtab_init(&obj->environment->labels, AKBASIC_MAX_LABELS));

    /* A new program does not inherit the old one's open files. */
    PASS(errctx, akbasic_disk_close_all(&obj->disk_state));

    /*
     * Disarm everything. The handlers were lines of the program that has just
     * been deleted, so an interrupt left armed would send the *next* program
     * into whatever happens to be at that line number.
     */
    for ( i = 0; i < AKBASIC_MAX_INTERRUPTS; i++ ) {
	PASS(errctx, akbasic_runtime_disarm_interrupt(obj, (akbasic_InterruptSource)i));
    }

    /*
     * And the sprites go back to undefined. The patterns belonged to the program
     * that has just been deleted. The *device* still holds them -- there is no
     * verb that undefines a sprite and so no entry point to say so -- but every
     * one of them is hidden, which is the observable half.
     */
    PASS(errctx, akbasic_sprite_state_init(&obj->sprite_state));
    if ( obj->sprites != NULL && obj->sprites->show != NULL ) {
	for ( i = 0; i < AKBASIC_MAX_SPRITES; i++ ) {
	    PASS(errctx, obj->sprites->show(obj->sprites, (int)i + 1, false));
	}
    }
    /*
     * **Static geometry does go back to the device**, where a sprite pattern
     * cannot. There is an entry point that retires one, so leaving them would be
     * a choice rather than a limitation -- and the wrong choice: a wall is
     * invisible, so one left behind by a deleted program is an unexplainable
     * collision in the next.
     */
    if ( obj->sprites != NULL && obj->sprites->solid != NULL ) {
	for ( i = 0; i < AKBASIC_MAX_SOLIDS; i++ ) {
	    PASS(errctx, obj->sprites->solid(obj->sprites, (int)i + 1, false, 0.0, 0.0, 0.0, 0.0));
	}
    }

    /*
     * And every widget comes down. Unlike a sprite there *is* an entry point
     * that undefines these, so this one is complete rather than half: a menu the
     * deleted program put up would otherwise sit on screen eating the cursor
     * keys, with nothing left running that knows how to retire it.
     */
    PASS(errctx, akbasic_ui_state_init(&obj->ui_state));
    if ( obj->ui != NULL && obj->ui->clear != NULL ) {
	PASS(errctx, obj->ui->clear(obj->ui));
    }

    /*
     * The line counter goes home too. Without this a NEW typed at the REPL
     * leaves the next entered line filed under wherever the last program
     * stopped, which is a surprising place for a fresh program to start.
     */
    obj->environment->lineno = 0;
    obj->environment->nextline = 0;
    obj->stopped = false;
    obj->stoppedline = 0;
    obj->errorline = 0;
    SUCCEED_TRUE(obj, dest);
    SUCCEED_RETURN(errctx);
}

/* ----------------------------------------------------------------- CLR --- */

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

    (void)expr; (void)lval; (void)rval;
    FAIL_ZERO_RETURN(errctx, (obj != NULL && dest != NULL), AKERR_NULLPOINTER, "NULL argument in CLR");

    /*
     * Variables and functions, not the program. A C128's CLR also closes open
     * files and empties the GOSUB and FOR stacks; the stacks *are* emptied here,
     * because unwinding to the root is how the variable pool is made safe to
     * release, and there are no open files to close -- DLOAD and DSAVE open,
     * transfer and close within the verb.
     */
    PASS(errctx, clear_variables(obj));
    SUCCEED_TRUE(obj, dest);
    SUCCEED_RETURN(errctx);
}

/* ------------------------------------------------------------ RENUMBER --- */

akerr_ErrorContext *akbasic_cmd_renumber(akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest)
{
    PREPARE_ERROR(errctx);
    double args[3];
    int count = 0;
    int64_t newstart = 10;
    int64_t increment = 10;
    int64_t oldstart = 0;

    (void)lval; (void)rval;
    FAIL_ZERO_RETURN(errctx, (obj != NULL && dest != NULL), AKERR_NULLPOINTER,
		     "NULL argument in RENUMBER");
    if ( expr != NULL && akbasic_leaf_first_argument(expr) != NULL ) {
	PASS(errctx, akbasic_args_numbers(obj, expr, "RENUMBER", args, 3, &count));
    }
    if ( count >= 1 ) {
	newstart = (int64_t)args[0];
    }
    if ( count >= 2 ) {
	increment = (int64_t)args[1];
    }
    if ( count >= 3 ) {
	oldstart = (int64_t)args[2];
    }

    PASS(errctx, akbasic_renumber(obj, newstart, increment, oldstart));
    /*
     * The labels and the DATA items were filed against the old numbering, so
     * both have to be built again. akbasic_runtime_set_mode() does it on the way
     * into RUN, but a program renumbered and then CONTinued would otherwise
     * branch on a stale map.
     */
    PASS(errctx, akbasic_runtime_scan_labels(obj));
    PASS(errctx, akbasic_data_scan(obj));
    obj->stopped = false;
    obj->stoppedline = 0;
    SUCCEED_TRUE(obj, dest);
    SUCCEED_RETURN(errctx);
}

/* ---------------------------------------------------------------- CONT --- */

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

    (void)expr; (void)lval; (void)rval;
    FAIL_ZERO_RETURN(errctx, (obj != NULL && dest != NULL), AKERR_NULLPOINTER, "NULL argument in CONT");

    /*
     * Refused rather than treated as a RUN. "CAN'T CONTINUE" is what a C128
     * says, and it says it for a reason: continuing a program that never
     * started would run it from line zero with whatever variables happened to be
     * lying about, which is not what anybody typing CONT wanted.
     */
    FAIL_ZERO_RETURN(errctx, obj->stopped, AKBASIC_ERR_STATE, "CAN'T CONTINUE");

    obj->environment->nextline = obj->stoppedline;
    obj->stopped = false;
    PASS(errctx, akbasic_runtime_set_mode(obj, AKBASIC_MODE_RUN));
    SUCCEED_TRUE(obj, dest);
    SUCCEED_RETURN(errctx);
}

/* -------------------------------------------------------- TRON / TROFF --- */

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

    (void)expr; (void)lval; (void)rval;
    FAIL_ZERO_RETURN(errctx, (obj != NULL && dest != NULL), AKERR_NULLPOINTER, "NULL argument in TRON");
    obj->trace = true;
    SUCCEED_TRUE(obj, dest);
    SUCCEED_RETURN(errctx);
}

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

    (void)expr; (void)lval; (void)rval;
    FAIL_ZERO_RETURN(errctx, (obj != NULL && dest != NULL), AKERR_NULLPOINTER, "NULL argument in TROFF");
    obj->trace = false;
    SUCCEED_TRUE(obj, dest);
    SUCCEED_RETURN(errctx);
}

/* ---------------------------------------------------------------- SWAP --- */

akerr_ErrorContext *akbasic_cmd_swap(akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest)
{
    PREPARE_ERROR(errctx);
    akbasic_ASTLeaf *first = NULL;
    akbasic_ASTLeaf *second = NULL;
    akbasic_Variable *a = NULL;
    akbasic_Variable *b = NULL;
    akbasic_Variable swap;
    char namea[AKBASIC_MAX_STRING_LENGTH];
    char nameb[AKBASIC_MAX_STRING_LENGTH];

    (void)lval; (void)rval;
    FAIL_ZERO_RETURN(errctx, (obj != NULL && expr != NULL && dest != NULL), AKERR_NULLPOINTER,
		     "NULL argument in SWAP");

    first = akbasic_leaf_first_argument(expr);
    second = (first != NULL ? first->next : NULL);
    FAIL_ZERO_RETURN(errctx, (first != NULL && second != NULL), AKBASIC_ERR_SYNTAX,
		     "Expected SWAP VARIABLE, VARIABLE");
    FAIL_ZERO_RETURN(errctx,
		     (akbasic_leaf_is_identifier(first) && akbasic_leaf_is_identifier(second)),
		     AKBASIC_ERR_SYNTAX, "Expected SWAP VARIABLE, VARIABLE");
    /*
     * Refused across types, which BASIC 7.0 also does. A# and B$ hold different
     * things and swapping them would leave two variables whose names no longer
     * describe their contents -- and the type suffix is the only type
     * declaration this language has.
     */
    FAIL_NONZERO_RETURN(errctx, (first->leaftype != second->leaftype), AKBASIC_ERR_TYPE,
			"SWAP needs two variables of the same type");

    PASS(errctx, akbasic_environment_get(obj->environment, first->identifier, &a));
    PASS(errctx, akbasic_environment_get(obj->environment, second->identifier, &b));
    FAIL_ZERO_RETURN(errctx, (a != NULL && b != NULL), AKBASIC_ERR_UNDEFINED,
		     "SWAP could not reach %s or %s", first->identifier, second->identifier);
    if ( a == b ) {
	/* SWAP A#, A# is legal and does nothing, rather than corrupting itself. */
	SUCCEED_TRUE(obj, dest);
	SUCCEED_RETURN(errctx);
    }

    /*
     * The whole record except the name, so an array swaps its dimensions and its
     * storage pointer along with its contents -- SWAP is documented as exchanging
     * the *variables*, not their scalar values, and on a C128 it is O(1) for
     * exactly this reason. The names stay put: they are what the symbol table
     * points at.
     */
    PASS(errctx, aksl_memcpy(namea, a->name, sizeof(namea)));
    PASS(errctx, aksl_memcpy(nameb, b->name, sizeof(nameb)));
    PASS(errctx, aksl_memcpy(&swap, a, sizeof(swap)));
    PASS(errctx, aksl_memcpy(a, b, sizeof(*a)));
    PASS(errctx, aksl_memcpy(b, &swap, sizeof(*b)));
    PASS(errctx, aksl_memcpy(a->name, namea, sizeof(a->name)));
    PASS(errctx, aksl_memcpy(b->name, nameb, sizeof(b->name)));
    /*
     * A scalar's storage is *inside* the record, so the pointer that came over
     * with it names the other variable's inline slot -- which now holds this
     * variable's own old value. Left alone, each side reads back what it started
     * with and SWAP silently does nothing. Rebind each to its own.
     */
    if ( a->values == &b->inlinevalue ) {
	a->values = &a->inlinevalue;
    }
    if ( b->values == &a->inlinevalue ) {
	b->values = &b->inlinevalue;
    }

    SUCCEED_TRUE(obj, dest);
    SUCCEED_RETURN(errctx);
}

/* ---------------------------------------------------------------- HELP --- */

akerr_ErrorContext *akbasic_cmd_help(akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest)
{
    PREPARE_ERROR(errctx);
    char line[AKBASIC_MAX_LINE_LENGTH * 2];
    int written = 0;

    (void)expr; (void)lval; (void)rval;
    FAIL_ZERO_RETURN(errctx, (obj != NULL && dest != NULL), AKERR_NULLPOINTER, "NULL argument in HELP");

    /*
     * A C128 re-lists the line the last error happened on and highlights the
     * part it choked on. The line is reproduced here; the highlight is not,
     * because the error is reported by the verb that raised it rather than by
     * something holding a token offset, so there is nothing that knows which
     * part to mark. Printing the line without pretending to know more is the
     * honest half of the verb.
     */
    if ( obj->errorline == 0 || obj->source[obj->errorline].code[0] == '\0' ) {
	PASS(errctx, akbasic_runtime_println(obj, "NO ERROR TO HELP WITH"));
	SUCCEED_TRUE(obj, dest);
	SUCCEED_RETURN(errctx);
    }
    /*
     * aksl_snprintf treats truncation as an error, and this destination is twice
     * AKBASIC_MAX_LINE_LENGTH against a stored line that is at most one of them
     * plus a line number, so the fit is a property of the buffer rather than
     * something to check for.
     */
    PASS(errctx, aksl_snprintf(&written, line, sizeof(line), "%" PRId64 " %s",
			       obj->errorline, obj->source[obj->errorline].code));
    PASS(errctx, akbasic_runtime_println(obj, line));
    SUCCEED_TRUE(obj, dest);
    SUCCEED_RETURN(errctx);
}