akbasic/src/runtime_commands.c

/**
 * @file runtime_commands.c
 * @brief The verb implementations.
 *
 * Ported from basicruntime_commands.go. Every handler has the signature the
 * dispatch table demands, and every one returns its result through `dest`.
 */

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

#include <akerror.h>
#include <akstdlib.h>

#include <akbasic/error.h>
#include <akbasic/runtime.h>
#include <akbasic/convert.h>
#include <akbasic/scanner.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 )

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

    (void)expr; (void)lval; (void)rval;
    /*
     * LET is not required in this dialect or in Commodore BASIC 7.0. Assignment
     * is part of expression evaluation, so there is nothing for LET to do.
     */
    SUCCEED_TRUE(obj, dest);
    SUCCEED_RETURN(errctx);
}

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

    (void)expr; (void)lval; (void)rval;
    /* The parse handler already installed the function. */
    SUCCEED_TRUE(obj, dest);
    SUCCEED_RETURN(errctx);
}

akerr_ErrorContext *akbasic_cmd_print(akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest)
{
    PREPARE_ERROR(errctx);
    char rendered[AKBASIC_MAX_STRING_LENGTH];

    (void)lval; (void)rval;
    FAIL_ZERO_RETURN(errctx, (expr != NULL), AKERR_NULLPOINTER, "NIL leaf");
    if ( expr->right == NULL ) {
	PASS(errctx, akbasic_runtime_println(obj, ""));
	SUCCEED_TRUE(obj, dest);
	SUCCEED_RETURN(errctx);
    }
    PASS(errctx, akbasic_runtime_evaluate(obj, expr->right, dest));
    PASS(errctx, akbasic_value_to_string(*dest, rendered, sizeof(rendered)));
    PASS(errctx, akbasic_runtime_println(obj, rendered));
    SUCCEED_TRUE(obj, dest);
    SUCCEED_RETURN(errctx);
}

akerr_ErrorContext *akbasic_cmd_goto(akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest)
{
    PREPARE_ERROR(errctx);
    akbasic_Value *target = NULL;

    (void)lval; (void)rval;
    FAIL_ZERO_RETURN(errctx, (expr != NULL && expr->right != NULL), AKERR_NULLPOINTER,
		     "Expected GOTO (line number or label)");
    PASS(errctx, akbasic_runtime_evaluate(obj, expr->right, &target));
    FAIL_NONZERO_RETURN(errctx, (target->valuetype != AKBASIC_TYPE_INTEGER), AKBASIC_ERR_TYPE,
			"Expected integer");
    obj->environment->nextline = target->intval;
    SUCCEED_TRUE(obj, dest);
    SUCCEED_RETURN(errctx);
}

akerr_ErrorContext *akbasic_cmd_gosub(akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest)
{
    PREPARE_ERROR(errctx);
    akbasic_Value *target = NULL;
    int64_t returnline = 0;

    (void)lval; (void)rval;
    FAIL_ZERO_RETURN(errctx, (expr != NULL && expr->right != NULL), AKERR_NULLPOINTER,
		     "Expected GOSUB (line number or label)");
    PASS(errctx, akbasic_runtime_evaluate(obj, expr->right, &target));
    FAIL_NONZERO_RETURN(errctx, (target->valuetype != AKBASIC_TYPE_INTEGER), AKBASIC_ERR_TYPE,
			"Expected integer");
    returnline = obj->environment->lineno + 1;
    PASS(errctx, akbasic_runtime_new_environment(obj));
    obj->environment->gosubReturnLine = returnline;
    obj->environment->nextline = target->intval;
    SUCCEED_TRUE(obj, dest);
    SUCCEED_RETURN(errctx);
}

akerr_ErrorContext *akbasic_cmd_return(akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest)
{
    PREPARE_ERROR(errctx);
    akbasic_Value *result = NULL;

    (void)lval; (void)rval;
    /*
     * A RETURN reached while skipping forward to one is the end of a DEF body,
     * not a subroutine return. Stop waiting and carry on.
     */
    if ( akbasic_environment_is_waiting_for(obj->environment, "RETURN") ) {
	PASS(errctx, akbasic_environment_stop_waiting(obj->environment, "RETURN"));
	SUCCEED_TRUE(obj, dest);
	SUCCEED_RETURN(errctx);
    }
    FAIL_ZERO_RETURN(errctx, (obj->environment->gosubReturnLine != 0), AKBASIC_ERR_STATE,
		     "RETURN outside the context of GOSUB");

    if ( expr != NULL && expr->right != NULL ) {
	PASS(errctx, akbasic_runtime_evaluate(obj, expr->right, &result));
    } else {
	result = &obj->staticTrueValue;
    }
    FAIL_ZERO_RETURN(errctx, (obj->environment->parent != NULL), AKBASIC_ERR_ENVIRONMENT,
		     "RETURN from an orphaned environment");
    obj->environment->parent->nextline = obj->environment->gosubReturnLine;
    PASS(errctx, akbasic_value_clone(result, &obj->environment->returnValue));
    PASS(errctx, akbasic_runtime_prev_environment(obj));
    *dest = result;
    SUCCEED_RETURN(errctx);
}

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

    (void)expr; (void)lval; (void)rval;
    PASS(errctx, akbasic_runtime_set_mode(obj, AKBASIC_MODE_REPL));
    SUCCEED_TRUE(obj, dest);
    SUCCEED_RETURN(errctx);
}

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

    (void)expr; (void)lval; (void)rval;
    /*
     * Sets a mode and returns. Nothing in this library calls exit() -- the
     * driver's main() decides what quitting means, and an embedding game may
     * decide it means something else entirely.
     */
    PASS(errctx, akbasic_runtime_set_mode(obj, AKBASIC_MODE_QUIT));
    SUCCEED_TRUE(obj, dest);
    SUCCEED_RETURN(errctx);
}

akerr_ErrorContext *akbasic_cmd_run(akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest)
{
    PREPARE_ERROR(errctx);
    akbasic_Value *target = NULL;

    (void)lval; (void)rval;
    obj->environment->nextline = 0;
    if ( expr != NULL && expr->right != NULL ) {
	PASS(errctx, akbasic_runtime_evaluate(obj, expr->right, &target));
	FAIL_NONZERO_RETURN(errctx, (target->valuetype != AKBASIC_TYPE_INTEGER), AKBASIC_ERR_TYPE,
			    "Expected RUN (line number)");
	obj->environment->nextline = target->intval;
    }
    PASS(errctx, akbasic_runtime_set_mode(obj, AKBASIC_MODE_RUN));
    SUCCEED_TRUE(obj, dest);
    SUCCEED_RETURN(errctx);
}

akerr_ErrorContext *akbasic_cmd_label(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, (expr != NULL && expr->right != NULL), AKERR_NULLPOINTER,
		     "Expected LABEL IDENTIFIER");
    FAIL_ZERO_RETURN(errctx, akbasic_leaf_is_identifier(expr->right), AKBASIC_ERR_SYNTAX,
		     "Expected identifier");
    PASS(errctx, akbasic_environment_set_label(obj->environment, expr->right->identifier,
					       obj->environment->lineno));
    SUCCEED_TRUE(obj, dest);
    SUCCEED_RETURN(errctx);
}

akerr_ErrorContext *akbasic_cmd_auto(akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest)
{
    PREPARE_ERROR(errctx);
    akbasic_Value *step = NULL;

    (void)lval; (void)rval;
    if ( expr == NULL || expr->right == NULL ) {
	obj->autoLineNumber = 0;
	SUCCEED_TRUE(obj, dest);
	SUCCEED_RETURN(errctx);
    }
    PASS(errctx, akbasic_runtime_evaluate(obj, expr->right, &step));
    FAIL_NONZERO_RETURN(errctx, (step->valuetype != AKBASIC_TYPE_INTEGER), AKBASIC_ERR_TYPE,
			"Expected AUTO (integer)");
    obj->autoLineNumber = step->intval;
    SUCCEED_TRUE(obj, dest);
    SUCCEED_RETURN(errctx);
}

akerr_ErrorContext *akbasic_cmd_dim(akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest)
{
    PREPARE_ERROR(errctx);
    akbasic_Variable *variable = NULL;
    akbasic_ASTLeaf *walk = NULL;
    akbasic_Value *size = NULL;
    int64_t sizes[AKBASIC_MAX_ARRAY_DEPTH];
    int sizecount = 0;

    (void)lval; (void)rval;
    FAIL_ZERO_RETURN(errctx,
		     (expr != NULL && expr->right != NULL && expr->right->right != NULL &&
		      expr->right->right->leaftype == AKBASIC_LEAF_ARGUMENTLIST &&
		      expr->right->right->operator_ == AKBASIC_TOK_ARRAY_SUBSCRIPT &&
		      akbasic_leaf_is_identifier(expr->right)),
		     AKBASIC_ERR_SYNTAX, "Expected DIM IDENTIFIER(DIMENSIONS, ...)");

    PASS(errctx, akbasic_environment_get(obj->environment, expr->right->identifier, &variable));
    FAIL_ZERO_RETURN(errctx, (variable != NULL), AKBASIC_ERR_UNDEFINED,
		     "Unable to get variable for identifier %s", expr->right->identifier);

    for ( walk = expr->right->right->right; walk != NULL; walk = walk->right ) {
	FAIL_ZERO_RETURN(errctx, (sizecount < AKBASIC_MAX_ARRAY_DEPTH), AKBASIC_ERR_BOUNDS,
			 "More than %d array dimensions", AKBASIC_MAX_ARRAY_DEPTH);
	PASS(errctx, akbasic_runtime_evaluate(obj, walk, &size));
	FAIL_NONZERO_RETURN(errctx, (size->valuetype != AKBASIC_TYPE_INTEGER), AKBASIC_ERR_TYPE,
			    "Array dimensions must evaluate to integer");
	sizes[sizecount] = size->intval;
	sizecount += 1;
    }
    PASS(errctx, akbasic_variable_init(variable, &obj->valuepool, sizes, sizecount));
    PASS(errctx, akbasic_variable_zero(variable));
    SUCCEED_TRUE(obj, dest);
    SUCCEED_RETURN(errctx);
}

/*
 * POKE and PEEK write and read a single byte at a caller-supplied address.
 *
 * The pointer.bas golden case sets A# = 255 and expects PEEK(POINTER(A#)) to be
 * 255, which holds only on a little-endian machine: A# is an int64_t and the
 * low byte has to come first. Stated here rather than discovered later.
 */
akerr_ErrorContext *akbasic_cmd_poke(akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest)
{
    PREPARE_ERROR(errctx);
    akbasic_ASTLeaf *arg = NULL;
    akbasic_Value *addrval = NULL;
    akbasic_Value *byteval = NULL;
    uint8_t *target = NULL;

    (void)lval; (void)rval;
    FAIL_ZERO_RETURN(errctx, (expr != NULL), AKERR_NULLPOINTER, "NIL leaf");
    arg = akbasic_leaf_first_argument(expr);
    FAIL_ZERO_RETURN(errctx, (arg != NULL), AKBASIC_ERR_SYNTAX, "POKE expected INTEGER, INTEGER");

    /* The address must be the live value, not a copy of it. */
    obj->eval_clone_identifiers = false;
    ATTEMPT {
	CATCH(errctx, akbasic_runtime_evaluate(obj, arg, &addrval));
    } CLEANUP {
	obj->eval_clone_identifiers = true;
    } PROCESS(errctx) {
    } FINISH(errctx, true);

    FAIL_NONZERO_RETURN(errctx, (addrval->valuetype != AKBASIC_TYPE_INTEGER), AKBASIC_ERR_TYPE,
			"POKE expected INTEGER, INTEGER");
    FAIL_ZERO_RETURN(errctx,
		     (arg->right != NULL &&
		      (arg->right->leaftype == AKBASIC_LEAF_LITERAL_INT ||
		       arg->right->leaftype == AKBASIC_LEAF_IDENTIFIER_INT)),
		     AKBASIC_ERR_SYNTAX, "POKE expected INTEGER, INTEGER");
    FAIL_ZERO_RETURN(errctx, (addrval->intval != 0), AKBASIC_ERR_VALUE,
		     "POKE got NIL pointer or uninitialized variable");

    PASS(errctx, akbasic_runtime_evaluate(obj, arg->right, &byteval));
    target = (uint8_t *)(uintptr_t)addrval->intval;
    *target = (uint8_t)byteval->intval;
    SUCCEED_TRUE(obj, dest);
    SUCCEED_RETURN(errctx);
}

akerr_ErrorContext *akbasic_cmd_input(akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest)
{
    PREPARE_ERROR(errctx);
    akbasic_ASTLeaf *identifier = NULL;
    akbasic_Value *prompt = NULL;
    akbasic_Value *entered = NULL;
    akbasic_Value *unused = NULL;
    char rendered[AKBASIC_MAX_STRING_LENGTH];
    char buffer[AKBASIC_MAX_LINE_LENGTH];
    bool eof = false;

    (void)lval; (void)rval;
    FAIL_ZERO_RETURN(errctx, (expr != NULL && expr->right != NULL), AKERR_NULLPOINTER,
		     "Expected INPUT \"PROMPT\" IDENTIFIER");
    identifier = expr->right;

    if ( identifier->left != NULL ) {
	PASS(errctx, akbasic_runtime_evaluate(obj, identifier->left, &prompt));
	PASS(errctx, akbasic_value_to_string(prompt, rendered, sizeof(rendered)));
	PASS(errctx, akbasic_runtime_write(obj, rendered));
    }

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

    PASS(errctx, akbasic_environment_new_value(obj->environment, &entered));
    PASS(errctx, akbasic_value_zero(entered));

    switch ( identifier->leaftype ) {
    case AKBASIC_LEAF_IDENTIFIER_INT:
	entered->valuetype = AKBASIC_TYPE_INTEGER;
	PASS(errctx, akbasic_str_to_int64(buffer, 10, &entered->intval));
	break;
    case AKBASIC_LEAF_IDENTIFIER_FLOAT:
	entered->valuetype = AKBASIC_TYPE_FLOAT;
	PASS(errctx, akbasic_str_to_double(buffer, &entered->floatval));
	break;
    default:
	entered->valuetype = AKBASIC_TYPE_STRING;
	FAIL_ZERO_RETURN(errctx, (strlen(buffer) < AKBASIC_MAX_STRING_LENGTH), AKBASIC_ERR_VALUE,
			 "Input line exceeds the %d character limit", AKBASIC_MAX_STRING_LENGTH - 1);
	strncpy(entered->stringval, buffer, AKBASIC_MAX_STRING_LENGTH - 1);
	entered->stringval[AKBASIC_MAX_STRING_LENGTH - 1] = '\0';
	break;
    }
    PASS(errctx, akbasic_environment_assign(obj->environment, identifier, entered, &unused));
    SUCCEED_TRUE(obj, dest);
    SUCCEED_RETURN(errctx);
}

/* LIST and DELETE share the range grammar: bare, n, -n, or n-n. */
static akerr_ErrorContext *parse_line_range(akbasic_Runtime *obj, akbasic_ASTLeaf *expr, int64_t *startidx, int64_t *endidx)
{
    PREPARE_ERROR(errctx);
    akbasic_Value *value = NULL;

    *startidx = 0;
    *endidx = AKBASIC_MAX_SOURCE_LINES - 1;
    if ( expr == NULL || expr->right == NULL ) {
	SUCCEED_RETURN(errctx);
    }

    if ( expr->right->leaftype == AKBASIC_LEAF_BINARY &&
	 expr->right->operator_ == AKBASIC_TOK_MINUS ) {
	/* n-n: a subtraction leaf is how the expression parser sees a range. */
	PASS(errctx, akbasic_runtime_evaluate(obj, expr->right->left, &value));
	FAIL_NONZERO_RETURN(errctx, (value->valuetype != AKBASIC_TYPE_INTEGER), AKBASIC_ERR_TYPE,
			    "Expected a line number range");
	*startidx = value->intval;
	PASS(errctx, akbasic_runtime_evaluate(obj, expr->right->right, &value));
	FAIL_NONZERO_RETURN(errctx, (value->valuetype != AKBASIC_TYPE_INTEGER), AKBASIC_ERR_TYPE,
			    "Expected a line number range");
	*endidx = value->intval;
	SUCCEED_RETURN(errctx);
    }
    if ( expr->right->leaftype == AKBASIC_LEAF_UNARY &&
	 expr->right->operator_ == AKBASIC_TOK_MINUS ) {
	/* -n: from the start through n. */
	PASS(errctx, akbasic_runtime_evaluate(obj, expr->right->right, &value));
	FAIL_NONZERO_RETURN(errctx, (value->valuetype != AKBASIC_TYPE_INTEGER), AKBASIC_ERR_TYPE,
			    "Expected a line number range");
	*endidx = value->intval;
	SUCCEED_RETURN(errctx);
    }
    /* n: from n to the end. */
    PASS(errctx, akbasic_runtime_evaluate(obj, expr->right, &value));
    FAIL_NONZERO_RETURN(errctx, (value->valuetype != AKBASIC_TYPE_INTEGER), AKBASIC_ERR_TYPE,
			"Expected a line number range");
    *startidx = value->intval;
    SUCCEED_RETURN(errctx);
}

akerr_ErrorContext *akbasic_cmd_list(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];
    int64_t startidx = 0;
    int64_t endidx = 0;
    int64_t i = 0;

    (void)lval; (void)rval;
    PASS(errctx, parse_line_range(obj, expr, &startidx, &endidx));
    if ( startidx < 0 ) {
	startidx = 0;
    }
    if ( endidx >= AKBASIC_MAX_SOURCE_LINES ) {
	endidx = AKBASIC_MAX_SOURCE_LINES - 1;
    }
    for ( i = startidx; i <= endidx; i++ ) {
	if ( obj->source[i].code[0] == '\0' ) {
	    continue;
	}
	snprintf(line, sizeof(line), "%" PRId64 " %s", i, obj->source[i].code);
	PASS(errctx, akbasic_runtime_println(obj, line));
    }
    SUCCEED_TRUE(obj, dest);
    SUCCEED_RETURN(errctx);
}

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

    (void)lval; (void)rval;
    PASS(errctx, parse_line_range(obj, expr, &startidx, &endidx));
    if ( startidx < 0 ) {
	startidx = 0;
    }
    if ( endidx >= AKBASIC_MAX_SOURCE_LINES ) {
	endidx = AKBASIC_MAX_SOURCE_LINES - 1;
    }
    for ( i = startidx; i <= endidx; i++ ) {
	obj->source[i].code[0] = '\0';
	obj->source[i].lineno = 0;
    }
    SUCCEED_TRUE(obj, dest);
    SUCCEED_RETURN(errctx);
}

/* Resolve a DLOAD/DSAVE filename argument to a string. */
static akerr_ErrorContext *filename_argument(akbasic_Runtime *obj, akbasic_ASTLeaf *expr, char *dest, size_t len)
{
    PREPARE_ERROR(errctx);
    akbasic_Value *value = NULL;

    FAIL_ZERO_RETURN(errctx, (expr != NULL && expr->right != NULL), AKBASIC_ERR_SYNTAX,
		     "Expected a filename");
    PASS(errctx, akbasic_runtime_evaluate(obj, expr->right, &value));
    FAIL_NONZERO_RETURN(errctx, (value->valuetype != AKBASIC_TYPE_STRING), AKBASIC_ERR_TYPE,
			"Expected a filename string");
    FAIL_ZERO_RETURN(errctx, (value->stringval[0] != '\0'), AKBASIC_ERR_VALUE,
		     "Filename must not be empty");
    FAIL_ZERO_RETURN(errctx, (strlen(value->stringval) < len), AKBASIC_ERR_BOUNDS,
		     "Filename exceeds the %zu character limit", len - 1);
    strncpy(dest, value->stringval, len - 1);
    dest[len - 1] = '\0';
    SUCCEED_RETURN(errctx);
}

akerr_ErrorContext *akbasic_cmd_dload(akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest)
{
    PREPARE_ERROR(errctx);
    char filename[AKBASIC_MAX_STRING_LENGTH];
    char buffer[AKBASIC_MAX_LINE_LENGTH];
    char scanned[AKBASIC_MAX_LINE_LENGTH];
    FILE *fp = NULL;
    size_t used = 0;
    int64_t i = 0;

    (void)lval; (void)rval;
    /*
     * aksl_fopen does not NULL-check pathname or mode and fopen(NULL, ...) is
     * undefined, so the name is validated here before it is handed over --
     * deps/libakstdlib/TODO.md 2.2.2.
     */
    PASS(errctx, filename_argument(obj, expr, filename, sizeof(filename)));

    /* DLOAD replaces the program in memory, so clear it before reading. */
    for ( i = 0; i < AKBASIC_MAX_SOURCE_LINES; i++ ) {
	obj->source[i].code[0] = '\0';
	obj->source[i].lineno = 0;
    }
    obj->environment->lineno = 0;
    obj->environment->nextline = 0;

    ATTEMPT {
	CATCH(errctx, aksl_fopen(filename, "r", &fp));
	while ( fgets(buffer, sizeof(buffer), fp) != NULL ) {
	    used = strlen(buffer);
	    while ( used > 0 && (buffer[used - 1] == '\n' || buffer[used - 1] == '\r') ) {
		buffer[used - 1] = '\0';
		used -= 1;
	    }
	    if ( buffer[0] == '\0' ) {
		continue;
	    }
	    /*
	     * PASS inside the loop, never CATCH: CATCH expands to a break, which
	     * would leave this loop rather than the ATTEMPT and let the rest of
	     * the block run with an error pending.
	     */
	    PASS(errctx, akbasic_scanner_scan(obj, buffer, scanned, sizeof(scanned)));
	    PASS(errctx, akbasic_runtime_store_line(obj, obj->environment->lineno, scanned));
	}
    } CLEANUP {
	if ( fp != NULL ) {
	    IGNORE(aksl_fclose(fp));
	}
    } PROCESS(errctx) {
    } FINISH(errctx, true);

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

akerr_ErrorContext *akbasic_cmd_dsave(akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest)
{
    PREPARE_ERROR(errctx);
    char filename[AKBASIC_MAX_STRING_LENGTH];
    char line[AKBASIC_MAX_LINE_LENGTH * 2];
    FILE *fp = NULL;
    int64_t i = 0;
    int count = 0;

    (void)lval; (void)rval;
    PASS(errctx, filename_argument(obj, expr, filename, sizeof(filename)));

    ATTEMPT {
	CATCH(errctx, aksl_fopen(filename, "w", &fp));
	for ( i = 0; i < AKBASIC_MAX_SOURCE_LINES; i++ ) {
	    if ( obj->source[i].code[0] == '\0' ) {
		continue;
	    }
	    snprintf(line, sizeof(line), "%" PRId64 " %s\n", i, obj->source[i].code);
	    PASS(errctx, aksl_fwrite(line, 1, strlen(line), fp));
	    count += 1;
	}
    } CLEANUP {
	if ( fp != NULL ) {
	    IGNORE(aksl_fclose(fp));
	}
    } PROCESS(errctx) {
    } FINISH(errctx, true);

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

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

    (void)obj; (void)expr; (void)lval; (void)rval; (void)dest;
    /*
     * Unreachable in practice: the IF parse handler produces a BRANCH leaf, and
     * evaluate() handles BRANCH directly. It exists so the table has an exec
     * handler for IF and a stray IF leaf produces a diagnosis rather than
     * "Unknown command".
     */
    FAIL_RETURN(errctx, AKBASIC_ERR_STATE, "Malformed IF statement");
}

/*
 * The loop condition, evaluated at the bottom of the structure. A negative step
 * means the loop runs while the counter is at or above the TO value; a positive
 * one, at or below. True means the loop is finished.
 */
static akerr_ErrorContext *evaluate_for_condition(akbasic_Runtime *obj, akbasic_Value *counter, bool *met)
{
    PREPARE_ERROR(errctx);
    akbasic_Value zero;
    akbasic_Value scratch;
    akbasic_Value *truth = NULL;

    FAIL_ZERO_RETURN(errctx, (counter != NULL), AKERR_NULLPOINTER, "NIL pointer for rval");
    PASS(errctx, akbasic_value_zero(&zero));
    zero.valuetype = AKBASIC_TYPE_INTEGER;
    zero.intval = 0;

    PASS(errctx, akbasic_value_less_than(&obj->environment->forStepValue, &zero, &scratch, &truth));
    if ( akbasic_value_is_true(truth) ) {
	PASS(errctx, akbasic_value_greater_than_equal(&obj->environment->forToValue, counter,
						      &scratch, &truth));
    } else {
	PASS(errctx, akbasic_value_less_than_equal(&obj->environment->forToValue, counter,
						   &scratch, &truth));
    }
    *met = akbasic_value_is_true(truth);
    SUCCEED_RETURN(errctx);
}

akerr_ErrorContext *akbasic_cmd_for(akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest)
{
    PREPARE_ERROR(errctx);
    akbasic_Value *assignval = NULL;
    akbasic_Value *tmp = NULL;
    akbasic_Value *counter = NULL;
    int64_t zerosubscript[1] = { 0 };
    bool met = false;

    (void)lval; (void)rval;
    FAIL_ZERO_RETURN(errctx, (obj->environment->forToLeaf != NULL && expr != NULL && expr->right != NULL),
		     AKBASIC_ERR_STATE, "Expected FOR ... TO [STEP ...]");
    FAIL_ZERO_RETURN(errctx,
		     (expr->right->left != NULL &&
		      (expr->right->left->leaftype == AKBASIC_LEAF_IDENTIFIER_INT ||
		       expr->right->left->leaftype == AKBASIC_LEAF_IDENTIFIER_FLOAT ||
		       expr->right->left->leaftype == AKBASIC_LEAF_IDENTIFIER_STRING)),
		     AKBASIC_ERR_SYNTAX, "Expected variable in FOR loop");

    PASS(errctx, akbasic_runtime_evaluate(obj, expr->right, &assignval));
    PASS(errctx, akbasic_environment_get(obj->environment, expr->right->left->identifier,
					 &obj->environment->forNextVariable));
    FAIL_ZERO_RETURN(errctx, (obj->environment->forNextVariable != NULL), AKBASIC_ERR_UNDEFINED,
		     "Unable to get loop variable %s", expr->right->left->identifier);
    PASS(errctx, akbasic_variable_set_subscript(obj->environment->forNextVariable, assignval,
						zerosubscript, 1));

    PASS(errctx, akbasic_runtime_evaluate(obj, obj->environment->forToLeaf, &tmp));
    PASS(errctx, akbasic_value_clone(tmp, &obj->environment->forToValue));
    PASS(errctx, akbasic_runtime_evaluate(obj, obj->environment->forStepLeaf, &tmp));
    PASS(errctx, akbasic_value_clone(tmp, &obj->environment->forStepValue));
    obj->environment->forToLeaf = NULL;
    obj->environment->forStepLeaf = NULL;

    PASS(errctx, akbasic_variable_get_subscript(obj->environment->forNextVariable,
						zerosubscript, 1, &counter));
    PASS(errctx, evaluate_for_condition(obj, counter, &met));
    if ( met ) {
	/* Zero iterations: skip the body entirely by waiting for the NEXT. */
	PASS(errctx, akbasic_environment_wait_for_command(obj->environment, "NEXT"));
    }
    SUCCEED_TRUE(obj, dest);
    SUCCEED_RETURN(errctx);
}

akerr_ErrorContext *akbasic_cmd_next(akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest)
{
    PREPARE_ERROR(errctx);
    akbasic_Variable *nextvar = NULL;
    akbasic_Value *counter = NULL;
    akbasic_Value *updated = NULL;
    akbasic_Value scratch;
    int64_t zerosubscript[1] = { 0 };
    bool met = false;

    (void)lval; (void)rval;
    FAIL_ZERO_RETURN(errctx, (obj->environment->forNextVariable != NULL), AKBASIC_ERR_STATE,
		     "NEXT outside the context of FOR");
    FAIL_ZERO_RETURN(errctx, (expr != NULL && expr->right != NULL), AKBASIC_ERR_SYNTAX,
		     "Expected NEXT IDENTIFIER");
    FAIL_ZERO_RETURN(errctx,
		     (expr->right->leaftype == AKBASIC_LEAF_IDENTIFIER_INT ||
		      expr->right->leaftype == AKBASIC_LEAF_IDENTIFIER_FLOAT),
		     AKBASIC_ERR_TYPE, "FOR ... NEXT only valid over INT and FLOAT types");

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

    /*
     * A NEXT for someone else's loop variable: this environment is done, hand
     * the line back to the parent and pop. That is how nested loops unwind.
     */
    if ( strcmp(expr->right->identifier, obj->environment->forNextVariable->name) != 0 ) {
	FAIL_ZERO_RETURN(errctx, (obj->environment->parent != NULL), AKBASIC_ERR_ENVIRONMENT,
			 "NEXT in an orphaned environment");
	obj->environment->parent->nextline = obj->environment->nextline;
	PASS(errctx, akbasic_runtime_prev_environment(obj));
	*dest = &obj->staticFalseValue;
	SUCCEED_RETURN(errctx);
    }

    PASS(errctx, akbasic_environment_get(obj->environment, expr->right->identifier, &nextvar));
    FAIL_ZERO_RETURN(errctx, (nextvar != NULL), AKBASIC_ERR_UNDEFINED,
		     "Unable to get loop variable %s", expr->right->identifier);
    PASS(errctx, akbasic_variable_get_subscript(nextvar, zerosubscript, 1, &counter));
    PASS(errctx, evaluate_for_condition(obj, counter, &met));
    PASS(errctx, akbasic_environment_stop_waiting(obj->environment, "NEXT"));

    if ( met ) {
	if ( obj->environment->parent != NULL ) {
	    obj->environment->parent->nextline = obj->environment->nextline;
	    PASS(errctx, akbasic_runtime_prev_environment(obj));
	}
	SUCCEED_TRUE(obj, dest);
	SUCCEED_RETURN(errctx);
    }

    /*
     * Advance the counter. The stored value is mutable, so math_plus updates it
     * in place -- see TODO.md section 12 item 4. Changing that without changing
     * this breaks every FOR loop.
     */
    PASS(errctx, akbasic_value_math_plus(counter, &obj->environment->forStepValue,
					 &scratch, &updated));
    obj->environment->nextline = obj->environment->loopFirstLine;
    SUCCEED_TRUE(obj, dest);
    SUCCEED_RETURN(errctx);
}

akerr_ErrorContext *akbasic_cmd_exit(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_NONZERO_RETURN(errctx,
			(obj->environment->forToValue.valuetype == AKBASIC_TYPE_UNDEFINED),
			AKBASIC_ERR_STATE, "EXIT outside the context of FOR");
    FAIL_ZERO_RETURN(errctx, (obj->environment->parent != NULL), AKBASIC_ERR_ENVIRONMENT,
		     "EXIT in an orphaned environment");
    obj->environment->parent->nextline = obj->environment->loopExitLine;
    /*
     * The reference pops without clearing the wait, which leaves the parent
     * waiting for a NEXT that will never arrive (TODO.md section 12 item 8). The
     * wait is cleared here first: leaving it set would hang the interpreter
     * rather than merely misbehave, and no golden case depends on the hang.
     */
    PASS(errctx, akbasic_environment_stop_waiting(obj->environment, "NEXT"));
    PASS(errctx, akbasic_runtime_prev_environment(obj));
    SUCCEED_TRUE(obj, dest);
    SUCCEED_RETURN(errctx);
}

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

    (void)expr; (void)lval; (void)rval;
    /*
     * READ does not read: it declares that the next DATA line should fill these
     * identifiers, and skips forward until one appears.
     */
    PASS(errctx, akbasic_environment_wait_for_command(obj->environment, "DATA"));
    obj->environment->readIdentifierIdx = 0;
    SUCCEED_TRUE(obj, dest);
    SUCCEED_RETURN(errctx);
}

akerr_ErrorContext *akbasic_cmd_data(akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest)
{
    PREPARE_ERROR(errctx);
    akbasic_Environment *env = obj->environment;
    akbasic_ASTLeaf *literal = NULL;
    akbasic_ASTLeaf *identifier = NULL;
    akbasic_ASTLeaf assign;
    akbasic_Value *unused = NULL;

    (void)lval; (void)rval;
    FAIL_ZERO_RETURN(errctx, (expr != NULL && expr->right != NULL), AKERR_NULLPOINTER,
		     "NIL expression or argument list");

    for ( literal = expr->right->right; literal != NULL; literal = literal->right ) {
	if ( env->readIdentifierIdx >= AKBASIC_MAX_LEAVES ) {
	    break;
	}
	identifier = env->readIdentifierLeaves[env->readIdentifierIdx];
	if ( identifier == NULL ) {
	    break;
	}
	/*
	 * Build the assignment by hand rather than through the parser: the
	 * identifier leaf is a stored copy and the literal belongs to this
	 * line's pool, so there is no source text to re-parse.
	 */
	PASS(errctx, akbasic_leaf_init(&assign, AKBASIC_LEAF_BINARY));
	assign.left = identifier;
	assign.right = literal;
	assign.operator_ = AKBASIC_TOK_ASSIGNMENT;
	PASS(errctx, akbasic_runtime_evaluate(obj, &assign, &unused));
	env->readIdentifierIdx += 1;
    }

    if ( literal == NULL &&
	 env->readIdentifierIdx < AKBASIC_MAX_LEAVES &&
	 env->readIdentifierLeaves[env->readIdentifierIdx] != NULL ) {
	/* Out of DATA with READ items outstanding: stay in waiting mode. */
	SUCCEED_TRUE(obj, dest);
	SUCCEED_RETURN(errctx);
    }

    PASS(errctx, akbasic_environment_stop_waiting(env, "DATA"));
    env->lineno = env->readReturnLine;
    env->readIdentifierIdx = 0;
    SUCCEED_TRUE(obj, dest);
    SUCCEED_RETURN(errctx);
}