akbasic/src/runtime_structure.c

/**
 * @file runtime_structure.c
 * @brief The group A verbs: DO, LOOP, BEGIN, BEND, ON and END.
 *
 * Block structure, built on the same `waitingForCommand` machinery `FOR`/`NEXT`
 * uses (section 1.6): a scope records the verb it is skipping forward to, and
 * nothing executes until that verb turns up. Everything here is a variation on
 * that one idea.
 *
 * **The line-based limitation applies to all of it.** Skipping works a source
 * line at a time, so a whole loop written on one line -- `DO : PRINT 1 : LOOP` --
 * does not loop, exactly as `FOR I=1 TO 3 : PRINT I : NEXT I` does not. That is
 * recorded in TODO.md section 4 and it wants its own piece of work: making the
 * skip operate on statements rather than lines.
 *
 * None of these verbs is in the Go reference, which lists all of them as
 * unimplemented, so the semantics come from Commodore BASIC 7.0.
 */

#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 Should a loop carrying this condition keep going?
 *
 * `WHILE` continues while the condition holds and `UNTIL` continues until it
 * does, which is the same test read two ways. A loop with no condition on that
 * end always continues -- `DO ... LOOP` is an infinite loop, and `EXIT` or a
 * `GOTO` is how a program leaves it.
 */
static akerr_ErrorContext *loop_continues(akbasic_Runtime *obj, akbasic_ASTLeaf *condition, int kind, bool *dest)
{
    PREPARE_ERROR(errctx);
    akbasic_Value *value = NULL;

    FAIL_ZERO_RETURN(errctx, (obj != NULL && dest != NULL), AKERR_NULLPOINTER,
		     "NULL argument in loop_continues");
    if ( kind == AKBASIC_LOOPCOND_NONE || condition == NULL ) {
	*dest = true;
	SUCCEED_RETURN(errctx);
    }
    PASS(errctx, akbasic_runtime_evaluate(obj, condition, &value));
    *dest = akbasic_value_is_truthy(value);
    if ( kind == AKBASIC_LOOPCOND_UNTIL ) {
	*dest = !(*dest);
    }
    SUCCEED_RETURN(errctx);
}

/* -------------------------------------------------------------- DO / LOOP -- */

akerr_ErrorContext *akbasic_cmd_do(akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest)
{
    PREPARE_ERROR(errctx);
    bool enter = false;

    (void)expr; (void)lval; (void)rval;
    FAIL_ZERO_RETURN(errctx, (obj != NULL && dest != NULL), AKERR_NULLPOINTER,
		     "NULL argument in DO");
    /*
     * The parse handler has already pushed the scope and stored the condition,
     * the way FOR's does -- so by the time this runs, `obj->environment` is the
     * loop's own.
     */
    FAIL_ZERO_RETURN(errctx, obj->environment->isDoLoop, AKBASIC_ERR_STATE,
		     "DO did not establish its own scope");

    if ( obj->environment->isEachLoop ) {
	akbasic_Environment *loopenv = obj->environment;
	akbasic_ASTLeaf *var = (expr != NULL ? expr->right : NULL);

	FAIL_ZERO_RETURN(errctx, (var != NULL && akbasic_leaf_is_identifier(var)),
			 AKBASIC_ERR_SYNTAX, "Expected DO EACH (variable) IN (generator call)");
	FAIL_ZERO_RETURN(errctx, (loopenv->forToLeaf != NULL), AKBASIC_ERR_STATE,
			 "Expected DO EACH (variable) IN (generator call)");

	PASS(errctx, akbasic_environment_get(loopenv, var->identifier, &loopenv->forNextVariable));
	FAIL_ZERO_RETURN(errctx, (loopenv->forNextVariable != NULL), AKBASIC_ERR_UNDEFINED,
			 "Unable to get loop variable %s", var->identifier);

	PASS(errctx, akbasic_runtime_generator_invoke(obj, loopenv, loopenv->forToLeaf));
	loopenv->forToLeaf = NULL;

	if ( loopenv->forGeneratorEnv == NULL ) {
	    /* The generator produced nothing: skip the body, same as DO WHILE
	       false does. */
	    PASS(errctx, akbasic_environment_wait_for_command(loopenv, "LOOP"));
	}
	SUCCEED_TRUE(obj, dest);
	SUCCEED_RETURN(errctx);
    }

    PASS(errctx, loop_continues(obj, obj->environment->doConditionLeaf,
				obj->environment->doConditionKind, &enter));
    if ( !enter ) {
	/*
	 * `DO WHILE` with a condition that is already false runs no body at all,
	 * so skip forward to the LOOP rather than executing the lines between.
	 * Same mechanism a zero-iteration FOR uses.
	 */
	PASS(errctx, akbasic_environment_wait_for_command(obj->environment, "LOOP"));
    }
    SUCCEED_TRUE(obj, dest);
    SUCCEED_RETURN(errctx);
}

akerr_ErrorContext *akbasic_cmd_loop(akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest)
{
    PREPARE_ERROR(errctx);
    akbasic_Value *value = NULL;
    akbasic_ASTLeaf *arg = NULL;
    bool again = false;
    int kind = AKBASIC_LOOPCOND_NONE;

    (void)lval; (void)rval;
    FAIL_ZERO_RETURN(errctx, (obj != NULL && dest != NULL), AKERR_NULLPOINTER,
		     "NULL argument in LOOP");
    FAIL_ZERO_RETURN(errctx, obj->environment->isDoLoop, AKBASIC_ERR_STATE,
		     "LOOP outside the context of DO");

    obj->environment->loopExitLine = obj->environment->lineno + 1;

    /* An EXIT sent us here; the loop is over whatever either condition says. */
    if ( obj->environment->exiting ) {
	obj->environment->exiting = false;
	PASS(errctx, akbasic_environment_stop_waiting(obj->environment, "LOOP"));
	/* A live generator abandoned mid-run: release it too. */
	if ( obj->environment->forGeneratorEnv != NULL ) {
	    PASS(errctx, akbasic_runtime_release_generator(obj, obj->environment->forGeneratorEnv));
	    obj->environment->forGeneratorEnv = NULL;
	}
	again = false;
    } else if ( obj->environment->isEachLoop ) {
	akbasic_Environment *loopenv = obj->environment;

	PASS(errctx, akbasic_environment_stop_waiting(obj->environment, "LOOP"));
	/*
	 * A condition on the LOOP composes with EACH: it is checked after each
	 * trip through the body, with the loop variable still holding that
	 * trip's value, before the generator is pumped for the next one. A
	 * condition that says stop abandons the generator exactly as EXIT does.
	 */
	again = true;
	arg = (expr != NULL ? expr->right : NULL);
	if ( arg != NULL ) {
	    kind = (int)arg->literal_int;
	    PASS(errctx, loop_continues(obj, arg->left, kind, &again));
	}
	if ( !again && loopenv->forGeneratorEnv != NULL ) {
	    PASS(errctx, akbasic_runtime_release_generator(obj, loopenv->forGeneratorEnv));
	    loopenv->forGeneratorEnv = NULL;
	}
	if ( again && loopenv->forGeneratorEnv != NULL ) {
	    obj->environment = loopenv->forGeneratorEnv;
	    PASS(errctx, akbasic_runtime_pump_generator(obj, loopenv));
	}
	again = (again && loopenv->forGeneratorEnv != NULL);
    } else {
	PASS(errctx, akbasic_environment_stop_waiting(obj->environment, "LOOP"));
	/*
	 * LOOP's own condition, parsed here rather than by a parse handler: the
	 * leaf is on this line and this line is still scanned, so unlike DO's
	 * there is nothing to preserve across iterations.
	 */
	arg = (expr != NULL ? expr->right : NULL);
	if ( arg != NULL ) {
	    kind = (int)arg->literal_int;
	    PASS(errctx, loop_continues(obj, arg->left, kind, &again));
	} else {
	    /*
	     * A bare LOOP re-tests whatever DO carried. `DO WHILE c ... LOOP`
	     * has to check `c` again at the bottom or the loop never ends.
	     */
	    PASS(errctx, loop_continues(obj, obj->environment->doConditionLeaf,
					obj->environment->doConditionKind, &again));
	}
    }
    (void)value;

    if ( again ) {
	obj->environment->nextline = obj->environment->loopFirstLine;
	SUCCEED_TRUE(obj, dest);
	SUCCEED_RETURN(errctx);
    }

    FAIL_ZERO_RETURN(errctx, (obj->environment->parent != NULL), AKBASIC_ERR_ENVIRONMENT,
		     "LOOP in an orphaned environment");
    obj->environment->parent->nextline = obj->environment->loopExitLine;
    PASS(errctx, akbasic_runtime_prev_environment(obj));
    SUCCEED_TRUE(obj, dest);
    SUCCEED_RETURN(errctx);
}

/* ----------------------------------------------------------- BEGIN / BEND -- */

akerr_ErrorContext *akbasic_cmd_begin(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 BEGIN");
    /*
     * Nothing to do when the block is entered. `IF c THEN BEGIN` reaches this
     * only when `c` was true, and the lines that follow are then ordinary lines
     * up to the BEND. The *false* case never gets here at all: the branch arms a
     * skip to BEND instead -- see the BRANCH case in akbasic_runtime_evaluate().
     */
    SUCCEED_TRUE(obj, dest);
    SUCCEED_RETURN(errctx);
}

akerr_ErrorContext *akbasic_cmd_bend(akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest)
{
    PREPARE_ERROR(errctx);
    bool waiting = false;

    (void)expr; (void)lval; (void)rval;
    FAIL_ZERO_RETURN(errctx, (obj != NULL && dest != NULL), AKERR_NULLPOINTER,
		     "NULL argument in BEND");
    /*
     * Either this is the end of a block that ran, in which case there is nothing
     * to do, or it is the BEND a skipped block was skipping to, in which case
     * stopping the skip is the whole job.
     */
    PASS(errctx, akbasic_environment_is_waiting_for(obj->environment, "BEND", &waiting));
    if ( waiting ) {
	PASS(errctx, akbasic_environment_stop_waiting(obj->environment, "BEND"));
    }
    SUCCEED_TRUE(obj, dest);
    SUCCEED_RETURN(errctx);
}

/* --------------------------------------------------------------------- ON -- */

akerr_ErrorContext *akbasic_cmd_on(akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest)
{
    PREPARE_ERROR(errctx);
    akbasic_ASTLeaf *arg = NULL;
    akbasic_Value *value = NULL;
    int64_t selector = 0;
    int64_t target = 0;
    int64_t returnline = 0;
    int index = 0;
    bool gosub = false;

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

    arg = akbasic_leaf_first_argument(expr);
    FAIL_ZERO_RETURN(errctx, (arg != NULL), AKBASIC_ERR_SYNTAX,
		     "Expected ON (expression) GOTO|GOSUB (line) [, ...]");
    /* The parse handler puts the GOSUB flag in the first argument's literal. */
    gosub = (arg->literal_int != 0);
    arg = arg->next;
    FAIL_ZERO_RETURN(errctx, (arg != NULL), AKBASIC_ERR_SYNTAX,
		     "Expected ON (expression) GOTO|GOSUB (line) [, ...]");

    PASS(errctx, akbasic_runtime_evaluate(obj, arg, &value));
    FAIL_NONZERO_RETURN(errctx, (value->valuetype == AKBASIC_TYPE_STRING), AKBASIC_ERR_TYPE,
			"ON expected a number");
    selector = (value->valuetype == AKBASIC_TYPE_FLOAT)
	? (int64_t)value->floatval : value->intval;

    /*
     * One-based, and out of range is not an error: BASIC 7.0 falls through to
     * the next statement when the selector names no target, which is what makes
     * `ON X GOTO 100, 200` usable without a bounds check in the program.
     */
    for ( arg = arg->next, index = 1; arg != NULL; arg = arg->next, index++ ) {
	if ( (int64_t)index != selector ) {
	    continue;
	}
	PASS(errctx, akbasic_runtime_evaluate(obj, arg, &value));
	FAIL_NONZERO_RETURN(errctx, (value->valuetype != AKBASIC_TYPE_INTEGER),
			    AKBASIC_ERR_TYPE, "ON expected a line number or a label");
	target = value->intval;

	if ( gosub ) {
	    returnline = obj->environment->lineno + 1;
	    PASS(errctx, akbasic_runtime_new_environment(obj));
	    obj->environment->gosubReturnLine = returnline;
	    obj->environment->nextline = target;
	} else {
	    obj->environment->nextline = target;
	}
	SUCCEED_TRUE(obj, dest);
	SUCCEED_RETURN(errctx);
    }
    SUCCEED_TRUE(obj, dest);
    SUCCEED_RETURN(errctx);
}

/* -------------------------------------------------------------------- END -- */

akerr_ErrorContext *akbasic_cmd_end(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 END");
    /*
     * The program is over, which is not the same as the interpreter being over.
     * A file run ends; a REPL session goes back to its prompt. That is what
     * run_finished_mode already means, and it is the difference between END and
     * QUIT -- QUIT ends the interpreter whatever started it.
     *
     * Unlike STOP this does not arm CONT. A C128 allows CONT after END, but END
     * says the program finished and CONT after a *finished* program resumes into
     * whatever line happens to follow, which is a worse answer than refusing.
     */
    PASS(errctx, akbasic_runtime_set_mode(obj, obj->run_finished_mode));
    SUCCEED_TRUE(obj, dest);
    SUCCEED_RETURN(errctx);
}