akbasic/src/runtime.c

/**
 * @file runtime.c
 * @brief Implements the interpreter core: pools, evaluation and the step loop.
 */

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

#include <akerror.h>

#include <akbasic/error.h>
#include <akbasic/parser.h>
#include <akbasic/runtime.h>
#include <akbasic/scanner.h>
#include <akbasic/verbs.h>

/* ------------------------------------------------------------------ pools -- */

akerr_ErrorContext *akbasic_runtime_new_variable(akbasic_Runtime *obj, akbasic_Variable **dest)
{
    PREPARE_ERROR(errctx);
    int i = 0;

    FAIL_ZERO_RETURN(errctx, (obj != NULL && dest != NULL), AKERR_NULLPOINTER,
		     "NULL argument in new_variable");
    for ( i = 0; i < AKBASIC_MAX_VARIABLES; i++ ) {
	if ( !obj->variables[i].used ) {
	    memset(&obj->variables[i], 0, sizeof(obj->variables[i]));
	    obj->variables[i].used = true;
	    *dest = &obj->variables[i];
	    SUCCEED_RETURN(errctx);
	}
    }
    FAIL_RETURN(errctx, AKBASIC_ERR_BOUNDS, "Maximum runtime variables reached");
}

akerr_ErrorContext *akbasic_runtime_global(akbasic_Runtime *obj, const char *name, akbasic_Variable **dest)
{
    PREPARE_ERROR(errctx);
    akbasic_Environment *root = NULL;

    FAIL_ZERO_RETURN(errctx, (obj != NULL && name != NULL && dest != NULL), AKERR_NULLPOINTER,
		     "NULL argument in runtime global");
    FAIL_ZERO_RETURN(errctx, (obj->environment != NULL), AKERR_NULLPOINTER,
		     "Runtime has no environment; call akbasic_runtime_init() first");

    /*
     * Walk to the root rather than using obj->environment. That is the whole
     * point: a script suspended part-way through a bounded run() is usually
     * inside a FOR or GOSUB body, and a variable created there dies when the
     * body pops -- silently, with the script reading it correctly right up
     * until it stops. See the note on the declaration.
     */
    for ( root = obj->environment; root->parent != NULL; root = root->parent ) {
    }
    PASS(errctx, akbasic_environment_create(root, name, dest));
    SUCCEED_RETURN(errctx);
}

akerr_ErrorContext *akbasic_runtime_new_function(akbasic_Runtime *obj, akbasic_FunctionDef **dest)
{
    PREPARE_ERROR(errctx);
    int i = 0;

    FAIL_ZERO_RETURN(errctx, (obj != NULL && dest != NULL), AKERR_NULLPOINTER,
		     "NULL argument in new_function");
    for ( i = 0; i < AKBASIC_MAX_FUNCTIONS; i++ ) {
	if ( !obj->functions[i].used ) {
	    memset(&obj->functions[i], 0, sizeof(obj->functions[i]));
	    obj->functions[i].used = true;
	    obj->functions[i].leafpool.next = 0;
	    obj->functions[i].leafpool.capacity = AKBASIC_MAX_LEAVES * 2;
	    obj->functions[i].leafpool.leaves = obj->functions[i].leafstorage;
	    *dest = &obj->functions[i];
	    SUCCEED_RETURN(errctx);
	}
    }
    FAIL_RETURN(errctx, AKBASIC_ERR_BOUNDS, "Maximum function definitions reached");
}

static akerr_ErrorContext *env_acquire(akbasic_Runtime *obj, akbasic_Environment **dest)
{
    PREPARE_ERROR(errctx);
    int i = 0;

    for ( i = 0; i < AKBASIC_MAX_ENVIRONMENTS; i++ ) {
	if ( !obj->environments[i].used ) {
	    obj->environments[i].used = true;
	    *dest = &obj->environments[i];
	    SUCCEED_RETURN(errctx);
	}
    }
    FAIL_RETURN(errctx, AKBASIC_ERR_ENVIRONMENT,
		"Environment pool exhausted at line %" PRId64 " (%d in use)",
		(obj->environment == NULL ? 0 : obj->environment->lineno),
		AKBASIC_MAX_ENVIRONMENTS);
}

akerr_ErrorContext *akbasic_runtime_new_environment(akbasic_Runtime *obj)
{
    PREPARE_ERROR(errctx);
    akbasic_Environment *env = NULL;

    FAIL_ZERO_RETURN(errctx, (obj != NULL), AKERR_NULLPOINTER, "NULL runtime in new_environment");
    PASS(errctx, env_acquire(obj, &env));
    PASS(errctx, akbasic_environment_init(env, obj, obj->environment));
    obj->environment = env;
    SUCCEED_RETURN(errctx);
}

akerr_ErrorContext *akbasic_runtime_prev_environment(akbasic_Runtime *obj)
{
    PREPARE_ERROR(errctx);
    akbasic_Environment *popped = NULL;

    FAIL_ZERO_RETURN(errctx, (obj != NULL), AKERR_NULLPOINTER, "NULL runtime in prev_environment");
    FAIL_ZERO_RETURN(errctx, (obj->environment->parent != NULL), AKBASIC_ERR_ENVIRONMENT,
		     "No previous environment to return to");
    popped = obj->environment;
    obj->environment = popped->parent;
    /*
     * Release it. The reference never does, which is a leak the GC papers over;
     * here the pool is finite, so an unreleased environment is a bug that shows
     * up as exhaustion a few thousand GOSUBs later.
     */
    popped->used = false;
    SUCCEED_RETURN(errctx);
}

/* ------------------------------------------------------------- lifecycle -- */

akerr_ErrorContext *akbasic_runtime_zero(akbasic_Runtime *obj)
{
    PREPARE_ERROR(errctx);

    FAIL_ZERO_RETURN(errctx, (obj != NULL), AKERR_NULLPOINTER, "NULL runtime in zero");
    PASS(errctx, akbasic_environment_zero(obj->environment));
    SUCCEED_RETURN(errctx);
}

akerr_ErrorContext *akbasic_runtime_init(akbasic_Runtime *obj, akbasic_TextSink *sink)
{
    PREPARE_ERROR(errctx);

    FAIL_ZERO_RETURN(errctx, (obj != NULL), AKERR_NULLPOINTER, "NULL runtime in init");
    FAIL_ZERO_RETURN(errctx, (sink != NULL), AKERR_NULLPOINTER, "NULL text sink in init");

    /*
     * Claim the status band before anything can raise one of our codes, or the
     * first error out of this function prints "Unknown Error". Idempotent, so a
     * host that already called it loses nothing.
     */
    PASS(errctx, akbasic_error_register());

    memset(obj, 0, sizeof(*obj));
    obj->sink = sink;
    obj->environment = NULL;
    obj->autoLineNumber = 0;
    obj->eval_clone_identifiers = true;
    obj->errclass = AKBASIC_ERRCLASS_NONE;
    obj->mode = AKBASIC_MODE_REPL;
    obj->run_finished_mode = AKBASIC_MODE_REPL;
    obj->inputEof = false;

    PASS(errctx, akbasic_graphics_state_init(&obj->gfx));
    PASS(errctx, akbasic_audio_state_init(&obj->audio_state));
    PASS(errctx, akbasic_valuepool_init(&obj->valuepool));
    PASS(errctx, akbasic_value_zero(&obj->staticTrueValue));
    PASS(errctx, akbasic_value_zero(&obj->staticFalseValue));
    PASS(errctx, akbasic_value_set_bool(&obj->staticTrueValue, true));
    PASS(errctx, akbasic_value_set_bool(&obj->staticFalseValue, false));

    PASS(errctx, akbasic_runtime_new_environment(obj));
    PASS(errctx, akbasic_runtime_zero(obj));
    PASS(errctx, akbasic_scanner_zero(obj));
    SUCCEED_RETURN(errctx);
}

akerr_ErrorContext *akbasic_runtime_set_devices(akbasic_Runtime *obj, akbasic_GraphicsBackend *graphics, akbasic_AudioBackend *audio, akbasic_InputBackend *input)
{
    PREPARE_ERROR(errctx);

    FAIL_ZERO_RETURN(errctx, (obj != NULL), AKERR_NULLPOINTER,
		     "NULL runtime in set_devices");

    /*
     * No validation of the records themselves. A backend with a NULL entry point
     * is caught at the call site by the verb that needs it, which can say which
     * verb wanted what -- checking every pointer here would only be able to say
     * that something, somewhere, was incomplete.
     */
    obj->graphics = graphics;
    obj->audio = audio;
    obj->input = input;
    SUCCEED_RETURN(errctx);
}

akerr_ErrorContext *akbasic_runtime_settime(akbasic_Runtime *obj, int64_t timems)
{
    PREPARE_ERROR(errctx);

    FAIL_ZERO_RETURN(errctx, (obj != NULL), AKERR_NULLPOINTER,
		     "NULL runtime in settime");

    /*
     * Deliberately not rejecting a time that moves backwards. A host is free to
     * drive this from a paused, scrubbed or replayed clock, and the only thing
     * that happens is a note holding longer than it asked to.
     */
    obj->timems = timems;
    SUCCEED_RETURN(errctx);
}

/* ---------------------------------------------------------------- output -- */

akerr_ErrorContext *akbasic_runtime_write(akbasic_Runtime *obj, const char *text)
{
    PREPARE_ERROR(errctx);

    FAIL_ZERO_RETURN(errctx, (obj != NULL && text != NULL), AKERR_NULLPOINTER,
		     "NULL argument in write");
    PASS(errctx, obj->sink->write(obj->sink, text));
    SUCCEED_RETURN(errctx);
}

akerr_ErrorContext *akbasic_runtime_println(akbasic_Runtime *obj, const char *text)
{
    PREPARE_ERROR(errctx);

    FAIL_ZERO_RETURN(errctx, (obj != NULL && text != NULL), AKERR_NULLPOINTER,
		     "NULL argument in println");
    PASS(errctx, obj->sink->writeln(obj->sink, text));
    SUCCEED_RETURN(errctx);
}

static const char *errclass_to_string(akbasic_ErrorClass errclass)
{
    switch ( errclass ) {
    case AKBASIC_ERRCLASS_IO:		return "IO ERROR";
    case AKBASIC_ERRCLASS_PARSE:	return "PARSE ERROR";
    case AKBASIC_ERRCLASS_RUNTIME:	return "RUNTIME ERROR";
    case AKBASIC_ERRCLASS_SYNTAX:	return "SYNTAX ERROR";
    default:				return "UNDEF";
    }
}

akerr_ErrorContext *akbasic_runtime_error(akbasic_Runtime *obj, akbasic_ErrorClass errclass, const char *message)
{
    PREPARE_ERROR(errctx);
    char line[AKBASIC_MAX_LINE_LENGTH * 2];

    FAIL_ZERO_RETURN(errctx, (obj != NULL && message != NULL), AKERR_NULLPOINTER,
		     "NULL argument in runtime error");
    obj->errclass = errclass;
    /* Where HELP will look. Recorded before the message is built, so a report
     * that itself fails still leaves the line behind. */
    obj->errorline = obj->environment->lineno;
    /*
     * The format, the trailing \n inside the string, and the second newline
     * writeln adds are all part of the acceptance contract --
     * tests/language/array_outofbounds.txt ends in 0a 0a. See TODO.md 1.8.
     */
    snprintf(line, sizeof(line), "? %" PRId64 " : %s %s\n",
	     obj->environment->lineno, errclass_to_string(errclass), message);
    PASS(errctx, akbasic_runtime_println(obj, line));
    SUCCEED_RETURN(errctx);
}

akerr_ErrorContext *akbasic_runtime_set_mode(akbasic_Runtime *obj, int mode)
{
    PREPARE_ERROR(errctx);

    FAIL_ZERO_RETURN(errctx, (obj != NULL), AKERR_NULLPOINTER, "NULL runtime in set_mode");
    obj->mode = mode;
    if ( obj->mode == AKBASIC_MODE_REPL ) {
	PASS(errctx, akbasic_runtime_println(obj, "READY"));
    }
    SUCCEED_RETURN(errctx);
}

/* ------------------------------------------------------------ evaluation -- */

/*
 * Report a runtime error carrying an akerr message, then re-raise. Used where
 * the reference calls basicError() and returns the error: the BASIC-visible line
 * goes to the sink and the context keeps propagating.
 */
static akerr_ErrorContext *report_and_reraise(akbasic_Runtime *obj, akerr_ErrorContext *cause)
{
    PREPARE_ERROR(errctx);
    char message[AKERR_MAX_ERROR_CONTEXT_STRING_LENGTH];
    int status = cause->status;

    snprintf(message, sizeof(message), "%s", cause->message);
    cause->handled = true;
    IGNORE(akerr_release_error(cause));
    PASS(errctx, akbasic_runtime_error(obj, AKBASIC_ERRCLASS_RUNTIME, message));
    FAIL_RETURN(errctx, status, "%s", message);
}

static akerr_ErrorContext *evaluate_identifier(akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value **dest)
{
    PREPARE_ERROR(errctx);
    akbasic_ASTLeaf *texpr = NULL;
    akbasic_Value *tval = NULL;
    akbasic_Value *slot = NULL;
    akbasic_Value *copy = NULL;
    akbasic_Variable *variable = NULL;
    int64_t subscripts[AKBASIC_MAX_ARRAY_DEPTH];
    int subscriptcount = 0;

    /*
     * An identifier's subscript list hangs off .expr, deliberately clear of
     * .right -- which is where an argument list chains its arguments, and where
     * INPUT's parse handler would otherwise collide with it. Checked for the
     * ARRAY_SUBSCRIPT operator anyway, because .expr means something else on the
     * leaf types that use it for grouping.
     */
    texpr = expr->expr;
    if ( texpr != NULL &&
	 texpr->leaftype == AKBASIC_LEAF_ARGUMENTLIST &&
	 texpr->operator_ == AKBASIC_TOK_ARRAY_SUBSCRIPT ) {
	for ( texpr = texpr->right; texpr != NULL; texpr = texpr->next ) {
	    FAIL_ZERO_RETURN(errctx, (subscriptcount < AKBASIC_MAX_ARRAY_DEPTH),
			     AKBASIC_ERR_BOUNDS,
			     "More than %d array subscripts", AKBASIC_MAX_ARRAY_DEPTH);
	    PASS(errctx, akbasic_runtime_evaluate(obj, texpr, &tval));
	    FAIL_NONZERO_RETURN(errctx, (tval->valuetype != AKBASIC_TYPE_INTEGER),
				AKBASIC_ERR_TYPE,
				"Array dimensions must evaluate to integer (C)");
	    subscripts[subscriptcount] = tval->intval;
	    subscriptcount += 1;
	}
    }
    if ( subscriptcount == 0 ) {
	subscripts[0] = 0;
	subscriptcount = 1;
    }

    PASS(errctx, akbasic_environment_get(obj->environment, expr->identifier, &variable));
    FAIL_ZERO_RETURN(errctx, (variable != NULL), AKBASIC_ERR_UNDEFINED,
		     "Identifier %s is undefined", expr->identifier);
    PASS(errctx, akbasic_variable_get_subscript(variable, subscripts, subscriptcount, &slot));

    if ( !obj->eval_clone_identifiers ) {
	*dest = slot;
	SUCCEED_RETURN(errctx);
    }
    PASS(errctx, akbasic_environment_new_value(obj->environment, &copy));
    PASS(errctx, akbasic_value_clone(slot, copy));
    *dest = copy;
    SUCCEED_RETURN(errctx);
}

static akerr_ErrorContext *evaluate_binary(akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value **dest)
{
    PREPARE_ERROR(errctx);
    akbasic_Value *lval = NULL;
    akbasic_Value *rval = NULL;
    akbasic_Value *scratch = NULL;

    PASS(errctx, akbasic_runtime_evaluate(obj, expr->left, &lval));
    PASS(errctx, akbasic_runtime_evaluate(obj, expr->right, &rval));

    if ( expr->operator_ == AKBASIC_TOK_ASSIGNMENT ) {
	PASS(errctx, akbasic_environment_assign(obj->environment, expr->left, rval, dest));
	SUCCEED_RETURN(errctx);
    }

    PASS(errctx, akbasic_environment_new_value(obj->environment, &scratch));
    switch ( expr->operator_ ) {
    case AKBASIC_TOK_MINUS:
	PASS(errctx, akbasic_value_math_minus(lval, rval, scratch, dest));
	break;
    case AKBASIC_TOK_PLUS:
	PASS(errctx, akbasic_value_math_plus(lval, rval, scratch, dest));
	break;
    case AKBASIC_TOK_LEFT_SLASH:
	PASS(errctx, akbasic_value_math_divide(lval, rval, scratch, dest));
	break;
    case AKBASIC_TOK_STAR:
	PASS(errctx, akbasic_value_math_multiply(lval, rval, scratch, dest));
	break;
    case AKBASIC_TOK_AND:
	PASS(errctx, akbasic_value_bitwise_and(lval, rval, scratch, dest));
	break;
    case AKBASIC_TOK_OR:
	PASS(errctx, akbasic_value_bitwise_or(lval, rval, scratch, dest));
	break;
    case AKBASIC_TOK_LESS_THAN:
	PASS(errctx, akbasic_value_less_than(lval, rval, scratch, dest));
	break;
    case AKBASIC_TOK_LESS_THAN_EQUAL:
	PASS(errctx, akbasic_value_less_than_equal(lval, rval, scratch, dest));
	break;
    case AKBASIC_TOK_EQUAL:
	PASS(errctx, akbasic_value_is_equal(lval, rval, scratch, dest));
	break;
    case AKBASIC_TOK_NOT_EQUAL:
	PASS(errctx, akbasic_value_is_not_equal(lval, rval, scratch, dest));
	break;
    case AKBASIC_TOK_GREATER_THAN:
	PASS(errctx, akbasic_value_greater_than(lval, rval, scratch, dest));
	break;
    case AKBASIC_TOK_GREATER_THAN_EQUAL:
	PASS(errctx, akbasic_value_greater_than_equal(lval, rval, scratch, dest));
	break;
    default:
	FAIL_RETURN(errctx, AKBASIC_ERR_SYNTAX,
		    "Don't know how to perform binary operation %d", (int)expr->operator_);
    }
    SUCCEED_RETURN(errctx);
}

akerr_ErrorContext *akbasic_runtime_evaluate(akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value **dest)
{
    PREPARE_ERROR(errctx);
    akbasic_Value *lval = NULL;
    akbasic_Value *rval = NULL;
    akbasic_Value *scratch = NULL;
    const akbasic_Verb *verb = NULL;

    FAIL_ZERO_RETURN(errctx, (obj != NULL && dest != NULL), AKERR_NULLPOINTER,
		     "NULL argument in evaluate");
    FAIL_ZERO_RETURN(errctx, (expr != NULL), AKERR_NULLPOINTER, "NULL expression in evaluate");

    PASS(errctx, akbasic_environment_new_value(obj->environment, &lval));
    PASS(errctx, akbasic_value_zero(lval));
    *dest = lval;

    switch ( expr->leaftype ) {
    case AKBASIC_LEAF_GROUPING:
	PASS(errctx, akbasic_runtime_evaluate(obj, expr->expr, dest));
	SUCCEED_RETURN(errctx);

    case AKBASIC_LEAF_BRANCH:
	ATTEMPT {
	    CATCH(errctx, akbasic_runtime_evaluate(obj, expr->expr, &rval));
	} CLEANUP {
	} PROCESS(errctx) {
	} HANDLE_DEFAULT(errctx) {
	    PASS(errctx, report_and_reraise(obj, errctx));
	} FINISH(errctx, true);
	/*
	 * Who owns the rest of the line?
	 *
	 * BASIC 7.0 scopes every statement after THEN to the condition, and the
	 * parser only ever takes *one* statement for each arm -- the rest arrive
	 * at the statement loop as ordinary top-level statements. So the branch
	 * has to say whether that loop should run them.
	 *
	 *   IF C THEN A : B            C false -> B belongs to THEN, skip it
	 *   IF C THEN A ELSE B : D     C true  -> D belongs to ELSE, skip it
	 *
	 * which is not "skip when false": the remainder always belongs to
	 * whichever arm was written last, so it is skipped exactly when that arm
	 * is the one *not* taken. With an ELSE present the last arm is ELSE;
	 * without one it is THEN.
	 */
	obj->skiprestofline = ((expr->right != NULL) == (rval->boolvalue == AKBASIC_TRUE));

	if ( rval->boolvalue == AKBASIC_TRUE ) {
	    PASS(errctx, akbasic_runtime_evaluate(obj, expr->left, dest));
	    SUCCEED_RETURN(errctx);
	}
	if ( expr->right != NULL ) {
	    /* A false branch is optional for some branching operations. */
	    PASS(errctx, akbasic_runtime_evaluate(obj, expr->right, dest));
	    SUCCEED_RETURN(errctx);
	}
	SUCCEED_RETURN(errctx);

    case AKBASIC_LEAF_IDENTIFIER_INT:
    case AKBASIC_LEAF_IDENTIFIER_FLOAT:
    case AKBASIC_LEAF_IDENTIFIER_STRING:
	PASS(errctx, evaluate_identifier(obj, expr, dest));
	SUCCEED_RETURN(errctx);

    case AKBASIC_LEAF_IDENTIFIER:
	/* A bare identifier with no type suffix is a label. */
	lval->valuetype = AKBASIC_TYPE_INTEGER;
	PASS(errctx, akbasic_environment_get_label(obj->environment, expr->identifier, &lval->intval));
	SUCCEED_RETURN(errctx);

    case AKBASIC_LEAF_LITERAL_INT:
	lval->valuetype = AKBASIC_TYPE_INTEGER;
	lval->intval = expr->literal_int;
	SUCCEED_RETURN(errctx);

    case AKBASIC_LEAF_LITERAL_FLOAT:
	lval->valuetype = AKBASIC_TYPE_FLOAT;
	lval->floatval = expr->literal_float;
	SUCCEED_RETURN(errctx);

    case AKBASIC_LEAF_LITERAL_STRING:
	lval->valuetype = AKBASIC_TYPE_STRING;
	memcpy(lval->stringval, expr->literal_string, sizeof(lval->stringval));
	SUCCEED_RETURN(errctx);

    case AKBASIC_LEAF_UNARY:
	/* .left: a unary leaf's operand, kept clear of the argument chain. */
	PASS(errctx, akbasic_runtime_evaluate(obj, expr->left, &rval));
	PASS(errctx, akbasic_environment_new_value(obj->environment, &scratch));
	if ( expr->operator_ == AKBASIC_TOK_MINUS ) {
	    PASS(errctx, akbasic_value_invert(rval, scratch, dest));
	} else if ( expr->operator_ == AKBASIC_TOK_NOT ) {
	    PASS(errctx, akbasic_value_bitwise_not(rval, scratch, dest));
	} else {
	    FAIL_RETURN(errctx, AKBASIC_ERR_SYNTAX,
			"Don't know how to perform operation %d on unary type %d",
			(int)expr->operator_, (int)rval->valuetype);
	}
	SUCCEED_RETURN(errctx);

    case AKBASIC_LEAF_FUNCTION:
	PASS(errctx, akbasic_verb_lookup(expr->identifier, &verb));
	if ( verb != NULL && verb->exec != NULL && verb->tokentype == AKBASIC_TOK_FUNCTION ) {
	    PASS(errctx, verb->exec(obj, expr, lval, rval, dest));
	    SUCCEED_RETURN(errctx);
	}
	PASS(errctx, akbasic_runtime_user_function(obj, expr, dest));
	SUCCEED_RETURN(errctx);

    case AKBASIC_LEAF_COMMAND_IMMEDIATE:
    case AKBASIC_LEAF_COMMAND:
	PASS(errctx, akbasic_verb_lookup(expr->identifier, &verb));
	FAIL_ZERO_RETURN(errctx, (verb != NULL && verb->exec != NULL), AKBASIC_ERR_UNDEFINED,
			 "Unknown command %s", expr->identifier);
	PASS(errctx, verb->exec(obj, expr, lval, rval, dest));
	SUCCEED_RETURN(errctx);

    case AKBASIC_LEAF_BINARY:
	PASS(errctx, evaluate_binary(obj, expr, dest));
	SUCCEED_RETURN(errctx);

    default:
	SUCCEED_RETURN(errctx);
    }
}

akerr_ErrorContext *akbasic_runtime_interpret(akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value **dest)
{
    PREPARE_ERROR(errctx);

    FAIL_ZERO_RETURN(errctx, (obj != NULL && expr != NULL && dest != NULL), AKERR_NULLPOINTER,
		     "NULL argument in interpret");
    /*
     * While an environment is skipping forward to a verb, nothing runs but that
     * verb. This is what keeps a zero-iteration FOR body from executing, given
     * that the loop condition is evaluated at the bottom of the structure.
     */
    if ( akbasic_environment_is_waiting_for_any(obj->environment) ) {
	if ( expr->leaftype != AKBASIC_LEAF_COMMAND ||
	     !akbasic_environment_is_waiting_for(obj->environment, expr->identifier) ) {
	    *dest = &obj->staticTrueValue;
	    SUCCEED_RETURN(errctx);
	}
    }
    ATTEMPT {
	CATCH(errctx, akbasic_runtime_evaluate(obj, expr, dest));
    } CLEANUP {
    } PROCESS(errctx) {
    } HANDLE_DEFAULT(errctx) {
	PASS(errctx, report_and_reraise(obj, errctx));
    } FINISH(errctx, true);
    SUCCEED_RETURN(errctx);
}

akerr_ErrorContext *akbasic_runtime_interpret_immediate(akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value **dest)
{
    PREPARE_ERROR(errctx);

    FAIL_ZERO_RETURN(errctx, (obj != NULL && expr != NULL && dest != NULL), AKERR_NULLPOINTER,
		     "NULL argument in interpret_immediate");
    *dest = NULL;
    if ( expr->leaftype != AKBASIC_LEAF_COMMAND_IMMEDIATE ) {
	SUCCEED_RETURN(errctx);
    }
    PASS(errctx, akbasic_runtime_evaluate(obj, expr, dest));
    SUCCEED_RETURN(errctx);
}

akerr_ErrorContext *akbasic_runtime_user_function(akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value **dest)
{
    PREPARE_ERROR(errctx);
    akbasic_FunctionDef *fndef = NULL;
    akbasic_Environment *targetenv = obj->environment;
    akbasic_ASTLeaf *leafptr = NULL;
    akbasic_ASTLeaf *argptr = NULL;
    akbasic_Value *argvalue = NULL;
    akbasic_Value *unused = NULL;
    void *fnptr = NULL;

    PASS(errctx, akbasic_environment_get_function(obj->environment, expr->identifier, &fnptr));
    fndef = (akbasic_FunctionDef *)fnptr;

    /*
     * The function's environment is owned by the funcdef, not by the pool free
     * list: it is reset on every call and outlives any single one. The reference
     * holds it by value inside BasicFunctionDef for the same reason.
     */
    if ( fndef->environment == NULL ) {
	PASS(errctx, akbasic_runtime_new_environment(obj));
	fndef->environment = obj->environment;
	obj->environment = targetenv;
    }
    PASS(errctx, akbasic_environment_init(fndef->environment, obj, obj->environment));

    /* Bind arguments into the function's scope before entering it. */
    leafptr = (expr->right != NULL ? expr->right->right : NULL);
    argptr = (fndef->arglist != NULL ? fndef->arglist->right : NULL);
    while ( leafptr != NULL && argptr != NULL ) {
	akbasic_Environment *callerenv = obj->environment;
	PASS(errctx, akbasic_runtime_evaluate(obj, leafptr, &argvalue));
	obj->environment = fndef->environment;
	PASS(errctx, akbasic_environment_assign(fndef->environment, argptr, argvalue, &unused));
	obj->environment = callerenv;
	leafptr = leafptr->next;
	argptr = argptr->next;
    }

    obj->environment = fndef->environment;

    if ( fndef->expression != NULL ) {
	PASS(errctx, akbasic_runtime_evaluate(obj, fndef->expression, dest));
	obj->environment = obj->environment->parent;
	SUCCEED_RETURN(errctx);
    }

    /*
     * A multi-line subroutine. Hand control to its environment and let the
     * caller's step loop run it until RETURN pops back out. The result is the
     * value RETURN parked in the child environment.
     */
    obj->environment->gosubReturnLine = obj->environment->lineno + 1;
    obj->environment->nextline = fndef->lineno;
    while ( obj->environment != targetenv && obj->mode == AKBASIC_MODE_RUN ) {
	PASS(errctx, akbasic_runtime_process_line_run(obj));
    }
    *dest = &fndef->environment->returnValue;
    SUCCEED_RETURN(errctx);
}

/* ------------------------------------------------------------ line cycle -- */

int64_t akbasic_runtime_find_previous_lineno(akbasic_Runtime *obj)
{
    int64_t i = 0;

    for ( i = obj->environment->lineno - 1; i > 0; i-- ) {
	if ( obj->source[i].code[0] != '\0' ) {
	    return i;
	}
    }
    return obj->environment->lineno;
}

akerr_ErrorContext *akbasic_runtime_store_line(akbasic_Runtime *obj, int64_t lineno, const char *code)
{
    PREPARE_ERROR(errctx);

    FAIL_ZERO_RETURN(errctx, (lineno >= 0 && lineno < AKBASIC_MAX_SOURCE_LINES),
		     AKBASIC_ERR_BOUNDS,
		     "Line number %" PRId64 " is outside 0..%d",
		     lineno, AKBASIC_MAX_SOURCE_LINES - 1);
    FAIL_ZERO_RETURN(errctx, (strlen(code) < AKBASIC_MAX_LINE_LENGTH), AKBASIC_ERR_BOUNDS,
		     "Source line exceeds the %d character limit", AKBASIC_MAX_LINE_LENGTH - 1);
    strncpy(obj->source[lineno].code, code, AKBASIC_MAX_LINE_LENGTH - 1);
    obj->source[lineno].code[AKBASIC_MAX_LINE_LENGTH - 1] = '\0';
    obj->source[lineno].lineno = lineno;
    SUCCEED_RETURN(errctx);
}

akerr_ErrorContext *akbasic_runtime_process_line_runstream(akbasic_Runtime *obj)
{
    PREPARE_ERROR(errctx);
    char buffer[AKBASIC_MAX_LINE_LENGTH];
    char scanned[AKBASIC_MAX_LINE_LENGTH];
    bool eof = false;

    PASS(errctx, obj->sink->readline(obj->sink, buffer, sizeof(buffer), &eof));
    if ( eof ) {
	obj->environment->nextline = 0;
	PASS(errctx, akbasic_runtime_set_mode(obj, AKBASIC_MODE_RUN));
	SUCCEED_RETURN(errctx);
    }

    /*
     * All this mode does is pick the line number off the front and file the
     * source line under it. DLOAD reaches this from REPL mode, where the line
     * numbers must be stripped the same way the REPL strips them.
     */
    PASS(errctx, akbasic_scanner_scan(obj, buffer, scanned, sizeof(scanned)));
    if ( obj->mode == AKBASIC_MODE_REPL ) {
	PASS(errctx, akbasic_runtime_store_line(obj, obj->environment->lineno, scanned));
    } else {
	PASS(errctx, akbasic_runtime_store_line(obj, obj->environment->lineno, buffer));
    }
    SUCCEED_RETURN(errctx);
}

akerr_ErrorContext *akbasic_runtime_process_line_repl(akbasic_Runtime *obj)
{
    PREPARE_ERROR(errctx);
    char prompt[32];
    char scanned[AKBASIC_MAX_LINE_LENGTH];
    akbasic_ASTLeaf *leaf = NULL;
    akbasic_Value *value = NULL;
    akbasic_Parser parser;
    bool eof = false;

    if ( obj->autoLineNumber > 0 ) {
	snprintf(prompt, sizeof(prompt), "%" PRId64 " ",
		 obj->environment->lineno + obj->autoLineNumber);
	PASS(errctx, akbasic_runtime_write(obj, prompt));
    }

    PASS(errctx, obj->sink->readline(obj->sink, obj->userline, sizeof(obj->userline), &eof));
    if ( eof ) {
	obj->inputEof = true;
	PASS(errctx, akbasic_runtime_set_mode(obj, AKBASIC_MODE_QUIT));
	SUCCEED_RETURN(errctx);
    }
    if ( obj->userline[0] == '\0' ) {
	SUCCEED_RETURN(errctx);
    }

    obj->environment->lineno += obj->autoLineNumber;
    PASS(errctx, akbasic_scanner_scan(obj, obj->userline, scanned, sizeof(scanned)));
    PASS(errctx, akbasic_parser_init(&parser, obj));
    obj->skiprestofline = false;

    while ( !akbasic_parser_is_at_end(&parser) && !obj->skiprestofline ) {
	ATTEMPT {
	    CATCH(errctx, akbasic_parser_parse(&parser, &leaf));
	} CLEANUP {
	} PROCESS(errctx) {
	} HANDLE_DEFAULT(errctx) {
	    char message[AKERR_MAX_ERROR_CONTEXT_STRING_LENGTH];
	    snprintf(message, sizeof(message), "%s", errctx->message);
	    IGNORE(akbasic_runtime_error(obj, AKBASIC_ERRCLASS_PARSE, message));
	} FINISH(errctx, false);
	if ( obj->errclass != AKBASIC_ERRCLASS_NONE ) {
	    SUCCEED_RETURN(errctx);
	}

	if ( leaf == NULL ) {
	    /* Nothing but statement separators left; an empty statement is not one. */
	    continue;
	}

	PASS(errctx, akbasic_runtime_interpret_immediate(obj, leaf, &value));
	if ( value == NULL ) {
	    /* Not an immediate command, so it is program text: file it. */
	    PASS(errctx, akbasic_runtime_store_line(obj, obj->environment->lineno, scanned));
	} else if ( obj->autoLineNumber > 0 ) {
	    obj->environment->lineno = akbasic_runtime_find_previous_lineno(obj);
	}
    }
    SUCCEED_RETURN(errctx);
}

akerr_ErrorContext *akbasic_runtime_process_line_run(akbasic_Runtime *obj)
{
    PREPARE_ERROR(errctx);
    char line[AKBASIC_MAX_LINE_LENGTH];
    akbasic_ASTLeaf *leaf = NULL;
    akbasic_Value *value = NULL;
    akbasic_Parser parser;

    if ( obj->environment->nextline >= AKBASIC_MAX_SOURCE_LINES ) {
	PASS(errctx, akbasic_runtime_set_mode(obj, obj->run_finished_mode));
	SUCCEED_RETURN(errctx);
    }

    strncpy(line, obj->source[obj->environment->nextline].code, sizeof(line) - 1);
    line[sizeof(line) - 1] = '\0';
    obj->environment->lineno = obj->environment->nextline;
    obj->environment->nextline += 1;
    if ( line[0] == '\0' ) {
	SUCCEED_RETURN(errctx);
    }

    /*
     * TRON. Inline and with no newline, which is what a C128 prints: a traced
     * program's output reads `[10][20]HELLO`. Blank lines are skipped above, so
     * a trace shows only the lines that actually hold something.
     */
    if ( obj->trace ) {
	char tracemark[32];
	snprintf(tracemark, sizeof(tracemark), "[%" PRId64 "]", obj->environment->lineno);
	PASS(errctx, akbasic_runtime_write(obj, tracemark));
    }

    PASS(errctx, akbasic_scanner_scan(obj, line, NULL, 0));
    PASS(errctx, akbasic_parser_init(&parser, obj));
    obj->skiprestofline = false;

    while ( !akbasic_parser_is_at_end(&parser) && !obj->skiprestofline ) {
	ATTEMPT {
	    CATCH(errctx, akbasic_parser_parse(&parser, &leaf));
	} CLEANUP {
	} PROCESS(errctx) {
	} HANDLE_DEFAULT(errctx) {
	    char message[AKERR_MAX_ERROR_CONTEXT_STRING_LENGTH];
	    snprintf(message, sizeof(message), "%s", errctx->message);
	    IGNORE(akbasic_runtime_error(obj, AKBASIC_ERRCLASS_PARSE, message));
	    IGNORE(akbasic_runtime_set_mode(obj, obj->run_finished_mode));
	} FINISH(errctx, false);
	if ( obj->errclass != AKBASIC_ERRCLASS_NONE ) {
	    SUCCEED_RETURN(errctx);
	}
	if ( leaf == NULL ) {
	    /* Nothing but statement separators left; an empty statement is not one. */
	    continue;
	}

	/*
	 * The reference discards both results here. An error has already been
	 * reported to the sink by interpret(); swallowing the context keeps a
	 * BASIC-level error from tearing down the host, which is the whole point
	 * of goal 3.
	 */
	ATTEMPT {
	    CATCH(errctx, akbasic_runtime_interpret(obj, leaf, &value));
	} CLEANUP {
	} PROCESS(errctx) {
	} HANDLE_DEFAULT(errctx) {
	} FINISH(errctx, false);
	if ( obj->errclass != AKBASIC_ERRCLASS_NONE ) {
	    SUCCEED_RETURN(errctx);
	}
    }
    SUCCEED_RETURN(errctx);
}

/* ------------------------------------------------------------- step loop -- */

akerr_ErrorContext *akbasic_runtime_start(akbasic_Runtime *obj, int mode)
{
    PREPARE_ERROR(errctx);

    FAIL_ZERO_RETURN(errctx, (obj != NULL), AKERR_NULLPOINTER, "NULL runtime in start");
    obj->run_finished_mode = (mode == AKBASIC_MODE_REPL ? AKBASIC_MODE_REPL : AKBASIC_MODE_QUIT);
    PASS(errctx, akbasic_runtime_set_mode(obj, mode));
    SUCCEED_RETURN(errctx);
}

akerr_ErrorContext *akbasic_runtime_load(akbasic_Runtime *obj, const char *source)
{
    PREPARE_ERROR(errctx);
    char line[AKBASIC_MAX_LINE_LENGTH];
    char scanned[AKBASIC_MAX_LINE_LENGTH];
    const char *cursor = NULL;
    const char *eol = NULL;
    size_t length = 0;

    FAIL_ZERO_RETURN(errctx, (obj != NULL), AKERR_NULLPOINTER, "NULL runtime in load");
    FAIL_ZERO_RETURN(errctx, (source != NULL), AKERR_NULLPOINTER, "NULL source in load");

    for ( cursor = source; *cursor != '\0'; cursor = (*eol == '\0' ? eol : eol + 1) ) {
	eol = strchr(cursor, '\n');
	if ( eol == NULL ) {
	    eol = cursor + strlen(cursor);
	}
	length = (size_t)(eol - cursor);
	if ( length > 0 && cursor[length - 1] == '\r' ) {
	    length -= 1;
	}
	FAIL_ZERO_RETURN(errctx, (length < sizeof(line)), AKBASIC_ERR_BOUNDS,
			 "Source line of %zu characters exceeds the %d character limit",
			 length, AKBASIC_MAX_LINE_LENGTH - 1);
	memcpy(line, cursor, length);
	line[length] = '\0';
	if ( line[0] == '\0' ) {
	    continue;
	}
	/*
	 * Scanning is what picks the line number off the front and rewrites the
	 * line to what follows it -- the same path RUNSTREAM takes, so a program
	 * loaded from memory and one read from a file are filed identically.
	 */
	PASS(errctx, akbasic_runtime_zero(obj));
	PASS(errctx, akbasic_scanner_zero(obj));
	PASS(errctx, akbasic_scanner_scan(obj, line, scanned, sizeof(scanned)));
	PASS(errctx, akbasic_runtime_store_line(obj, obj->environment->lineno, scanned));
    }
    obj->environment->nextline = 0;
    SUCCEED_RETURN(errctx);
}

akerr_ErrorContext *akbasic_runtime_step(akbasic_Runtime *obj)
{
    PREPARE_ERROR(errctx);
    bool blocked = false;

    FAIL_ZERO_RETURN(errctx, (obj != NULL), AKERR_NULLPOINTER, "NULL runtime in step");

    /*
     * Release the next queued note if its predecessor's time is up. PLAY does not
     * block -- section 1.6 forbids it -- so this is what paces a tune, and it
     * runs before the QUIT check so a program's last notes still come out while
     * a host keeps calling step().
     */
    PASS(errctx, akbasic_play_service(obj));

    if ( obj->mode == AKBASIC_MODE_QUIT ) {
	SUCCEED_RETURN(errctx);
    }

    /*
     * A GETKEY with nothing typed yet holds the program here. The step still
     * returns -- a host keeps its frame rate and a bounded run() still comes
     * back -- it simply does not advance, which is what GETKEY means. The note
     * queue above is serviced first on purpose: music should keep playing while
     * a program waits for a keypress.
     */
    PASS(errctx, akbasic_input_service(obj, &blocked));
    if ( blocked ) {
	SUCCEED_RETURN(errctx);
    }

    PASS(errctx, akbasic_runtime_zero(obj));
    PASS(errctx, akbasic_scanner_zero(obj));

    switch ( obj->mode ) {
    case AKBASIC_MODE_RUNSTREAM:
	PASS(errctx, akbasic_runtime_process_line_runstream(obj));
	break;
    case AKBASIC_MODE_REPL:
	PASS(errctx, akbasic_runtime_process_line_repl(obj));
	break;
    case AKBASIC_MODE_RUN:
	PASS(errctx, akbasic_runtime_process_line_run(obj));
	break;
    default:
	break;
    }

    /*
     * The reference never clears runtime.errno, so the first BASIC-level error
     * ends the program: in a file run, run_finished_mode is QUIT. Reproduced
     * deliberately -- tests/language/array_outofbounds.txt depends on exactly one
     * error line being printed and nothing after it.
     *
     * The clear on the way back to the REPL is *not* the reference's, and it is
     * a fix rather than a deviation. A sticky errclass with run_finished_mode
     * REPL means every later step re-enters REPL mode and prints READY again --
     * so an interactive session that hits one runtime error and then reaches end
     * of input spins forever printing READY instead of quitting, because the
     * QUIT that process_line_repl() set on EOF is overwritten right here. A
     * fresh prompt is a fresh statement; the error has been reported and acted
     * on and there is nothing left for it to do.
     */
    if ( obj->errclass != AKBASIC_ERRCLASS_NONE ) {
	PASS(errctx, akbasic_runtime_set_mode(obj, obj->run_finished_mode));
	if ( obj->mode == AKBASIC_MODE_REPL ) {
	    obj->errclass = AKBASIC_ERRCLASS_NONE;
	}
    }
    SUCCEED_RETURN(errctx);
}

akerr_ErrorContext *akbasic_runtime_run(akbasic_Runtime *obj, int maxsteps)
{
    PREPARE_ERROR(errctx);
    int steps = 0;

    FAIL_ZERO_RETURN(errctx, (obj != NULL), AKERR_NULLPOINTER, "NULL runtime in run");
    while ( obj->mode != AKBASIC_MODE_QUIT ) {
	PASS(errctx, akbasic_runtime_step(obj));
	steps += 1;
	if ( maxsteps > 0 && steps >= maxsteps ) {
	    break;
	}
    }
    SUCCEED_RETURN(errctx);
}