akbasic/src/runtime_trap.c

/**
 * @file runtime_trap.c
 * @brief The group C verbs: TRAP, RESUME, and the ERR() message lookup.
 *
 * Error trapping, built on the interrupt machinery COLLISION already uses:
 * #AKBASIC_INTERRUPT_ERROR was declared with it and armed by nothing until now.
 * A trapped error is a GOSUB the program did not write, entered at a line
 * boundary, and `RESUME` is its `RETURN`.
 *
 * **`ER` and `EL` are ordinary global variables here, spelled `ER#` and `EL#`.**
 * A C128 exposes them as bare reserved names, which this dialect cannot do: an
 * identifier carries its type in a suffix and a bare name is a *label*
 * (`LABEL DONE` / `GOTO DONE`). Writing them into the global scope costs nothing,
 * needs no new syntax, and `PRINT ER#` reads the way the rest of the language
 * does. Recorded in TODO.md section 5.
 */

#include <inttypes.h>

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

#include <akbasic/args.h>
#include <akbasic/error.h>
#include <akbasic/runtime.h>

#include "verbs.h"

/* Most verbs answer "did something happen"; this is that answer. */
#define SUCCEED_TRUE(__obj, __dest)			\
    do {						\
	*(__dest) = &(__obj)->staticTrueValue;		\
    } while ( 0 )

akerr_ErrorContext *akbasic_trap_set_error_variables(akbasic_Runtime *obj, int status, int64_t line)
{
    PREPARE_ERROR(errctx);
    akbasic_Variable *variable = NULL;
    int64_t zerosubscript[1] = { 0 };

    FAIL_ZERO_RETURN(errctx, (obj != NULL), AKERR_NULLPOINTER,
		     "NULL runtime in set_error_variables");
    /*
     * The *global* scope, not the active one. A trapped error is reported from
     * wherever it happened -- inside a GOSUB body, inside a loop -- and a
     * handler that reads ER# has usually been entered through a scope of its
     * own. akbasic_runtime_global() walks to the root, which is the only place
     * both can see.
     */
    PASS(errctx, akbasic_runtime_global(obj, "ER#", &variable));
    PASS(errctx, akbasic_variable_set_integer(variable, (int64_t)status, zerosubscript, 1));
    PASS(errctx, akbasic_runtime_global(obj, "EL#", &variable));
    PASS(errctx, akbasic_variable_set_integer(variable, line, zerosubscript, 1));
    SUCCEED_RETURN(errctx);
}

/* ------------------------------------------------------------------ TRAP -- */

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

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

    target = (expr != NULL ? expr->right : NULL);
    if ( target == NULL ) {
	/* Bare TRAP disarms, which is how a C128 turns trapping back off. */
	PASS(errctx, akbasic_runtime_disarm_interrupt(obj, AKBASIC_INTERRUPT_ERROR));
	SUCCEED_TRUE(obj, dest);
	SUCCEED_RETURN(errctx);
    }

    /*
     * A label is taken by name and resolved when the trap fires, exactly as
     * COLLISION's handler is: an error handler sits on a line normal flow does
     * not fall into.
     */
    if ( target->leaftype == AKBASIC_LEAF_IDENTIFIER &&
	 akbasic_leaf_first_subscript(target) == NULL ) {
	PASS(errctx, akbasic_runtime_arm_interrupt(obj, AKBASIC_INTERRUPT_ERROR,
						   0, target->identifier));
	SUCCEED_TRUE(obj, dest);
	SUCCEED_RETURN(errctx);
    }

    PASS(errctx, akbasic_runtime_evaluate(obj, target, &value));
    FAIL_NONZERO_RETURN(errctx, (value->valuetype != AKBASIC_TYPE_INTEGER), AKBASIC_ERR_TYPE,
			"TRAP expected a line number or a label");
    PASS(errctx, akbasic_runtime_arm_interrupt(obj, AKBASIC_INTERRUPT_ERROR,
					       value->intval, NULL));
    SUCCEED_TRUE(obj, dest);
    SUCCEED_RETURN(errctx);
}

/* ---------------------------------------------------------------- RESUME -- */

akerr_ErrorContext *akbasic_cmd_resume(akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest)
{
    PREPARE_ERROR(errctx);
    akbasic_ASTLeaf *target = NULL;
    akbasic_Value *value = NULL;
    akbasic_Variable *variable = NULL;
    int64_t zerosubscript[1] = { 0 };
    int64_t resumeline = 0;
    int cmp = 0;
    bool isnext = false;

    (void)lval; (void)rval;
    FAIL_ZERO_RETURN(errctx, (obj != NULL && dest != NULL), AKERR_NULLPOINTER,
		     "NULL argument in RESUME");
    FAIL_ZERO_RETURN(errctx, (obj->handlerenv != NULL), AKBASIC_ERR_STATE,
		     "RESUME outside the context of a TRAP handler");
    FAIL_ZERO_RETURN(errctx, (obj->environment == obj->handlerenv), AKBASIC_ERR_STATE,
		     "RESUME must return from the handler itself, not from a GOSUB inside it");
    FAIL_ZERO_RETURN(errctx, (obj->environment->parent != NULL), AKBASIC_ERR_ENVIRONMENT,
		     "RESUME from an orphaned environment");

    /* Where the error happened, which EL# is holding. */
    PASS(errctx, akbasic_runtime_global(obj, "EL#", &variable));
    PASS(errctx, akbasic_variable_get_subscript(variable, zerosubscript, 1, &value));
    resumeline = value->intval;

    target = (expr != NULL ? expr->right : NULL);
    if ( target != NULL && target->leaftype == AKBASIC_LEAF_COMMAND ) {
	PASS(errctx, aksl_strcmp(target->identifier, "NEXT", &cmp));
	isnext = (cmp == 0);
    }
    if ( target == NULL ) {
	/*
	 * Bare RESUME retries the line that failed. That is a loop unless the
	 * handler fixed whatever was wrong, which is the program's business and
	 * is exactly what the verb is for.
	 */
	obj->environment->parent->nextline = resumeline;
    } else if ( isnext ) {
	/* RESUME NEXT carries on at the line after the one that failed. */
	obj->environment->parent->nextline = resumeline + 1;
    } else {
	PASS(errctx, akbasic_runtime_evaluate(obj, target, &value));
	FAIL_NONZERO_RETURN(errctx, (value->valuetype != AKBASIC_TYPE_INTEGER),
			    AKBASIC_ERR_TYPE, "RESUME expected NEXT, a line number or a label");
	obj->environment->parent->nextline = value->intval;
    }

    obj->handlerenv = NULL;
    PASS(errctx, akbasic_runtime_prev_environment(obj));
    SUCCEED_TRUE(obj, dest);
    SUCCEED_RETURN(errctx);
}

/* ------------------------------------------------------------------- ERR -- */

akerr_ErrorContext *akbasic_fn_err(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;
    akbasic_Value *out = NULL;
    const char *name = NULL;
    int64_t status = 0;

    (void)lval; (void)rval;
    FAIL_ZERO_RETURN(errctx, (obj != NULL && expr != NULL && dest != NULL), AKERR_NULLPOINTER,
		     "NULL argument in ERR");
    arg = akbasic_leaf_first_argument(expr);
    FAIL_ZERO_RETURN(errctx, (arg != NULL), AKBASIC_ERR_SYNTAX, "ERR expected an error number");
    PASS(errctx, akbasic_runtime_evaluate(obj, arg, &value));
    FAIL_NONZERO_RETURN(errctx, (value->valuetype == AKBASIC_TYPE_STRING), AKBASIC_ERR_TYPE,
			"ERR expected a number");
    status = (value->valuetype == AKBASIC_TYPE_FLOAT)
	? (int64_t)value->floatval : value->intval;

    PASS(errctx, akbasic_environment_new_value(obj->environment, &out));
    PASS(errctx, akbasic_value_zero(out));
    out->valuetype = AKBASIC_TYPE_STRING;

    /*
     * The name libakerror registered for the code, which is where every status
     * in this process is named -- akbasic's own band, libakgl's, and the errno
     * values underneath. It answers for an unregistered code too, with "Unknown
     * Error", so there is nothing to add here; the NULL guard is for a libakerror
     * that ever decides otherwise.
     */
    name = akerr_name_for_status((int)status, NULL);
    PASS(errctx, aksl_strcpy(out->stringval, sizeof(out->stringval),
			     (name != NULL ? name : "Unknown Error")));
    *dest = out;
    SUCCEED_RETURN(errctx);
}