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.
 *
 * The safe pattern is: seed variables *before* akbasic_runtime_start(), read
 * results *after* the script stops. Poking a variable while the script is
 * suspended part-way through is sharp in two ways that this file demonstrates at
 * the bottom -- see TODO.md section 6 item 17.
 */

#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_environment_get() 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_environment_get(obj->environment, name, &variable));
    FAIL_ZERO_RETURN(errctx, (variable != NULL), AKERR_KEY,
		     "could not reach variable %s from the active scope", name);
    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_environment_get(obj->environment, name, &variable));
    FAIL_ZERO_RETURN(errctx, (variable != NULL), AKERR_KEY,
		     "could not reach variable %s from the active scope", name);
    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_environment_get(obj->environment, name, &variable));
    FAIL_ZERO_RETURN(errctx, (variable != NULL), AKERR_KEY, "no variable %s", name);
    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_environment_get(obj->environment, name, &variable));
    FAIL_ZERO_RETURN(errctx, (variable != NULL), AKERR_KEY, "no variable %s", name);
    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 hazard, demonstrated rather than described. A script suspended part-way
 * through is usually inside a FOR or GOSUB scope, and a variable created there
 * dies when that scope pops.
 */
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";

static akerr_ErrorContext AKERR_NOIGNORE *demonstrate_scope_hazard(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));

    /* Run far enough to be inside the loop body. */
    PASS(errctx, akbasic_runtime_run(&SCRIPT, 12));
    printf("suspended inside the loop? %s\n",
	   (SCRIPT.environment != root ? "yes" : "no"));

    /* Poking through the *active* scope creates the variable in the loop. */
    PASS(errctx, host_set_int(&SCRIPT, "GIFT#", 42));

    /* Reaching for the root scope while a child is active simply misses. */
    PASS(errctx, akbasic_environment_get(root, "UNREACHABLE#", &variable));
    printf("can the host create in the root scope mid-run? %s\n",
	   (variable != NULL ? "yes" : "no -- get() 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--- the mid-run scope hazard (TODO.md 6.17) ---\n");
	CATCH(errctx, demonstrate_scope_hazard());
    } CLEANUP {
    } PROCESS(errctx) {
    } HANDLE_DEFAULT(errctx) {
	LOG_ERROR_WITH_MESSAGE(errctx, "host variable exchange failed");
	rc = 1;
    } FINISH_NORETURN(errctx);

    return rc;
}