akbasic/src/runtime_disk.c

/**
 * @file runtime_disk.c
 * @brief The group F verbs: files, channels, and the ones that need a 1541.
 *
 * Split three ways, and the split is the whole design.
 *
 *   - **Verbs that mean something on a filesystem** are implemented against
 *     `aksl_f*`: DOPEN, DCLOSE, APPEND, RECORD, SCRATCH, RENAME, COPY, CONCAT,
 *     DIRECTORY and the binary pair BSAVE/BLOAD.
 *   - **Verbs that are spellings of ones already here** are aliases: SAVE and
 *     LOAD are DSAVE and DLOAD, CATALOG is DIRECTORY, DVERIFY is VERIFY.
 *   - **Verbs that need the hardware** are refused by name, with the reason:
 *     HEADER, COLLECT, BACKUP, BOOT and DCLEAR. Formatting a disk, validating
 *     one, duplicating one and resetting a drive have no filesystem meaning that
 *     is not a lie.
 *
 * Channel numbers are the program's, written after `#`. A leading `#` is
 * optional everywhere -- `DOPEN #1, "F"` and `DOPEN 1, "F"` are the same
 * statement -- because the scanner reads `#` as its own token and a verb name
 * cannot carry one.
 */

#include <inttypes.h>
#include <stdio.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 )

akerr_ErrorContext *akbasic_disk_state_init(akbasic_DiskState *obj)
{
    PREPARE_ERROR(errctx);

    FAIL_ZERO_RETURN(errctx, (obj != NULL), AKERR_NULLPOINTER, "NULL disk state in init");
    PASS(errctx, aksl_memset(obj, 0, sizeof(*obj)));
    SUCCEED_RETURN(errctx);
}

akerr_ErrorContext *akbasic_disk_close_all(akbasic_DiskState *obj)
{
    PREPARE_ERROR(errctx);
    int i = 0;

    FAIL_ZERO_RETURN(errctx, (obj != NULL), AKERR_NULLPOINTER, "NULL disk state in close_all");
    /*
     * A loop, so CATCH and the _BREAK macros are banned in here. A close that
     * fails is reported, but the rest are still closed: leaking the others
     * because one of them was already gone would be a poor trade.
     */
    for ( i = 0; i < AKBASIC_MAX_CHANNELS; i++ ) {
	if ( obj->channels[i].fp != NULL ) {
	    IGNORE(aksl_fclose(obj->channels[i].fp));
	    obj->channels[i].fp = NULL;
	    obj->channels[i].name[0] = '\0';
	    obj->channels[i].writing = false;
	}
    }
    SUCCEED_RETURN(errctx);
}

/** @brief Check a channel number and hand back its slot. */
static akerr_ErrorContext *channel_slot(akbasic_Runtime *obj, int64_t number, akbasic_Channel **dest)
{
    PREPARE_ERROR(errctx);

    FAIL_ZERO_RETURN(errctx, (number >= 0 && number < AKBASIC_MAX_CHANNELS),
		     AKBASIC_ERR_BOUNDS, "Channel %" PRId64 " is outside 0..%d",
		     number, AKBASIC_MAX_CHANNELS - 1);
    *dest = &obj->disk_state.channels[number];
    SUCCEED_RETURN(errctx);
}

/** @brief The slot for an already-open channel, or an error naming the number. */
static akerr_ErrorContext *open_channel(akbasic_Runtime *obj, int64_t number, akbasic_Channel **dest)
{
    PREPARE_ERROR(errctx);

    PASS(errctx, channel_slot(obj, number, dest));
    FAIL_ZERO_RETURN(errctx, ((*dest)->fp != NULL), AKBASIC_ERR_STATE,
		     "Channel %" PRId64 " is not open", number);
    SUCCEED_RETURN(errctx);
}

/** @brief Evaluate one argument as a string. */
static akerr_ErrorContext *string_arg(akbasic_Runtime *obj, akbasic_ASTLeaf *arg, const char *verb, char *dest, size_t len)
{
    PREPARE_ERROR(errctx);
    akbasic_Value *value = NULL;

    FAIL_ZERO_RETURN(errctx, (arg != NULL), AKBASIC_ERR_SYNTAX, "%s expected a file name", verb);
    PASS(errctx, akbasic_runtime_evaluate(obj, arg, &value));
    FAIL_NONZERO_RETURN(errctx, (value->valuetype != AKBASIC_TYPE_STRING), AKBASIC_ERR_TYPE,
			"%s expected a file name", verb);
    /*
     * A plain copy, so aksl_strcpy rather than aksl_snprintf: it refuses rather
     * than truncates, and every caller here hands in a buffer the size of a
     * string value, so a name that did not fit could only ever be a bug.
     */
    PASS(errctx, aksl_strcpy(dest, len, value->stringval));
    SUCCEED_RETURN(errctx);
}

/** @brief Evaluate one argument as an integer. */
static akerr_ErrorContext *int_arg(akbasic_Runtime *obj, akbasic_ASTLeaf *arg, const char *verb, int64_t *dest)
{
    PREPARE_ERROR(errctx);
    akbasic_Value *value = NULL;

    FAIL_ZERO_RETURN(errctx, (arg != NULL), AKBASIC_ERR_SYNTAX, "%s expected a number", verb);
    PASS(errctx, akbasic_runtime_evaluate(obj, arg, &value));
    FAIL_NONZERO_RETURN(errctx, (value->valuetype == AKBASIC_TYPE_STRING), AKBASIC_ERR_TYPE,
			"%s expected a number", verb);
    *dest = (value->valuetype == AKBASIC_TYPE_FLOAT)
	? (int64_t)value->floatval : value->intval;
    SUCCEED_RETURN(errctx);
}

/* --------------------------------------------------------- DOPEN / APPEND -- */

/** @brief Shared by DOPEN and APPEND, which differ only in the mode. */
static akerr_ErrorContext *open_file(akbasic_Runtime *obj, akbasic_ASTLeaf *expr, const char *verb, const char *mode)
{
    PREPARE_ERROR(errctx);
    akbasic_ASTLeaf *arg = NULL;
    akbasic_Channel *channel = NULL;
    char name[AKBASIC_MAX_STRING_LENGTH];
    int64_t number = 0;
    bool writing = (mode[0] != 'r');

    arg = akbasic_leaf_first_argument(expr);
    PASS(errctx, int_arg(obj, arg, verb, &number));
    PASS(errctx, channel_slot(obj, number, &channel));
    FAIL_NONZERO_RETURN(errctx, (channel->fp != NULL), AKBASIC_ERR_STATE,
			"Channel %" PRId64 " is already open on \"%s\"", number, channel->name);
    PASS(errctx, string_arg(obj, (arg != NULL ? arg->next : NULL), verb, name, sizeof(name)));

    /*
     * DOPEN's third argument is the C128's `W` for write. It arrives as a bare
     * identifier, which is a label to this dialect and so cannot be evaluated --
     * so what is read is the *leaf*, not its value.
     */
    if ( arg != NULL && arg->next != NULL && arg->next->next != NULL ) {
	akbasic_ASTLeaf *modeleaf = arg->next->next;

	if ( modeleaf->leaftype == AKBASIC_LEAF_IDENTIFIER &&
	     (modeleaf->identifier[0] == 'W' || modeleaf->identifier[0] == 'w') ) {
	    mode = "w";
	    writing = true;
	}
    }

    PASS(errctx, aksl_fopen(name, mode, &channel->fp));
    PASS(errctx, aksl_strcpy(channel->name, sizeof(channel->name), name));
    channel->writing = writing;
    SUCCEED_RETURN(errctx);
}

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

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

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

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

akerr_ErrorContext *akbasic_cmd_dclose(akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest)
{
    PREPARE_ERROR(errctx);
    akbasic_ASTLeaf *arg = NULL;
    akbasic_Channel *channel = NULL;
    int64_t number = 0;

    (void)lval; (void)rval;
    FAIL_ZERO_RETURN(errctx, (obj != NULL && dest != NULL), AKERR_NULLPOINTER, "NULL argument in DCLOSE");
    arg = akbasic_leaf_first_argument(expr);
    if ( arg == NULL ) {
	/* Bare DCLOSE closes everything, which is what a C128 does. */
	PASS(errctx, akbasic_disk_close_all(&obj->disk_state));
	SUCCEED_TRUE(obj, dest);
	SUCCEED_RETURN(errctx);
    }
    PASS(errctx, int_arg(obj, arg, "DCLOSE", &number));
    PASS(errctx, open_channel(obj, number, &channel));
    PASS(errctx, aksl_fclose(channel->fp));
    channel->fp = NULL;
    channel->name[0] = '\0';
    channel->writing = false;
    SUCCEED_TRUE(obj, dest);
    SUCCEED_RETURN(errctx);
}

/* ----------------------------------------------------------------- RECORD -- */

akerr_ErrorContext *akbasic_cmd_record(akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest)
{
    PREPARE_ERROR(errctx);
    akbasic_ASTLeaf *arg = NULL;
    akbasic_Channel *channel = NULL;
    int64_t number = 0;
    int64_t record = 0;
    int64_t offset = 1;
    int64_t size = 0;

    (void)lval; (void)rval;
    FAIL_ZERO_RETURN(errctx, (obj != NULL && dest != NULL), AKERR_NULLPOINTER, "NULL argument in RECORD");
    arg = akbasic_leaf_first_argument(expr);
    PASS(errctx, int_arg(obj, arg, "RECORD", &number));
    PASS(errctx, open_channel(obj, number, &channel));
    PASS(errctx, int_arg(obj, (arg != NULL ? arg->next : NULL), "RECORD", &record));
    if ( arg != NULL && arg->next != NULL && arg->next->next != NULL ) {
	PASS(errctx, int_arg(obj, arg->next->next, "RECORD", &offset));
    }

    /*
     * A C128's RECORD positions within a *relative* file, whose record length was
     * fixed when the file was created. There is no such thing on a filesystem, so
     * a record is taken to be a line: the file is rewound and read forward. That
     * is slower than a seek and it is the only definition that does not require
     * inventing a record length the file does not have. TODO.md section 5.
     */
    FAIL_ZERO_RETURN(errctx, (record >= 1), AKBASIC_ERR_VALUE,
		     "RECORD numbers records from 1, not %" PRId64, record);
    PASS(errctx, aksl_fseek(channel->fp, 0, SEEK_SET));
    for ( size = 1; size < record; size++ ) {
	char line[AKBASIC_MAX_STRING_LENGTH];
	size_t length = 0;
	akerr_ErrorContext *got = aksl_fgets(line, sizeof(line), channel->fp, &length);

	if ( got != NULL ) {
	    got->handled = true;
	    IGNORE(akerr_release_error(got));
	    break;
	}
    }
    if ( offset > 1 ) {
	PASS(errctx, aksl_fseek(channel->fp, (long)(offset - 1), SEEK_CUR));
    }
    SUCCEED_TRUE(obj, dest);
    SUCCEED_RETURN(errctx);
}

/* -------------------------------------------------------- file management -- */

akerr_ErrorContext *akbasic_cmd_scratch(akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest)
{
    PREPARE_ERROR(errctx);
    akerr_ErrorContext *failure = NULL;
    char name[AKBASIC_MAX_STRING_LENGTH];

    (void)lval; (void)rval;
    FAIL_ZERO_RETURN(errctx, (obj != NULL && dest != NULL), AKERR_NULLPOINTER, "NULL argument in SCRATCH");
    PASS(errctx, string_arg(obj, akbasic_leaf_first_argument(expr), "SCRATCH", name, sizeof(name)));
    /*
     * Caught and restated rather than passed. aksl_remove raises the bare errno,
     * and "No such file or directory" on its own does not say which file or
     * which verb wanted it -- so the wrapper's error is retired here and the
     * message the program sees keeps naming both.
     */
    failure = aksl_remove(name);
    if ( failure != NULL ) {
	failure->handled = true;
	IGNORE(akerr_release_error(failure));
	FAIL_RETURN(errctx, AKERR_IO, "SCRATCH could not delete \"%s\"", name);
    }
    SUCCEED_TRUE(obj, dest);
    SUCCEED_RETURN(errctx);
}

akerr_ErrorContext *akbasic_cmd_rename(akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest)
{
    PREPARE_ERROR(errctx);
    akerr_ErrorContext *failure = NULL;
    akbasic_ASTLeaf *arg = NULL;
    char from[AKBASIC_MAX_STRING_LENGTH];
    char to[AKBASIC_MAX_STRING_LENGTH];

    (void)lval; (void)rval;
    FAIL_ZERO_RETURN(errctx, (obj != NULL && dest != NULL), AKERR_NULLPOINTER, "NULL argument in RENAME");
    arg = akbasic_leaf_first_argument(expr);
    PASS(errctx, string_arg(obj, arg, "RENAME", from, sizeof(from)));
    PASS(errctx, string_arg(obj, (arg != NULL ? arg->next : NULL), "RENAME", to, sizeof(to)));
    /* Caught and restated, for the reason SCRATCH gives: the message names both files. */
    failure = aksl_rename(from, to);
    if ( failure != NULL ) {
	failure->handled = true;
	IGNORE(akerr_release_error(failure));
	FAIL_RETURN(errctx, AKERR_IO, "RENAME could not rename \"%s\" to \"%s\"", from, to);
    }
    SUCCEED_TRUE(obj, dest);
    SUCCEED_RETURN(errctx);
}

/** @brief Shared by COPY and CONCAT, which differ only in the destination mode. */
static akerr_ErrorContext *copy_file(akbasic_Runtime *obj, akbasic_ASTLeaf *expr, const char *verb, const char *mode)
{
    PREPARE_ERROR(errctx);
    akbasic_ASTLeaf *arg = NULL;
    FILE *in = NULL;
    FILE *out = NULL;
    char from[AKBASIC_MAX_STRING_LENGTH];
    char to[AKBASIC_MAX_STRING_LENGTH];
    char buffer[4096];

    arg = akbasic_leaf_first_argument(expr);
    PASS(errctx, string_arg(obj, arg, verb, from, sizeof(from)));
    PASS(errctx, string_arg(obj, (arg != NULL ? arg->next : NULL), verb, to, sizeof(to)));

    PASS(errctx, aksl_fopen(from, "rb", &in));
    ATTEMPT {
	CATCH(errctx, aksl_fopen(to, mode, &out));
	for ( ;; ) {
	    size_t got = 0;
	    size_t put = 0;
	    bool done = false;
	    akerr_ErrorContext *read = aksl_fread(buffer, 1, sizeof(buffer), in, &got);

	    if ( read != NULL ) {
		/*
		 * A short read is how a file *ends*: aksl_fread reports fewer
		 * items than asked for as an error, and `got` still holds what
		 * it managed. Writing that out before stopping is the whole
		 * copy for any file smaller than the buffer -- the first
		 * version broke here and produced an empty destination every
		 * time.
		 */
		read->handled = true;
		IGNORE(akerr_release_error(read));
		done = true;
	    }
	    if ( got > 0 ) {
		/*
		 * PASS rather than CATCH: this is a loop, and CATCH expands to
		 * a break that would leave the rest of the ATTEMPT running with
		 * an error pending.
		 */
		PASS(errctx, aksl_fwrite(buffer, 1, got, out, &put));
	    }
	    if ( done || got == 0 ) {
		break;
	    }
	}
    } CLEANUP {
	IGNORE(aksl_fclose(in));
	if ( out != NULL ) {
	    IGNORE(aksl_fclose(out));
	}
    } PROCESS(errctx) {
    } FINISH(errctx, true);
    SUCCEED_RETURN(errctx);
}

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

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

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

    (void)lval; (void)rval;
    FAIL_ZERO_RETURN(errctx, (obj != NULL && dest != NULL), AKERR_NULLPOINTER, "NULL argument in CONCAT");
    /* Appends rather than replaces, which is the whole difference from COPY. */
    PASS(errctx, copy_file(obj, expr, "CONCAT", "ab"));
    SUCCEED_TRUE(obj, dest);
    SUCCEED_RETURN(errctx);
}

/* -------------------------------------------------------------- DIRECTORY -- */

akerr_ErrorContext *akbasic_cmd_directory(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 DIRECTORY");
    /*
     * Refused rather than half-built. This was blocked upstream: listing a
     * directory needs opendir/readdir, `libakstdlib` did not wrap them, and
     * this project's rule is that a missing capability gets filed upstream
     * rather than worked around here (MAINTENANCE.md). That was libakstdlib
     * issue #10, and it landed -- aksl_opendir, aksl_readdir, aksl_closedir
     * and aksl_rewinddir all exist as of the revision this tree pins.
     *
     * So the blocker is gone and only the work is left. Writing the verb needs
     * decisions this commit is not the place for: what a listing looks like on
     * a filesystem with no disk-image block counts, which of the Commodore
     * wildcard forms to honour, and where the entries go. Tracked as akbasic
     * issue #55; the refusal stays honest until then rather than growing a
     * half-listing nobody specified.
     */
    FAIL_RETURN(errctx, AKBASIC_ERR_DEVICE,
		"DIRECTORY is not implemented yet");
}

/* ------------------------------------------------------------ BSAVE/BLOAD -- */

akerr_ErrorContext *akbasic_cmd_bsave(akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest)
{
    PREPARE_ERROR(errctx);
    akbasic_ASTLeaf *arg = NULL;
    FILE *fp = NULL;
    char name[AKBASIC_MAX_STRING_LENGTH];
    int64_t from = 0;
    int64_t to = 0;
    size_t put = 0;

    (void)lval; (void)rval;
    FAIL_ZERO_RETURN(errctx, (obj != NULL && dest != NULL), AKERR_NULLPOINTER, "NULL argument in BSAVE");
    arg = akbasic_leaf_first_argument(expr);
    PASS(errctx, string_arg(obj, arg, "BSAVE", name, sizeof(name)));
    PASS(errctx, int_arg(obj, (arg != NULL ? arg->next : NULL), "BSAVE", &from));
    PASS(errctx, int_arg(obj, (arg != NULL && arg->next != NULL ? arg->next->next : NULL),
			 "BSAVE", &to));
    FAIL_ZERO_RETURN(errctx, (from != 0 && to > from), AKBASIC_ERR_VALUE,
		     "BSAVE needs a start address and a higher end address");

    PASS(errctx, aksl_fopen(name, "wb", &fp));
    ATTEMPT {
	CATCH(errctx, aksl_fwrite((const void *)(uintptr_t)from, 1, (size_t)(to - from), fp, &put));
    } CLEANUP {
	IGNORE(aksl_fclose(fp));
    } PROCESS(errctx) {
    } FINISH(errctx, true);
    SUCCEED_TRUE(obj, dest);
    SUCCEED_RETURN(errctx);
}

akerr_ErrorContext *akbasic_cmd_bload(akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest)
{
    PREPARE_ERROR(errctx);
    akbasic_ASTLeaf *arg = NULL;
    FILE *fp = NULL;
    char name[AKBASIC_MAX_STRING_LENGTH];
    int64_t at = 0;
    int64_t limit = 0;
    size_t got = 0;

    (void)lval; (void)rval;
    FAIL_ZERO_RETURN(errctx, (obj != NULL && dest != NULL), AKERR_NULLPOINTER, "NULL argument in BLOAD");
    arg = akbasic_leaf_first_argument(expr);
    PASS(errctx, string_arg(obj, arg, "BLOAD", name, sizeof(name)));
    PASS(errctx, int_arg(obj, (arg != NULL ? arg->next : NULL), "BLOAD", &at));
    /*
     * The length is required, unlike a C128's BLOAD which reads until the file
     * ends. A file longer than the caller expected would otherwise write past
     * whatever it was pointed at, and there is no way to notice: a BASIC integer
     * here is a real address. Refusing to guess is the only safe answer -- and
     * checked before it is read, so a missing one says *that* rather than
     * "expected a number".
     */
    FAIL_ZERO_RETURN(errctx,
		     (arg != NULL && arg->next != NULL && arg->next->next != NULL),
		     AKBASIC_ERR_SYNTAX,
		     "BLOAD needs an address and a maximum length");
    PASS(errctx, int_arg(obj, arg->next->next, "BLOAD", &limit));
    FAIL_ZERO_RETURN(errctx, (at != 0 && limit > 0), AKBASIC_ERR_VALUE,
		     "BLOAD needs an address and a maximum length");

    PASS(errctx, aksl_fopen(name, "rb", &fp));
    ATTEMPT {
	akerr_ErrorContext *read = aksl_fread((void *)(uintptr_t)at, 1, (size_t)limit, fp, &got);

	if ( read != NULL ) {
	    /* A short read is the ordinary case: the file was smaller than the cap. */
	    read->handled = true;
	    IGNORE(akerr_release_error(read));
	}
    } CLEANUP {
	IGNORE(aksl_fclose(fp));
    } PROCESS(errctx) {
    } FINISH(errctx, true);
    SUCCEED_TRUE(obj, dest);
    SUCCEED_RETURN(errctx);
}

/* ------------------------------------------------------------ channel I/O -- */

akerr_ErrorContext *akbasic_disk_write(akbasic_Runtime *obj, int64_t number, const char *text)
{
    PREPARE_ERROR(errctx);
    akbasic_Channel *channel = NULL;
    size_t length = 0;
    size_t put = 0;

    FAIL_ZERO_RETURN(errctx, (obj != NULL && text != NULL), AKERR_NULLPOINTER,
		     "NULL argument in disk_write");
    PASS(errctx, open_channel(obj, number, &channel));
    FAIL_ZERO_RETURN(errctx, channel->writing, AKBASIC_ERR_STATE,
		     "Channel %" PRId64 " was opened for reading", number);
    PASS(errctx, aksl_strlen(text, &length));
    PASS(errctx, aksl_fwrite(text, 1, length, channel->fp, &put));
    PASS(errctx, aksl_fwrite("\n", 1, 1, channel->fp, &put));
    SUCCEED_RETURN(errctx);
}

akerr_ErrorContext *akbasic_disk_readline(akbasic_Runtime *obj, int64_t number, char *dest, size_t len, bool *eof)
{
    PREPARE_ERROR(errctx);
    akbasic_Channel *channel = NULL;
    akerr_ErrorContext *got = NULL;
    char *newline = NULL;
    size_t length = 0;

    FAIL_ZERO_RETURN(errctx, (obj != NULL && dest != NULL && eof != NULL), AKERR_NULLPOINTER,
		     "NULL argument in disk_readline");
    PASS(errctx, open_channel(obj, number, &channel));
    FAIL_NONZERO_RETURN(errctx, channel->writing, AKBASIC_ERR_STATE,
			"Channel %" PRId64 " was opened for writing", number);

    *eof = false;
    dest[0] = '\0';
    got = aksl_fgets(dest, len, channel->fp, &length);
    if ( got != NULL ) {
	/*
	 * End of file is not an error here, the same way it is not one for the
	 * sink's readline: running out of input is a state a program handles.
	 */
	got->handled = true;
	IGNORE(akerr_release_error(got));
	*eof = true;
	SUCCEED_RETURN(errctx);
    }
    PASS(errctx, aksl_strchr(dest, '\n', &newline));
    if ( newline != NULL ) {
	*newline = '\0';
    }
    SUCCEED_RETURN(errctx);
}

akerr_ErrorContext *akbasic_cmd_print_channel(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;
    char text[AKBASIC_MAX_STRING_LENGTH];
    int64_t number = 0;

    (void)lval; (void)rval;
    FAIL_ZERO_RETURN(errctx, (obj != NULL && dest != NULL), AKERR_NULLPOINTER,
		     "NULL argument in PRINT#");
    arg = akbasic_leaf_first_argument(expr);
    PASS(errctx, int_arg(obj, arg, "PRINT#", &number));
    FAIL_ZERO_RETURN(errctx, (arg != NULL && arg->next != NULL), AKBASIC_ERR_SYNTAX,
		     "Expected PRINT #(channel), (expression)");
    PASS(errctx, akbasic_runtime_evaluate(obj, arg->next, &value));
    PASS(errctx, akbasic_value_to_string(value, text, sizeof(text)));
    PASS(errctx, akbasic_disk_write(obj, number, text));
    SUCCEED_TRUE(obj, dest);
    SUCCEED_RETURN(errctx);
}

akerr_ErrorContext *akbasic_cmd_input_channel(akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest)
{
    PREPARE_ERROR(errctx);
    akbasic_ASTLeaf *arg = NULL;
    akbasic_ASTLeaf *identifier = NULL;
    akbasic_ASTLeaf literal;
    akbasic_ASTLeaf assign;
    akbasic_Value *unused = NULL;
    char text[AKBASIC_MAX_STRING_LENGTH];
    int64_t number = 0;
    bool eof = false;

    (void)lval; (void)rval;
    FAIL_ZERO_RETURN(errctx, (obj != NULL && dest != NULL), AKERR_NULLPOINTER,
		     "NULL argument in INPUT#");
    arg = akbasic_leaf_first_argument(expr);
    PASS(errctx, int_arg(obj, arg, "INPUT#", &number));
    identifier = (arg != NULL ? arg->next : NULL);
    FAIL_ZERO_RETURN(errctx, akbasic_leaf_is_identifier(identifier), AKBASIC_ERR_SYNTAX,
		     "Expected INPUT #(channel), (variable)");

    PASS(errctx, akbasic_disk_readline(obj, number, text, sizeof(text), &eof));
    /*
     * End of file leaves the variable empty rather than raising. A program reads
     * until it gets nothing back, which is what it can check -- and a numeric
     * variable reading an empty line gets zero, the same as a C128.
     */
    PASS(errctx, akbasic_leaf_init(&literal, AKBASIC_LEAF_LITERAL_STRING));
    PASS(errctx, aksl_strcpy(literal.literal_string, sizeof(literal.literal_string), text));
    if ( akbasic_leaf_identifier_type(identifier) == AKBASIC_TYPE_INTEGER ) {
	long long converted = 0;

	literal.leaftype = AKBASIC_LEAF_LITERAL_INT;
	literal.literal_int = 0;
	if ( !eof && text[0] != '\0' ) {
	    PASS(errctx, aksl_atoll(text, &converted));
	    literal.literal_int = (int64_t)converted;
	}
    } else if ( akbasic_leaf_identifier_type(identifier) == AKBASIC_TYPE_FLOAT ) {
	literal.leaftype = AKBASIC_LEAF_LITERAL_FLOAT;
	literal.literal_float = 0.0;
	if ( !eof && text[0] != '\0' ) {
	    PASS(errctx, aksl_atof(text, &literal.literal_float));
	}
    }
    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));
    SUCCEED_TRUE(obj, dest);
    SUCCEED_RETURN(errctx);
}

/* ---------------------------------------------------------------- VERIFY -- */

/**
 * @brief Count the lines of @p fp that differ from the program in memory.
 *
 * Its own function so that the comparison can be reached with a single CATCH.
 * Written inline it would be a loop inside VERIFY's ATTEMPT, where neither form
 * is available: CATCH expands to a break that would escape only the loop, and
 * PASS returns past the CLEANUP that closes the file. One call is neither, so
 * the wrappers below can PASS in the ordinary way.
 */
static akerr_ErrorContext *verify_lines(akbasic_Runtime *obj, FILE *fp, int64_t *dest)
{
    PREPARE_ERROR(errctx);
    akerr_ErrorContext *got = NULL;
    char line[AKBASIC_MAX_LINE_LENGTH];
    const char *filetext = NULL;
    char *newline = NULL;
    int64_t lineno = 0;
    size_t length = 0;
    int cmp = 0;

    *dest = 0;
    for ( lineno = 0; lineno < AKBASIC_MAX_SOURCE_LINES; lineno++ ) {
	if ( obj->source[lineno].code[0] == '\0' ) {
	    continue;
	}
	got = aksl_fgets(line, sizeof(line), fp, &length);
	if ( got != NULL ) {
	    got->handled = true;
	    IGNORE(akerr_release_error(got));
	    *dest += 1;
	    break;
	}
	PASS(errctx, aksl_strchr(line, '\n', &newline));
	if ( newline != NULL ) {
	    *newline = '\0';
	}
	/*
	 * The stored line has had its number stripped, so the file's copy is
	 * compared from past its own number.
	 */
	filetext = line;
	while ( *filetext == ' ' ) {
	    filetext += 1;
	}
	while ( *filetext >= '0' && *filetext <= '9' ) {
	    filetext += 1;
	}
	while ( *filetext == ' ' ) {
	    filetext += 1;
	}
	PASS(errctx, aksl_strcmp(filetext, obj->source[lineno].code, &cmp));
	if ( cmp != 0 ) {
	    *dest += 1;
	}
    }
    SUCCEED_RETURN(errctx);
}

akerr_ErrorContext *akbasic_cmd_dverify(akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest)
{
    PREPARE_ERROR(errctx);
    FILE *fp = NULL;
    char name[AKBASIC_MAX_STRING_LENGTH];
    int64_t mismatch = 0;

    (void)lval; (void)rval;
    FAIL_ZERO_RETURN(errctx, (obj != NULL && dest != NULL), AKERR_NULLPOINTER,
		     "NULL argument in VERIFY");
    PASS(errctx, string_arg(obj, akbasic_leaf_first_argument(expr), "VERIFY", name, sizeof(name)));

    /*
     * A C128 verifies the program in memory against the one on disk byte for
     * byte, because a 1541 write could fail silently. Here the comparison is
     * line by line against the file's text, which is the same question asked of
     * a filesystem: is what I would save what is already there?
     */
    PASS(errctx, aksl_fopen(name, "r", &fp));
    ATTEMPT {
	CATCH(errctx, verify_lines(obj, fp, &mismatch));
    } CLEANUP {
	IGNORE(aksl_fclose(fp));
    } PROCESS(errctx) {
    } FINISH(errctx, true);

    FAIL_NONZERO_RETURN(errctx, (mismatch != 0), AKBASIC_ERR_VALUE,
			"VERIFY: \"%s\" does not match the program in memory (%" PRId64 " lines differ)",
			name, mismatch);
    PASS(errctx, akbasic_runtime_println(obj, "OK"));
    SUCCEED_TRUE(obj, dest);
    SUCCEED_RETURN(errctx);
}

/* --------------------------------------------------- needs a real 1541 --- */

/**
 * @brief Refuse a verb that has no meaning without the drive, and say why.
 *
 * Five of them, and the reasoning is the same each time: formatting a disk,
 * validating one, duplicating one, resetting a drive and booting from one are
 * operations on a physical device. A filesystem has no equivalent that is not a
 * lie -- `HEADER` would have to mean "delete everything in this directory",
 * which is a spectacularly bad thing to do to somebody who typed a C128 verb.
 */
static akerr_ErrorContext *no_drive(const char *verb, const char *what)
{
    PREPARE_ERROR(errctx);

    FAIL_RETURN(errctx, AKBASIC_ERR_DEVICE,
		"%s %s, and there is no disk drive here -- only a filesystem", verb, what);
}

akerr_ErrorContext *akbasic_cmd_header(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;
    PASS(errctx, no_drive("HEADER", "formats a disk"));
    SUCCEED_RETURN(errctx);
}

akerr_ErrorContext *akbasic_cmd_collect(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;
    PASS(errctx, no_drive("COLLECT", "validates a disk's block allocation map"));
    SUCCEED_RETURN(errctx);
}

akerr_ErrorContext *akbasic_cmd_backup(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;
    PASS(errctx, no_drive("BACKUP", "duplicates one disk onto another"));
    SUCCEED_RETURN(errctx);
}

akerr_ErrorContext *akbasic_cmd_boot(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;
    PASS(errctx, no_drive("BOOT", "loads and runs a boot sector"));
    SUCCEED_RETURN(errctx);
}

akerr_ErrorContext *akbasic_cmd_dclear(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 DCLEAR");
    /*
     * The one of the five with a defensible meaning. DCLEAR resets the drive and
     * closes every channel it had open; the second half is exactly
     * akbasic_disk_close_all(), so that is what it does. The first half has
     * nothing to reset.
     */
    PASS(errctx, akbasic_disk_close_all(&obj->disk_state));
    SUCCEED_TRUE(obj, dest);
    SUCCEED_RETURN(errctx);
}