/** * @file variable.c * @brief Implements the named variable slot and its subscript arithmetic. */ #include #include #include #include #include /* * 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); PASS(errctx, aksl_strlen(obj->name, &namelen)); 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; /* * A scalar lives in the variable; only a run of more than one value comes * from the pool. * * That is not an optimisation, it is what makes a name created inside a * scope cost nothing. The pool never frees and a scope exit returns the * variable slot without returning its storage, so every GOSUB that created * a local used to spend slots that never came back -- 4096 creations and * the run was over, which a game loop reaches in half a minute. TODO.md * section 6 item 30 has the whole reduction. * * **A `@` name is the one exclusion**, except for a one-slot pointer * parameter. A structure or a pointer variable keeps pool storage because * a pointer may outlive the scope that DIMmed it -- docs/16-structures.md * says nothing is reclaimed and akbasic_runtime_prev_environment() relies * on it. A pointer parameter owns only its reference slot; the target is * owned by the caller, so bind_structure_parameter() marks it before this * call and lets that slot use inline storage. The suffix is the right test * for every other case rather than `structtype`, which the DIM path sets * *after* calling this. * * Otherwise: reuse the existing slice when it is already big enough, which * makes a re-DIM to the same or a smaller size free; growing takes fresh * slots and abandons the old ones, as documented on akbasic_ValuePool. */ if ( totalsize == 1 && (lastchar != '@' || obj->ispointer) ) { obj->values = &obj->inlinevalue; } else 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"); /* * -1 rather than 0, because 0 is a perfectly good type index: a variable * that was never DIMmed AS anything would otherwise claim to be the first * type the program declared. */ obj->structtype = -1; obj->ispointer = false; 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; size_t valuelen = 0; FAIL_ZERO_RETURN(errctx, (value != NULL), AKERR_NULLPOINTER, "NULL string in set_string"); PASS(errctx, aksl_strlen(value, &valuelen)); FAIL_ZERO_RETURN(errctx, (valuelen < AKBASIC_MAX_STRING_LENGTH), AKBASIC_ERR_VALUE, "String of %zu characters exceeds the %d character limit", valuelen, AKBASIC_MAX_STRING_LENGTH - 1); PASS(errctx, akbasic_value_zero(&tmp)); tmp.valuetype = AKBASIC_TYPE_STRING; PASS(errctx, aksl_strcpy(tmp.stringval, sizeof(tmp.stringval), value)); PASS(errctx, akbasic_variable_set_subscript(obj, &tmp, subscripts, subscriptcount)); SUCCEED_RETURN(errctx); }