akbasic/src/variable.c

/**
 * @file variable.c
 * @brief Implements the named variable slot and its subscript arithmetic.
 */

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

#include <akerror.h>

#include <akbasic/error.h>
#include <akbasic/variable.h>

/*
 * Flatten a subscript list to an index, walking the dimensions from the last to
 * the first exactly as the reference does. The bounds message is reproduced
 * character for character: tests/language/array_outofbounds.txt compares it with
 * strcmp, so a reworded message is a failing golden case.
 */
static akerr_ErrorContext *flatten_subscripts(akbasic_Variable *obj, int64_t *subscripts, int subscriptcount, int64_t *dest)
{
    PREPARE_ERROR(errctx);
    int64_t flatindex = 0;
    int64_t multiplier = 1;
    int i = 0;

    for ( i = subscriptcount - 1; i >= 0; i-- ) {
	FAIL_NONZERO_RETURN(errctx,
			    (subscripts[i] < 0 || subscripts[i] >= obj->dimensions[i]),
			    AKBASIC_ERR_BOUNDS,
			    "Variable index access out of bounds at dimension %d: %" PRId64 " (max %" PRId64 ")",
			    i, subscripts[i], obj->dimensions[i] - 1);
	flatindex += subscripts[i] * multiplier;
	multiplier *= obj->dimensions[i];
    }
    *dest = flatindex;
    SUCCEED_RETURN(errctx);
}

akerr_ErrorContext *akbasic_variable_init(akbasic_Variable *obj, akbasic_ValuePool *pool, int64_t *sizes, int sizecount)
{
    PREPARE_ERROR(errctx);
    int64_t totalsize = 1;
    size_t namelen = 0;
    char lastchar = '\0';
    int i = 0;

    FAIL_ZERO_RETURN(errctx, (obj != NULL), AKERR_NULLPOINTER, "NULL variable in init");
    FAIL_ZERO_RETURN(errctx, (pool != NULL), AKERR_NULLPOINTER, "NULL value pool in variable init");
    FAIL_ZERO_RETURN(errctx, (sizes != NULL), AKERR_NULLPOINTER, "NULL sizes in variable init");
    FAIL_ZERO_RETURN(errctx, (sizecount > 0 && sizecount <= AKBASIC_MAX_ARRAY_DEPTH),
		     AKBASIC_ERR_BOUNDS,
		     "Array dimension count %d out of range 1..%d",
		     sizecount, AKBASIC_MAX_ARRAY_DEPTH);

    namelen = strlen(obj->name);
    FAIL_ZERO_RETURN(errctx, (namelen > 0), AKBASIC_ERR_VALUE, "Invalid variable name");

    /* Type comes from the suffix. A bare name keeps whatever type it had. */
    lastchar = obj->name[namelen - 1];
    switch ( lastchar ) {
    case '$':
	obj->valuetype = AKBASIC_TYPE_STRING;
	break;
    case '#':
	obj->valuetype = AKBASIC_TYPE_INTEGER;
	break;
    case '%':
	obj->valuetype = AKBASIC_TYPE_FLOAT;
	break;
    default:
	break;
    }

    for ( i = 0; i < sizecount; i++ ) {
	FAIL_NONZERO_RETURN(errctx, (sizes[i] <= 0), AKBASIC_ERR_VALUE,
			    "Array dimensions must be positive integers");
	FAIL_NONZERO_RETURN(errctx, (sizes[i] > AKBASIC_MAX_ARRAY_ELEMENTS),
			    AKBASIC_ERR_BOUNDS,
			    "Array dimension %d of %" PRId64 " exceeds the %d element limit",
			    i, sizes[i], AKBASIC_MAX_ARRAY_ELEMENTS);
	totalsize *= sizes[i];
	FAIL_NONZERO_RETURN(errctx, (totalsize > AKBASIC_MAX_ARRAY_ELEMENTS),
			    AKBASIC_ERR_BOUNDS,
			    "Array of %" PRId64 " total elements exceeds the %d element limit",
			    totalsize, AKBASIC_MAX_ARRAY_ELEMENTS);
	obj->dimensions[i] = sizes[i];
    }
    obj->dimensioncount = sizecount;

    /*
     * Reuse the existing slice when it is already big enough. That makes a
     * re-DIM to the same or a smaller size free, which is the only re-DIM any
     * real program performs; growing takes fresh slots and abandons the old
     * ones, as documented on akbasic_ValuePool.
     */
    if ( obj->values == NULL || obj->valuecount < (int)totalsize ) {
	PASS(errctx, akbasic_valuepool_take(pool, (int)totalsize, &obj->values));
    }
    obj->valuecount = (int)totalsize;

    for ( i = 0; i < (int)totalsize; i++ ) {
	PASS(errctx, akbasic_value_init(&obj->values[i]));
	PASS(errctx, akbasic_value_zero(&obj->values[i]));
	obj->values[i].valuetype = obj->valuetype;
	obj->values[i].mutable_ = true;
    }
    SUCCEED_RETURN(errctx);
}

akerr_ErrorContext *akbasic_variable_zero(akbasic_Variable *obj)
{
    PREPARE_ERROR(errctx);

    FAIL_ZERO_RETURN(errctx, (obj != NULL), AKERR_NULLPOINTER, "NULL variable in zero");
    obj->valuetype = AKBASIC_TYPE_UNDEFINED;
    obj->mutable_ = true;
    SUCCEED_RETURN(errctx);
}

akerr_ErrorContext *akbasic_variable_get_subscript(akbasic_Variable *obj, int64_t *subscripts, int subscriptcount, akbasic_Value **dest)
{
    PREPARE_ERROR(errctx);
    int64_t index = 0;

    FAIL_ZERO_RETURN(errctx, (obj != NULL), AKERR_NULLPOINTER, "NULL variable in get_subscript");
    FAIL_ZERO_RETURN(errctx, (subscripts != NULL), AKERR_NULLPOINTER, "NULL subscripts in get_subscript");
    FAIL_ZERO_RETURN(errctx, (dest != NULL), AKERR_NULLPOINTER, "NULL destination in get_subscript");
    FAIL_ZERO_RETURN(errctx, (obj->values != NULL), AKERR_NULLPOINTER,
		     "Variable %s has no storage", obj->name);
    FAIL_ZERO_RETURN(errctx, (subscriptcount == obj->dimensioncount),
		     AKBASIC_ERR_BOUNDS,
		     "Variable %s has %d dimensions, received %d",
		     obj->name, obj->dimensioncount, subscriptcount);

    PASS(errctx, flatten_subscripts(obj, subscripts, subscriptcount, &index));
    *dest = &obj->values[index];
    SUCCEED_RETURN(errctx);
}

akerr_ErrorContext *akbasic_variable_set_subscript(akbasic_Variable *obj, akbasic_Value *value, int64_t *subscripts, int subscriptcount)
{
    PREPARE_ERROR(errctx);
    akbasic_Value *slot = NULL;

    FAIL_ZERO_RETURN(errctx, (value != NULL), AKERR_NULLPOINTER, "NULL value in set_subscript");
    PASS(errctx, akbasic_variable_get_subscript(obj, subscripts, subscriptcount, &slot));
    PASS(errctx, akbasic_value_clone(value, slot));
    SUCCEED_RETURN(errctx);
}

akerr_ErrorContext *akbasic_variable_set_integer(akbasic_Variable *obj, int64_t value, int64_t *subscripts, int subscriptcount)
{
    PREPARE_ERROR(errctx);
    akbasic_Value tmp;

    PASS(errctx, akbasic_value_zero(&tmp));
    tmp.valuetype = AKBASIC_TYPE_INTEGER;
    tmp.intval = value;
    PASS(errctx, akbasic_variable_set_subscript(obj, &tmp, subscripts, subscriptcount));
    SUCCEED_RETURN(errctx);
}

akerr_ErrorContext *akbasic_variable_set_float(akbasic_Variable *obj, double value, int64_t *subscripts, int subscriptcount)
{
    PREPARE_ERROR(errctx);
    akbasic_Value tmp;

    PASS(errctx, akbasic_value_zero(&tmp));
    tmp.valuetype = AKBASIC_TYPE_FLOAT;
    tmp.floatval = value;
    PASS(errctx, akbasic_variable_set_subscript(obj, &tmp, subscripts, subscriptcount));
    SUCCEED_RETURN(errctx);
}

akerr_ErrorContext *akbasic_variable_set_string(akbasic_Variable *obj, const char *value, int64_t *subscripts, int subscriptcount)
{
    PREPARE_ERROR(errctx);
    akbasic_Value tmp;

    FAIL_ZERO_RETURN(errctx, (value != NULL), AKERR_NULLPOINTER, "NULL string in set_string");
    FAIL_ZERO_RETURN(errctx, (strlen(value) < AKBASIC_MAX_STRING_LENGTH),
		     AKBASIC_ERR_VALUE,
		     "String of %zu characters exceeds the %d character limit",
		     strlen(value), AKBASIC_MAX_STRING_LENGTH - 1);
    PASS(errctx, akbasic_value_zero(&tmp));
    tmp.valuetype = AKBASIC_TYPE_STRING;
    strncpy(tmp.stringval, value, AKBASIC_MAX_STRING_LENGTH - 1);
    tmp.stringval[AKBASIC_MAX_STRING_LENGTH - 1] = '\0';
    PASS(errctx, akbasic_variable_set_subscript(obj, &tmp, subscripts, subscriptcount));
    SUCCEED_RETURN(errctx);
}