Files
akbasic/src/value.c
Andrew Kesterson c1d06ee4b8 Let DEF take structure parameters, and give call scopes back
DEF AREA(S@ AS RECT) = S@.W# * S@.H#
    DEF POKEIT(P@ AS PTR TO RECT)

A parameter names its type, exactly as DIM does. A bare `DEF F(S@)` is refused:
@ says "a structure" without saying which, so it does not state a contract the
way S$ does, and accepting it would mean checking fields at the call rather than
at the declaration -- which is the hole naming the type closes. The cost is that
there are no generic functions, and that is a real loss rather than an oversight.

Passing is by value, because a parameter is bound by assignment and assignment
copies; a pointer parameter copies its reference and lets a function change its
caller's record on purpose. Neither is a special rule. What a structure
parameter does need is its storage prepared before the copy, since a structure
variable is a run of slots and there is nothing to copy into until the run
exists.

A DEF parameter list is no longer parsed as an argument list, because a
parameter is a declaration rather than an expression: `S@ AS RECT` stopped that
parser dead with "Unbalanced parenthesis".

akbasic_value_is_truthy() learned that a pointer is true when it points at
something, which had to come with this. Without it there is no way to test for
the end of a list at all -- comparing a pointer to 0 reads a numeric field it
does not carry and answers whatever that field held. A structure is deliberately
given no truth value: it always exists, so the question has no answer worth
guessing at.

And a regression I introduced last commit, plus the older one underneath it.
prev_environment() released a scope but not the variables the scope created, so
a call leaked one slot per parameter and two hundred calls exhausted the
128-slot pool. Giving each DEF call its own scope made that reachable; it was
there for GOSUB all along, measured on a stashed build -- a subroutine with a
local of its own failed after about 128 calls before any of this work. The
release is safe because a scope's table holds only what it created, and it is
the variable slot that comes back rather than its storage, so a pointer into a
record DIMmed in that scope stays sound.

Co-Authored-By: Claude Opus 5 (1M context) <noreply@anthropic.com>
2026-08-01 13:05:32 -04:00

708 lines
28 KiB
C

/**
* @file value.c
* @brief Implements the BASIC value type and its operators.
*
* Ported from basicvalue.go. It used to reproduce the reference's arithmetic
* oddities deliberately, because the golden corpus encoded the observed
* behaviour; TODO.md section 0.1 retired that constraint and section 6 records
* which ones have since been fixed and why.
*/
#include <inttypes.h>
#include <stdio.h>
#include <string.h>
#include <akerror.h>
#include <akbasic/error.h>
#include <akbasic/value.h>
/*
* Selected on the type, not summed. The reference adds both numeric fields --
* `rval.intval + int64(rval.floatval)` -- which happens to give the right answer
* only because whichever field is unused is always zero (TODO.md section 6
* item 5). Nothing enforces that: a value that ever carries both, or one reused
* from the pool without being zeroed, silently computes the sum of the two.
*/
static int64_t rval_as_int(akbasic_Value *rval)
{
if ( rval->valuetype == AKBASIC_TYPE_FLOAT ) {
return (int64_t)rval->floatval;
}
if ( rval->valuetype == AKBASIC_TYPE_BOOLEAN ) {
return rval->boolvalue;
}
return rval->intval;
}
/** @brief The float counterpart of rval_as_int(); same reasoning. */
static double rval_as_float(akbasic_Value *rval)
{
if ( rval->valuetype == AKBASIC_TYPE_FLOAT ) {
return rval->floatval;
}
if ( rval->valuetype == AKBASIC_TYPE_BOOLEAN ) {
return (double)rval->boolvalue;
}
return (double)rval->intval;
}
/**
* @brief What a value's type is called in a diagnostic.
*
* Indexed by akbasic_Type, so a new type added to the enum without a row here
* trips the negative-array-size assert below rather than printing an empty
* string into an error message nobody can act on.
*/
static const char *TYPE_NAMES[] = {
"an undefined value", /* AKBASIC_TYPE_UNDEFINED */
"an integer", /* AKBASIC_TYPE_INTEGER */
"a float", /* AKBASIC_TYPE_FLOAT */
"a string", /* AKBASIC_TYPE_STRING */
"a truth value", /* AKBASIC_TYPE_BOOLEAN */
"a structure", /* AKBASIC_TYPE_STRUCT */
"a pointer" /* AKBASIC_TYPE_POINTER */
};
typedef char akbasic_assert_type_names_complete
[(sizeof(TYPE_NAMES) / sizeof(TYPE_NAMES[0]) == AKBASIC_TYPE_POINTER + 1) ? 1 : -1];
static const char *type_name(akbasic_Type valuetype)
{
if ( valuetype < 0 || valuetype > AKBASIC_TYPE_POINTER ) {
return "a value of unknown type";
}
return TYPE_NAMES[valuetype];
}
/**
* @brief Refuse an operand the numeric path cannot read.
*
* `math_minus`, `math_multiply` and `math_divide` are shaped
* `if ( INTEGER ) ... else <treat as float>`, and **that else is a catch-all
* rather than a float branch**: it reads `floatval` from whatever it is handed.
* A truth value carries its payload in `boolvalue` and leaves `floatval` zero,
* so `(A# == 1) - 1` computed `0 - 1` into a field nothing reads, left the type
* as BOOLEAN, and printed `true` instead of -2. Multiplication and division did
* the same; only `math_plus` escaped, because it enumerates its cases and ends
* in an error.
*
* Checked here rather than in each operator so there is one rule and one
* message, and so a type added later is refused by all three at once instead of
* silently taking the float branch in each.
*
* **The two operands have different rules, and deliberately.** The left one
* decides the branch, so it must be a number. The right one is read through
* rval_as_int()/rval_as_float(), which handle a truth value on purpose -- a
* comparison yields -1 or 0 and `5 - (A# == 1)` is 6, which is the same property
* that lets `AND` and `OR` double as logical operators. Refusing a truth value
* on the right would break that, so this permits exactly what those two readers
* can actually read and nothing else.
*/
static akerr_ErrorContext *require_numeric(akbasic_Value *self, akbasic_Value *rval, const char *what)
{
PREPARE_ERROR(errctx);
FAIL_ZERO_RETURN(errctx,
(self->valuetype == AKBASIC_TYPE_INTEGER ||
self->valuetype == AKBASIC_TYPE_FLOAT),
AKBASIC_ERR_TYPE, "Cannot perform %s on %s", what, type_name(self->valuetype));
FAIL_ZERO_RETURN(errctx,
(rval->valuetype == AKBASIC_TYPE_INTEGER ||
rval->valuetype == AKBASIC_TYPE_FLOAT ||
rval->valuetype == AKBASIC_TYPE_BOOLEAN),
AKBASIC_ERR_TYPE, "Cannot perform %s on %s", what, type_name(rval->valuetype));
SUCCEED_RETURN(errctx);
}
/* Copy a string into a value's inline buffer. Truncation is an error. */
static akerr_ErrorContext *set_string(akbasic_Value *dest, const char *src)
{
PREPARE_ERROR(errctx);
FAIL_ZERO_RETURN(errctx, (strlen(src) < AKBASIC_MAX_STRING_LENGTH),
AKBASIC_ERR_VALUE,
"String result of %zu characters exceeds the %d character limit",
strlen(src), AKBASIC_MAX_STRING_LENGTH - 1);
strncpy(dest->stringval, src, AKBASIC_MAX_STRING_LENGTH - 1);
dest->stringval[AKBASIC_MAX_STRING_LENGTH - 1] = '\0';
SUCCEED_RETURN(errctx);
}
akerr_ErrorContext *akbasic_valuepool_init(akbasic_ValuePool *obj)
{
PREPARE_ERROR(errctx);
FAIL_ZERO_RETURN(errctx, (obj != NULL), AKERR_NULLPOINTER, "NULL pool in init");
memset(obj, 0, sizeof(*obj));
obj->next = 0;
SUCCEED_RETURN(errctx);
}
akerr_ErrorContext *akbasic_valuepool_take(akbasic_ValuePool *obj, int count, akbasic_Value **dest)
{
PREPARE_ERROR(errctx);
int i = 0;
FAIL_ZERO_RETURN(errctx, (obj != NULL), AKERR_NULLPOINTER, "NULL pool in take");
FAIL_ZERO_RETURN(errctx, (dest != NULL), AKERR_NULLPOINTER, "NULL destination in take");
FAIL_ZERO_RETURN(errctx, (count > 0), AKBASIC_ERR_BOUNDS,
"Array element count %d must be positive", count);
FAIL_ZERO_RETURN(errctx, (count <= AKBASIC_MAX_ARRAY_VALUES - obj->next),
AKBASIC_ERR_BOUNDS,
"Array of %d elements does not fit in the %d remaining value slots",
count, AKBASIC_MAX_ARRAY_VALUES - obj->next);
*dest = &obj->values[obj->next];
for ( i = 0; i < count; i++ ) {
PASS(errctx, akbasic_value_zero(&obj->values[obj->next + i]));
}
obj->next += count;
SUCCEED_RETURN(errctx);
}
akerr_ErrorContext *akbasic_value_init(akbasic_Value *obj)
{
PREPARE_ERROR(errctx);
FAIL_ZERO_RETURN(errctx, (obj != NULL), AKERR_NULLPOINTER, "NULL value in init");
/*
* BasicValue.init() is empty in the reference; the zeroing happens in
* zero(). Keeping both means the call sites port one-for-one.
*/
SUCCEED_RETURN(errctx);
}
akerr_ErrorContext *akbasic_value_zero(akbasic_Value *obj)
{
PREPARE_ERROR(errctx);
FAIL_ZERO_RETURN(errctx, (obj != NULL), AKERR_NULLPOINTER, "NULL value in zero");
obj->valuetype = AKBASIC_TYPE_UNDEFINED;
obj->stringval[0] = '\0';
obj->mutable_ = false;
obj->intval = 0;
obj->floatval = 0.0;
obj->boolvalue = AKBASIC_FALSE;
obj->structtype = -1;
obj->structbase = NULL;
obj->hostbase = NULL;
SUCCEED_RETURN(errctx);
}
akerr_ErrorContext *akbasic_value_clone(akbasic_Value *self, akbasic_Value *dest)
{
PREPARE_ERROR(errctx);
FAIL_ZERO_RETURN(errctx, (self != NULL), AKERR_NULLPOINTER, "NULL source in clone");
FAIL_ZERO_RETURN(errctx, (dest != NULL), AKERR_NULLPOINTER, "NULL destination in clone");
if ( self == dest ) {
SUCCEED_RETURN(errctx);
}
dest->valuetype = self->valuetype;
memcpy(dest->stringval, self->stringval, sizeof(dest->stringval));
dest->intval = self->intval;
dest->floatval = self->floatval;
dest->boolvalue = self->boolvalue;
/*
* The structure reference copies with everything else, and for a POINTER
* that is exactly right -- copying a pointer copies what it points at, not
* what it points to. For a STRUCT it is *not* the copy the language
* promises: assignment intercepts before it gets here and copies the slots
* instead. Cloning the reference is still correct at this level, because
* this is the one-slot copy and a structure does not fit in one slot.
*/
dest->structtype = self->structtype;
dest->structbase = self->structbase;
dest->hostbase = self->hostbase;
/* mutable_ is deliberately not copied: the reference's clone() does not. */
SUCCEED_RETURN(errctx);
}
akerr_ErrorContext *akbasic_value_to_string(akbasic_Value *self, char *dest, size_t len)
{
PREPARE_ERROR(errctx);
FAIL_ZERO_RETURN(errctx, (self != NULL), AKERR_NULLPOINTER, "NULL value in to_string");
FAIL_ZERO_RETURN(errctx, (dest != NULL), AKERR_NULLPOINTER, "NULL destination in to_string");
FAIL_ZERO_RETURN(errctx, (len > 0), AKBASIC_ERR_BOUNDS, "Zero-length destination in to_string");
switch ( self->valuetype ) {
case AKBASIC_TYPE_STRING:
snprintf(dest, len, "%s", self->stringval);
break;
case AKBASIC_TYPE_INTEGER:
snprintf(dest, len, "%" PRId64, self->intval);
break;
case AKBASIC_TYPE_FLOAT:
snprintf(dest, len, "%f", self->floatval);
break;
case AKBASIC_TYPE_BOOLEAN:
/* Go's %t, which is "true"/"false" and not the numeric -1/0. */
snprintf(dest, len, "%s", (self->boolvalue == AKBASIC_TRUE ? "true" : "false"));
break;
default:
snprintf(dest, len, "(UNDEFINED STRING REPRESENTATION FOR %d)", (int)self->valuetype);
break;
}
SUCCEED_RETURN(errctx);
}
akerr_ErrorContext *akbasic_value_set_bool(akbasic_Value *obj, bool result)
{
PREPARE_ERROR(errctx);
FAIL_ZERO_RETURN(errctx, (obj != NULL), AKERR_NULLPOINTER, "NULL value in set_bool");
obj->valuetype = AKBASIC_TYPE_BOOLEAN;
obj->boolvalue = (result ? AKBASIC_TRUE : AKBASIC_FALSE);
SUCCEED_RETURN(errctx);
}
bool akbasic_value_is_true(akbasic_Value *self)
{
if ( self == NULL || self->valuetype != AKBASIC_TYPE_BOOLEAN ) {
return false;
}
return (self->boolvalue == AKBASIC_TRUE);
}
bool akbasic_value_is_truthy(akbasic_Value *self)
{
if ( self == NULL ) {
return false;
}
/*
* Nonzero is true, which is Commodore's rule rather than a convenience.
* BASIC 7.0 has no separate boolean type: a comparison yields -1 or 0, `AND`
* and `OR` are the bitwise operators, and `IF A THEN` is legal for any
* numeric A. Testing only for the boolean type would make `IF A# THEN` and
* `IF A = 1 OR B = 2 THEN` -- whose OR yields an integer -- both silently
* false.
*
* A string is never true. A C128 raises a type mismatch instead; that is a
* stricter answer this interpreter could adopt later, and false is the
* conservative one meanwhile.
*/
switch ( self->valuetype ) {
case AKBASIC_TYPE_BOOLEAN:
return (self->boolvalue != 0);
case AKBASIC_TYPE_POINTER:
/*
* **A pointer is true when it points at something**, which is what makes
* `IF P@ THEN` the way to ask. Without it there is no way to test for the
* end of a list at all: comparing a pointer to 0 reads a numeric field it
* does not carry and answers whatever that field happened to hold.
*
* A *structure* is deliberately not given a truth value. It always
* exists, so the question has no answer worth guessing at, and falling
* through to false keeps `IF A@ THEN` from quietly meaning something.
*/
return (self->structbase != NULL);
case AKBASIC_TYPE_INTEGER:
return (self->intval != 0);
case AKBASIC_TYPE_FLOAT:
return (self->floatval != 0.0);
default:
return false;
}
}
/* Shared prologue for the unary operators: validate, clone into scratch. */
static akerr_ErrorContext *unary_prologue(akbasic_Value *self, akbasic_Value *scratch, akbasic_Value **dest)
{
PREPARE_ERROR(errctx);
FAIL_ZERO_RETURN(errctx, (self != NULL), AKERR_NULLPOINTER, "NULL value in unary operation");
FAIL_ZERO_RETURN(errctx, (scratch != NULL), AKERR_NULLPOINTER, "NULL scratch in unary operation");
FAIL_ZERO_RETURN(errctx, (dest != NULL), AKERR_NULLPOINTER, "NULL destination in unary operation");
PASS(errctx, akbasic_value_clone(self, scratch));
*dest = scratch;
SUCCEED_RETURN(errctx);
}
/* Shared prologue for the binary operators: validate, clone into scratch. */
static akerr_ErrorContext *binary_prologue(akbasic_Value *self, akbasic_Value *rval, akbasic_Value *scratch, akbasic_Value **dest)
{
PREPARE_ERROR(errctx);
FAIL_ZERO_RETURN(errctx, (self != NULL), AKERR_NULLPOINTER, "NULL value in binary operation");
FAIL_ZERO_RETURN(errctx, (rval != NULL), AKERR_NULLPOINTER, "nil rval");
FAIL_ZERO_RETURN(errctx, (scratch != NULL), AKERR_NULLPOINTER, "NULL scratch in binary operation");
FAIL_ZERO_RETURN(errctx, (dest != NULL), AKERR_NULLPOINTER, "NULL destination in binary operation");
PASS(errctx, akbasic_value_clone(self, scratch));
*dest = scratch;
SUCCEED_RETURN(errctx);
}
/**
* @brief The integer a bitwise operator should use for @p value.
*
* BOOLEAN counts as an integer here, and that is what makes `AND` and `OR`
* double as logical operators. Commodore BASIC has no separate logical pair: it
* represents true as -1, every bit set, precisely so that `A = 1 AND B = 2`
* works out bit by bit and lands on -1 or 0. Refusing a boolean operand would
* make the commonest conditional in the language a type error.
*/
static bool bitwise_operand(akbasic_Value *value, int64_t *dest)
{
if ( value == NULL ) {
return false;
}
if ( value->valuetype == AKBASIC_TYPE_INTEGER ) {
*dest = value->intval;
return true;
}
if ( value->valuetype == AKBASIC_TYPE_BOOLEAN ) {
*dest = value->boolvalue;
return true;
}
return false;
}
akerr_ErrorContext *akbasic_value_invert(akbasic_Value *self, akbasic_Value *scratch, akbasic_Value **dest)
{
PREPARE_ERROR(errctx);
FAIL_ZERO_RETURN(errctx, (self != NULL), AKERR_NULLPOINTER, "NULL value in invert");
FAIL_NONZERO_RETURN(errctx, (self->valuetype == AKBASIC_TYPE_STRING),
AKBASIC_ERR_TYPE, "Cannot invert a string");
PASS(errctx, unary_prologue(self, scratch, dest));
(*dest)->intval = -(self->intval);
(*dest)->floatval = -(self->floatval);
SUCCEED_RETURN(errctx);
}
akerr_ErrorContext *akbasic_value_bitwise_not(akbasic_Value *self, akbasic_Value *scratch, akbasic_Value **dest)
{
PREPARE_ERROR(errctx);
int64_t a = 0;
FAIL_ZERO_RETURN(errctx, (self != NULL), AKERR_NULLPOINTER, "NULL value in bitwise not");
FAIL_ZERO_RETURN(errctx, bitwise_operand(self, &a), AKBASIC_ERR_TYPE,
"Can only perform bitwise operations on integers and truth values");
PASS(errctx, unary_prologue(self, scratch, dest));
/*
* A truth value inverts to a truth value. On a C128 true is -1 -- every bit
* set -- so `NOT` of it is 0 and `NOT` of 0 is -1 either way you compute it;
* carrying the type through is what keeps `IF NOT (A = 9) THEN` reading as a
* condition rather than as an integer that happens to be nonzero.
*/
(*dest)->valuetype = self->valuetype;
(*dest)->intval = ~a;
(*dest)->boolvalue = ~a;
SUCCEED_RETURN(errctx);
}
akerr_ErrorContext *akbasic_value_shift_left(akbasic_Value *self, int64_t bits, akbasic_Value *scratch, akbasic_Value **dest)
{
PREPARE_ERROR(errctx);
FAIL_ZERO_RETURN(errctx, (self != NULL), AKERR_NULLPOINTER, "NULL value in shift left");
FAIL_ZERO_RETURN(errctx, (self->valuetype == AKBASIC_TYPE_INTEGER),
AKBASIC_ERR_TYPE, "Only integer datatypes can be bit-shifted");
/*
* Go's << on a negative or >=64 count is defined; C's is undefined. Refuse
* rather than inherit the UB -- no golden case exercises it, so this cannot
* change observed behaviour.
*/
FAIL_ZERO_RETURN(errctx, (bits >= 0 && bits < 64), AKBASIC_ERR_VALUE,
"Shift count %" PRId64 " is out of range 0..63", bits);
PASS(errctx, unary_prologue(self, scratch, dest));
(*dest)->intval = (int64_t)((uint64_t)(*dest)->intval << bits);
SUCCEED_RETURN(errctx);
}
akerr_ErrorContext *akbasic_value_shift_right(akbasic_Value *self, int64_t bits, akbasic_Value *scratch, akbasic_Value **dest)
{
PREPARE_ERROR(errctx);
FAIL_ZERO_RETURN(errctx, (self != NULL), AKERR_NULLPOINTER, "NULL value in shift right");
FAIL_ZERO_RETURN(errctx, (self->valuetype == AKBASIC_TYPE_INTEGER),
AKBASIC_ERR_TYPE, "Only integer datatypes can be bit-shifted");
FAIL_ZERO_RETURN(errctx, (bits >= 0 && bits < 64), AKBASIC_ERR_VALUE,
"Shift count %" PRId64 " is out of range 0..63", bits);
PASS(errctx, unary_prologue(self, scratch, dest));
(*dest)->intval = (*dest)->intval >> bits;
SUCCEED_RETURN(errctx);
}
akerr_ErrorContext *akbasic_value_bitwise_and(akbasic_Value *self, akbasic_Value *rval, akbasic_Value *scratch, akbasic_Value **dest)
{
PREPARE_ERROR(errctx);
int64_t a = 0;
int64_t b = 0;
FAIL_ZERO_RETURN(errctx, (self != NULL), AKERR_NULLPOINTER, "NULL value in bitwise and");
FAIL_ZERO_RETURN(errctx, (rval != NULL), AKERR_NULLPOINTER, "nil rval");
FAIL_ZERO_RETURN(errctx, (bitwise_operand(self, &a) && bitwise_operand(rval, &b)),
AKBASIC_ERR_TYPE,
"Can only perform bitwise operations on integers and truth values");
PASS(errctx, binary_prologue(self, rval, scratch, dest));
(*dest)->valuetype = AKBASIC_TYPE_INTEGER;
(*dest)->intval = a & b;
(*dest)->boolvalue = (*dest)->intval;
SUCCEED_RETURN(errctx);
}
akerr_ErrorContext *akbasic_value_bitwise_or(akbasic_Value *self, akbasic_Value *rval, akbasic_Value *scratch, akbasic_Value **dest)
{
PREPARE_ERROR(errctx);
int64_t a = 0;
int64_t b = 0;
FAIL_ZERO_RETURN(errctx, (self != NULL), AKERR_NULLPOINTER, "NULL value in bitwise or");
FAIL_ZERO_RETURN(errctx, (rval != NULL), AKERR_NULLPOINTER, "nil rval");
FAIL_ZERO_RETURN(errctx, (bitwise_operand(self, &a) && bitwise_operand(rval, &b)),
AKBASIC_ERR_TYPE,
"Can only perform bitwise operations on integers and truth values");
PASS(errctx, binary_prologue(self, rval, scratch, dest));
(*dest)->valuetype = AKBASIC_TYPE_INTEGER;
(*dest)->intval = a | b;
(*dest)->boolvalue = (*dest)->intval;
SUCCEED_RETURN(errctx);
}
akerr_ErrorContext *akbasic_value_bitwise_xor(akbasic_Value *self, akbasic_Value *rval, akbasic_Value *scratch, akbasic_Value **dest)
{
PREPARE_ERROR(errctx);
int64_t a = 0;
int64_t b = 0;
FAIL_ZERO_RETURN(errctx, (self != NULL), AKERR_NULLPOINTER, "NULL value in bitwise xor");
FAIL_ZERO_RETURN(errctx, (rval != NULL), AKERR_NULLPOINTER, "nil rval");
FAIL_ZERO_RETURN(errctx, (bitwise_operand(self, &a) && bitwise_operand(rval, &b)),
AKBASIC_ERR_TYPE,
"Can only perform bitwise operations on integers and truth values");
PASS(errctx, binary_prologue(self, rval, scratch, dest));
(*dest)->valuetype = AKBASIC_TYPE_INTEGER;
(*dest)->intval = a ^ b;
(*dest)->boolvalue = (*dest)->intval;
SUCCEED_RETURN(errctx);
}
akerr_ErrorContext *akbasic_value_math_plus(akbasic_Value *self, akbasic_Value *rval, akbasic_Value *scratch, akbasic_Value **dest)
{
PREPARE_ERROR(errctx);
akbasic_Value *out = NULL;
char buf[AKBASIC_MAX_STRING_LENGTH * 2];
FAIL_ZERO_RETURN(errctx, (self != NULL), AKERR_NULLPOINTER, "NULL value in math plus");
FAIL_ZERO_RETURN(errctx, (rval != NULL), AKERR_NULLPOINTER, "nil rval");
FAIL_ZERO_RETURN(errctx, (scratch != NULL), AKERR_NULLPOINTER, "NULL scratch in math plus");
FAIL_ZERO_RETURN(errctx, (dest != NULL), AKERR_NULLPOINTER, "NULL destination in math plus");
/*
* Always a clone, like every other operator. The reference mutates `self` in
* place when it happens to be mutable, so `A# + 1` modified `A#` whenever
* the left operand came from a variable rather than from a literal --
* TODO.md section 6 item 4, and the highest-blast-radius entry on that list.
*
* It was load-bearing: NEXT advanced its counter by calling this and letting
* the mutation land in the variable. NEXT now writes the result back itself,
* which is what made this safe to change. tests/for_next.c is the coverage
* that had to exist first.
*/
PASS(errctx, akbasic_value_clone(self, scratch));
out = scratch;
if ( self->valuetype == AKBASIC_TYPE_INTEGER ) {
out->intval = self->intval + rval_as_int(rval);
} else if ( self->valuetype == AKBASIC_TYPE_FLOAT ) {
out->floatval = self->floatval + rval_as_float(rval);
} else if ( self->valuetype == AKBASIC_TYPE_STRING && rval->valuetype == AKBASIC_TYPE_STRING ) {
snprintf(buf, sizeof(buf), "%s%s", self->stringval, rval->stringval);
PASS(errctx, set_string(out, buf));
} else if ( self->valuetype == AKBASIC_TYPE_STRING && rval->valuetype == AKBASIC_TYPE_INTEGER ) {
snprintf(buf, sizeof(buf), "%s%" PRId64, self->stringval, rval->intval);
PASS(errctx, set_string(out, buf));
} else if ( self->valuetype == AKBASIC_TYPE_STRING && rval->valuetype == AKBASIC_TYPE_FLOAT ) {
snprintf(buf, sizeof(buf), "%s%f", self->stringval, rval->floatval);
PASS(errctx, set_string(out, buf));
} else {
FAIL_RETURN(errctx, AKBASIC_ERR_TYPE, "Invalid arithmetic operation");
}
*dest = out;
SUCCEED_RETURN(errctx);
}
akerr_ErrorContext *akbasic_value_math_minus(akbasic_Value *self, akbasic_Value *rval, akbasic_Value *scratch, akbasic_Value **dest)
{
PREPARE_ERROR(errctx);
PASS(errctx, binary_prologue(self, rval, scratch, dest));
FAIL_NONZERO_RETURN(errctx,
(self->valuetype == AKBASIC_TYPE_STRING || rval->valuetype == AKBASIC_TYPE_STRING),
AKBASIC_ERR_TYPE, "Cannot perform subtraction on strings");
PASS(errctx, require_numeric(self, rval, "subtraction"));
if ( self->valuetype == AKBASIC_TYPE_INTEGER ) {
(*dest)->intval = self->intval - rval_as_int(rval);
} else {
(*dest)->floatval = self->floatval - rval_as_float(rval);
}
SUCCEED_RETURN(errctx);
}
akerr_ErrorContext *akbasic_value_math_divide(akbasic_Value *self, akbasic_Value *rval, akbasic_Value *scratch, akbasic_Value **dest)
{
PREPARE_ERROR(errctx);
PASS(errctx, binary_prologue(self, rval, scratch, dest));
FAIL_NONZERO_RETURN(errctx,
(self->valuetype == AKBASIC_TYPE_STRING || rval->valuetype == AKBASIC_TYPE_STRING),
AKBASIC_ERR_TYPE, "Cannot perform division on strings");
PASS(errctx, require_numeric(self, rval, "division"));
if ( self->valuetype == AKBASIC_TYPE_INTEGER ) {
/*
* Integer division by zero is UB in C where Go panics. Neither is
* acceptable in a library, and no golden case divides by zero, so raise.
*/
FAIL_NONZERO_RETURN(errctx, (rval_as_int(rval) == 0), AKBASIC_ERR_VALUE,
"DIVISION BY ZERO");
(*dest)->intval = self->intval / rval_as_int(rval);
} else {
(*dest)->floatval = self->floatval / rval_as_float(rval);
}
SUCCEED_RETURN(errctx);
}
akerr_ErrorContext *akbasic_value_math_multiply(akbasic_Value *self, akbasic_Value *rval, akbasic_Value *scratch, akbasic_Value **dest)
{
PREPARE_ERROR(errctx);
char buf[AKBASIC_MAX_STRING_LENGTH];
int64_t i = 0;
size_t srclen = 0;
size_t offset = 0;
PASS(errctx, binary_prologue(self, rval, scratch, dest));
if ( self->valuetype == AKBASIC_TYPE_STRING ) {
FAIL_NONZERO_RETURN(errctx, (rval->valuetype == AKBASIC_TYPE_STRING),
AKBASIC_ERR_TYPE, "String multiplication requires an integer multiple");
/*
* Go's strings.Repeat panics on a negative count. Refusing is strictly
* better than either panicking or reading off the end of the buffer, and
* no golden case does it.
*/
FAIL_NONZERO_RETURN(errctx, (rval->intval < 0), AKBASIC_ERR_VALUE,
"String multiplier %" PRId64 " must not be negative", rval->intval);
srclen = strlen((*dest)->stringval);
FAIL_NONZERO_RETURN(errctx,
(srclen != 0 && (uint64_t)rval->intval > (AKBASIC_MAX_STRING_LENGTH - 1) / srclen),
AKBASIC_ERR_VALUE,
"Repeated string of %zu x %" PRId64 " characters exceeds the %d character limit",
srclen, rval->intval, AKBASIC_MAX_STRING_LENGTH - 1);
for ( i = 0; i < rval->intval; i++ ) {
memcpy(buf + offset, (*dest)->stringval, srclen);
offset += srclen;
}
buf[offset] = '\0';
PASS(errctx, set_string(*dest, buf));
SUCCEED_RETURN(errctx);
}
/*
* The reference falls through to the numeric branches even for a string,
* where self->floatval is 0 and the write lands in a field nothing reads.
* That was reproduced deliberately and is now a return, because the guard
* below would otherwise refuse the string repeat this branch just did --
* and the fallthrough was only ever provably harmless, never useful.
*/
PASS(errctx, require_numeric(self, rval, "multiplication"));
if ( self->valuetype == AKBASIC_TYPE_INTEGER ) {
(*dest)->intval = self->intval * rval_as_int(rval);
} else {
(*dest)->floatval = self->floatval * rval_as_float(rval);
}
SUCCEED_RETURN(errctx);
}
akerr_ErrorContext *akbasic_value_less_than(akbasic_Value *self, akbasic_Value *rval, akbasic_Value *scratch, akbasic_Value **dest)
{
PREPARE_ERROR(errctx);
PASS(errctx, binary_prologue(self, rval, scratch, dest));
if ( self->valuetype == AKBASIC_TYPE_INTEGER ) {
PASS(errctx, akbasic_value_set_bool(*dest, self->intval < rval_as_int(rval)));
} else if ( self->valuetype == AKBASIC_TYPE_FLOAT ) {
PASS(errctx, akbasic_value_set_bool(*dest, self->floatval < rval_as_float(rval)));
} else {
PASS(errctx, akbasic_value_set_bool(*dest, strcmp(self->stringval, rval->stringval) < 0));
}
SUCCEED_RETURN(errctx);
}
akerr_ErrorContext *akbasic_value_less_than_equal(akbasic_Value *self, akbasic_Value *rval, akbasic_Value *scratch, akbasic_Value **dest)
{
PREPARE_ERROR(errctx);
PASS(errctx, binary_prologue(self, rval, scratch, dest));
if ( self->valuetype == AKBASIC_TYPE_INTEGER ) {
PASS(errctx, akbasic_value_set_bool(*dest, self->intval <= rval_as_int(rval)));
} else if ( self->valuetype == AKBASIC_TYPE_FLOAT ) {
PASS(errctx, akbasic_value_set_bool(*dest, self->floatval <= rval_as_float(rval)));
} else {
PASS(errctx, akbasic_value_set_bool(*dest, strcmp(self->stringval, rval->stringval) <= 0));
}
SUCCEED_RETURN(errctx);
}
akerr_ErrorContext *akbasic_value_greater_than(akbasic_Value *self, akbasic_Value *rval, akbasic_Value *scratch, akbasic_Value **dest)
{
PREPARE_ERROR(errctx);
PASS(errctx, binary_prologue(self, rval, scratch, dest));
if ( self->valuetype == AKBASIC_TYPE_INTEGER ) {
PASS(errctx, akbasic_value_set_bool(*dest, self->intval > rval_as_int(rval)));
} else if ( self->valuetype == AKBASIC_TYPE_FLOAT ) {
PASS(errctx, akbasic_value_set_bool(*dest, self->floatval > rval_as_float(rval)));
} else {
PASS(errctx, akbasic_value_set_bool(*dest, strcmp(self->stringval, rval->stringval) > 0));
}
SUCCEED_RETURN(errctx);
}
akerr_ErrorContext *akbasic_value_greater_than_equal(akbasic_Value *self, akbasic_Value *rval, akbasic_Value *scratch, akbasic_Value **dest)
{
PREPARE_ERROR(errctx);
PASS(errctx, binary_prologue(self, rval, scratch, dest));
if ( self->valuetype == AKBASIC_TYPE_INTEGER ) {
PASS(errctx, akbasic_value_set_bool(*dest, self->intval >= rval_as_int(rval)));
} else if ( self->valuetype == AKBASIC_TYPE_FLOAT ) {
PASS(errctx, akbasic_value_set_bool(*dest, self->floatval >= rval_as_float(rval)));
} else {
PASS(errctx, akbasic_value_set_bool(*dest, strcmp(self->stringval, rval->stringval) >= 0));
}
SUCCEED_RETURN(errctx);
}
akerr_ErrorContext *akbasic_value_is_equal(akbasic_Value *self, akbasic_Value *rval, akbasic_Value *scratch, akbasic_Value **dest)
{
PREPARE_ERROR(errctx);
PASS(errctx, binary_prologue(self, rval, scratch, dest));
if ( self->valuetype == AKBASIC_TYPE_INTEGER ) {
PASS(errctx, akbasic_value_set_bool(*dest, self->intval == rval_as_int(rval)));
} else if ( self->valuetype == AKBASIC_TYPE_FLOAT ) {
PASS(errctx, akbasic_value_set_bool(*dest, self->floatval == rval_as_float(rval)));
} else {
PASS(errctx, akbasic_value_set_bool(*dest, strcmp(self->stringval, rval->stringval) == 0));
}
SUCCEED_RETURN(errctx);
}
akerr_ErrorContext *akbasic_value_is_not_equal(akbasic_Value *self, akbasic_Value *rval, akbasic_Value *scratch, akbasic_Value **dest)
{
PREPARE_ERROR(errctx);
PASS(errctx, binary_prologue(self, rval, scratch, dest));
if ( self->valuetype == AKBASIC_TYPE_INTEGER ) {
PASS(errctx, akbasic_value_set_bool(*dest, self->intval != rval_as_int(rval)));
} else if ( self->valuetype == AKBASIC_TYPE_FLOAT ) {
PASS(errctx, akbasic_value_set_bool(*dest, self->floatval != rval_as_float(rval)));
} else {
PASS(errctx, akbasic_value_set_bool(*dest, strcmp(self->stringval, rval->stringval) != 0));
}
SUCCEED_RETURN(errctx);
}