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>
708 lines
28 KiB
C
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);
|
|
}
|