akbasic/examples/hostvars.c

/**
 * @file hostvars.c
 * @brief Exchanging variables between a host C program and a BASIC script.
 *
 * This is the code in README.md's "Exchanging variables with the host" section,
 * kept here so it is compiled and run by every build rather than rotting in a
 * document.
 *
 * **Use akbasic_runtime_global().** It finds or creates the variable in the
 * script's outermost scope, which is what a host means every time. The obvious
 * alternative, akbasic_environment_get(), lands a new variable in whatever scope
 * is *active* -- and a script suspended part-way through a bounded run() is
 * usually inside a FOR or GOSUB body, so the variable dies when that body pops
 * and the script reads zero from then on, with nothing raised anywhere.
 *
 * The bottom of this file demonstrates that difference rather than describing
 * it, because it was TODO.md section 6 item 17 and it is the sort of thing that
 * gets rediscovered.
 */

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

#include <akerror.h>

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

static akbasic_Runtime SCRIPT;
static akbasic_TextSink SINK;
static akbasic_StdioSink SINKSTATE;

static const char *PROGRAM =
    "10 PRINT \"HERO \" + NAME$ + \" HAS \" + HP# + \" HP\"\n"
    "20 SCORE# = HP# * LEVEL#\n"
    "30 STATUS$ = \"OK\"\n";

/* ------------------------------------------------------- host -> script -- */

/*
 * Seed an integer the script can read. akbasic_runtime_global() creates the
 * variable if it does not exist, and the type comes from the name's suffix, so
 * "HP#" is an integer and "HP$" would be a string.
 *
 * The subscript list is {0} with a count of 1 because every scalar is really a
 * one-element array -- the same shape the interpreter itself uses.
 */
static akerr_ErrorContext AKERR_NOIGNORE *host_set_int(akbasic_Runtime *obj, const char *name, int64_t value)
{
    PREPARE_ERROR(errctx);
    akbasic_Variable *variable = NULL;
    int64_t subscript[1] = { 0 };

    PASS(errctx, akbasic_runtime_global(obj, name, &variable));
    PASS(errctx, akbasic_variable_set_integer(variable, value, subscript, 1));
    SUCCEED_RETURN(errctx);
}

static akerr_ErrorContext AKERR_NOIGNORE *host_set_string(akbasic_Runtime *obj, const char *name, const char *value)
{
    PREPARE_ERROR(errctx);
    akbasic_Variable *variable = NULL;
    int64_t subscript[1] = { 0 };

    PASS(errctx, akbasic_runtime_global(obj, name, &variable));
    PASS(errctx, akbasic_variable_set_string(variable, value, subscript, 1));
    SUCCEED_RETURN(errctx);
}

/* ------------------------------------------------------- script -> host -- */

static akerr_ErrorContext AKERR_NOIGNORE *host_get_int(akbasic_Runtime *obj, const char *name, int64_t *dest)
{
    PREPARE_ERROR(errctx);
    akbasic_Variable *variable = NULL;
    akbasic_Value *value = NULL;
    int64_t subscript[1] = { 0 };

    PASS(errctx, akbasic_runtime_global(obj, name, &variable));
    PASS(errctx, akbasic_variable_get_subscript(variable, subscript, 1, &value));
    FAIL_NONZERO_RETURN(errctx, (value->valuetype != AKBASIC_TYPE_INTEGER), AKBASIC_ERR_TYPE,
			"%s is not an integer", name);
    *dest = value->intval;
    SUCCEED_RETURN(errctx);
}

static akerr_ErrorContext AKERR_NOIGNORE *host_get_string(akbasic_Runtime *obj, const char *name, char *dest, size_t len)
{
    PREPARE_ERROR(errctx);
    akbasic_Variable *variable = NULL;
    akbasic_Value *value = NULL;
    int64_t subscript[1] = { 0 };

    PASS(errctx, akbasic_runtime_global(obj, name, &variable));
    PASS(errctx, akbasic_variable_get_subscript(variable, subscript, 1, &value));
    FAIL_NONZERO_RETURN(errctx, (value->valuetype != AKBASIC_TYPE_STRING), AKBASIC_ERR_TYPE,
			"%s is not a string", name);
    FAIL_ZERO_RETURN(errctx, (strlen(value->stringval) < len), AKBASIC_ERR_BOUNDS,
		     "%s does not fit the caller's buffer", name);
    snprintf(dest, len, "%s", value->stringval);
    SUCCEED_RETURN(errctx);
}

/* ------------------------------------------------------------- the demo -- */

/*
 * The difference between the two entry points, demonstrated rather than
 * described. The script prints the same variable from inside a loop and from
 * after it, so a variable that died with the loop's scope is visible as a zero
 * on the second line rather than as an error anywhere.
 */
static const char *LOOPING_PROGRAM =
    "10 FOR I# = 1 TO 3\n"
    "20   PRINT \"  in loop, GIFT# = \" + GIFT#\n"
    "30 NEXT I#\n"
    "40 PRINT \"  after loop, GIFT# = \" + GIFT#\n";

/* Step until the script is inside the loop body, whatever line that turns out
 * to be. A step processes one source-line *index*, and lines are filed under
 * their BASIC line numbers, so a fixed count would be a hostage to them. */
static akerr_ErrorContext AKERR_NOIGNORE *run_into_the_loop(void)
{
    PREPARE_ERROR(errctx);
    int steps = 0;

    while ( steps < AKBASIC_MAX_SOURCE_LINES &&
	    SCRIPT.mode != AKBASIC_MODE_QUIT &&
	    SCRIPT.environment->parent == NULL ) {
	PASS(errctx, akbasic_runtime_run(&SCRIPT, 1));
	steps += 1;
    }
    SUCCEED_RETURN(errctx);
}

static akerr_ErrorContext AKERR_NOIGNORE *demonstrate_scope_rules(void)
{
    PREPARE_ERROR(errctx);
    akbasic_Environment *root = NULL;
    akbasic_Variable *variable = NULL;

    PASS(errctx, akbasic_runtime_init(&SCRIPT, &SINK));
    root = SCRIPT.environment;
    PASS(errctx, akbasic_runtime_load(&SCRIPT, LOOPING_PROGRAM));
    PASS(errctx, akbasic_runtime_start(&SCRIPT, AKBASIC_MODE_RUN));

    PASS(errctx, run_into_the_loop());
    printf("suspended inside the loop? %s\n",
	   (SCRIPT.environment != root ? "yes" : "no"));

    /*
     * The right way. The variable lands in the root scope, so line 40 -- which
     * runs after NEXT has popped the loop -- still sees it.
     */
    PASS(errctx, host_set_int(&SCRIPT, "GIFT#", 42));

    /*
     * The wrong way, kept because the failure is silent and worth seeing once.
     * akbasic_environment_get() only auto-creates in the *active* environment,
     * so reaching for the root while a child is active returns NULL through
     * dest without raising -- and an unchecked host dereferences it.
     */
    PASS(errctx, akbasic_environment_get(root, "UNREACHABLE#", &variable));
    printf("does environment_get() create in the root mid-run? %s\n",
	   (variable != NULL ? "yes" : "no -- it returns NULL, with no error"));

    PASS(errctx, akbasic_runtime_run(&SCRIPT, 0));
    SUCCEED_RETURN(errctx);
}

int main(void)
{
    PREPARE_ERROR(errctx);
    char status[64];
    int64_t score = 0;
    int rc = 0;

    ATTEMPT {
	CATCH(errctx, akbasic_sink_init_stdio(&SINK, &SINKSTATE, stdout, stdin));
	CATCH(errctx, akbasic_runtime_init(&SCRIPT, &SINK));
	CATCH(errctx, akbasic_runtime_load(&SCRIPT, PROGRAM));

	/*
	 * Seed before starting. At this point the root environment is the active
	 * one, so anything created here is global to the script.
	 */
	CATCH(errctx, host_set_int(&SCRIPT, "HP#", 100));
	CATCH(errctx, host_set_int(&SCRIPT, "LEVEL#", 7));
	CATCH(errctx, host_set_string(&SCRIPT, "NAME$", "LINK"));

	CATCH(errctx, akbasic_runtime_start(&SCRIPT, AKBASIC_MODE_RUN));
	CATCH(errctx, akbasic_runtime_run(&SCRIPT, 0));

	/* Read the results back once it has stopped. */
	CATCH(errctx, host_get_int(&SCRIPT, "SCORE#", &score));
	CATCH(errctx, host_get_string(&SCRIPT, "STATUS$", status, sizeof(status)));
	printf("host read back: SCORE# = %lld, STATUS$ = \"%s\"\n",
	       (long long)score, status);

	printf("\n--- creating a variable mid-run ---\n");
	CATCH(errctx, demonstrate_scope_rules());
    } CLEANUP {
    } PROCESS(errctx) {
    } HANDLE_DEFAULT(errctx) {
	LOG_ERROR_WITH_MESSAGE(errctx, "host variable exchange failed");
	rc = 1;
    } FINISH_NORETURN(errctx);

    return rc;
}