akbasic/src/runtime_struct.c

/**
 * @file runtime_struct.c
 * @brief The structure verbs and the field machinery behind `.` and `->`.
 *
 * **A structure is laid out exactly as an array is**, and that falls out of
 * declaring the type: `TYPE` states the fields, so an instance has a known slot
 * count and takes one contiguous run from the same value pool `DIM` already
 * draws from. A field access is then offset arithmetic against an offset
 * src/structtype.c computed before the program ran.
 *
 * Two things ride on a value to say which instance is meant -- `structtype` and
 * `structbase`, both added to akbasic_Value for this and neither shared with the
 * numeric fields. A `STRUCT` value and a `POINTER` value carry the *same*
 * reference; what differs is what assignment does with it. A structure copies
 * the slots it points at and a pointer copies the reference, which is the whole
 * of the strict-pointer rule and the reason `.` and `->` are kept apart from the
 * scanner all the way down to here.
 *
 * Copy is **deep through values and stops at pointers**, as it does for a C
 * struct holding a pointer. Because a `TYPE` cannot contain itself by value, the
 * depth of a copy is fixed by the type graph before the program starts, so no
 * copy can recurse forever and none needs a runtime depth counter. Only
 * rendering does, because a pointer can make the graph cyclic.
 */

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

#include <akerror.h>
#include <akstdlib.h>

#include <akbasic/error.h>
#include <akbasic/runtime.h>
#include <akbasic/structtype.h>

#include "verbs.h"

/* Most verbs answer "did something happen"; this is that answer. */
#define SUCCEED_TRUE(__obj, __dest)			\
    do {						\
	*(__dest) = &(__obj)->staticTrueValue;		\
    } while ( 0 )

akerr_ErrorContext *akbasic_struct_describe(akbasic_Runtime *obj, int typeindex, akbasic_Value *base,
					    bool pointer, akbasic_Value *dest)
{
    PREPARE_ERROR(errctx);

    FAIL_ZERO_RETURN(errctx, (obj != NULL && dest != NULL), AKERR_NULLPOINTER,
		     "NULL argument in struct describe");
    PASS(errctx, akbasic_value_zero(dest));
    dest->valuetype = (pointer ? AKBASIC_TYPE_POINTER : AKBASIC_TYPE_STRUCT);
    dest->structtype = typeindex;
    dest->structbase = base;
    SUCCEED_RETURN(errctx);
}

akerr_ErrorContext *akbasic_struct_copy(akbasic_Runtime *obj, int typeindex,
					akbasic_Value *src, akbasic_Value *dest)
{
    PREPARE_ERROR(errctx);
    akbasic_StructType *type = NULL;
    int i = 0;

    FAIL_ZERO_RETURN(errctx, (obj != NULL && src != NULL && dest != NULL), AKERR_NULLPOINTER,
		     "NULL argument in struct copy");
    FAIL_ZERO_RETURN(errctx, (typeindex >= 0 && typeindex < obj->structtypes.count),
		     AKBASIC_ERR_BOUNDS, "Structure type index %d is out of range", typeindex);
    type = &obj->structtypes.types[typeindex];

    if ( src == dest ) {
	SUCCEED_RETURN(errctx);
    }
    /*
     * Slot by slot rather than one memcpy of the run, because the two are not
     * the same thing: a nested pointer field must copy its reference and a
     * nested value field must copy its slots, and only walking the descriptor
     * knows which is which. A memcpy would give the right answer today and the
     * wrong one the moment a field needs anything but a byte copy -- a host
     * binding, for instance.
     */
    for ( i = 0; i < type->slotcount; i++ ) {
	PASS(errctx, akbasic_value_clone(&src[i], &dest[i]));
    }
    SUCCEED_RETURN(errctx);
}

/**
 * @brief Resolve a field-access leaf to the slot it addresses.
 *
 * Walks the chain from the base outward, so `A@.POS@.X#` resolves `A@`, then
 * `POS@` within it, then `X#` within that -- each step against a type the
 * declaration already fixed, which is why a misspelled field can be refused by
 * name at all.
 */
akerr_ErrorContext *akbasic_struct_resolve(akbasic_Runtime *obj, akbasic_ASTLeaf *expr,
					   akbasic_StructField **fielddest, akbasic_Value **slotdest,
					   void **hostdest)
{
    PREPARE_ERROR(errctx);
    akbasic_Value *basevalue = NULL;
    akbasic_StructField *field = NULL;
    akbasic_Value *slot = NULL;

    FAIL_ZERO_RETURN(errctx, (obj != NULL && expr != NULL && slotdest != NULL), AKERR_NULLPOINTER,
		     "NULL argument in struct resolve");
    FAIL_ZERO_RETURN(errctx, (expr->leaftype == AKBASIC_LEAF_FIELD), AKBASIC_ERR_SYNTAX,
		     "Not a field access");

    PASS(errctx, akbasic_runtime_evaluate(obj, expr->left, &basevalue));

    /*
     * The strict-pointer rule, and the only place it is enforced. `.` requires a
     * structure and `->` requires a pointer to one; neither stands in for the
     * other, so a reader always knows from the spelling whether the thing on the
     * left is a copy or a reference to somebody else's data.
     */
    if ( expr->operator_ == AKBASIC_TOK_ARROW ) {
	FAIL_ZERO_RETURN(errctx, (basevalue->valuetype == AKBASIC_TYPE_POINTER),
			 AKBASIC_ERR_TYPE,
			 "-> needs a pointer on its left; use . to reach a field of a structure");
	FAIL_ZERO_RETURN(errctx, (basevalue->structbase != NULL), AKBASIC_ERR_VALUE,
			 "This pointer is not pointing at anything yet; POINT it AT a structure first");
    } else {
	FAIL_ZERO_RETURN(errctx, (basevalue->valuetype == AKBASIC_TYPE_STRUCT),
			 AKBASIC_ERR_TYPE,
			 (basevalue->valuetype == AKBASIC_TYPE_POINTER
			  ? "'.' needs a structure on its left; use -> to reach a field through a pointer"
			  : "'.' needs a structure on its left"));
	FAIL_ZERO_RETURN(errctx, (basevalue->structbase != NULL), AKBASIC_ERR_VALUE,
			 "This structure has no storage; DIM it AS a type first");
    }

    PASS(errctx, akbasic_structtype_field(&obj->structtypes, basevalue->structtype,
					  expr->identifier, &field));
    slot = basevalue->structbase + field->offset;
    if ( fielddest != NULL ) {
	*fielddest = field;
    }
    if ( hostdest != NULL ) {
	*hostdest = basevalue->hostbase;
    }
    *slotdest = slot;
    SUCCEED_RETURN(errctx);
}

akerr_ErrorContext *akbasic_struct_evaluate_field(akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value **dest)
{
    PREPARE_ERROR(errctx);
    akbasic_StructField *field = NULL;
    akbasic_Value *slot = NULL;
    akbasic_Value *out = NULL;
    void *hostbase = NULL;

    PASS(errctx, akbasic_struct_resolve(obj, expr, &field, &slot, &hostbase));

    /*
     * A nested structure evaluates to a description of where it lives, not to a
     * copy of it: `A@.POS@.X#` has to reach through it, and `B@ = A@.POS@` has
     * to know how many slots to copy. The copy happens in assignment, which is
     * the one place that knows a copy was asked for.
     */
    if ( field->kind == AKBASIC_FIELD_STRUCT ) {
	PASS(errctx, akbasic_environment_new_value(obj->environment, &out));
	PASS(errctx, akbasic_struct_describe(obj, field->typeindex, slot, false, out));
	if ( hostbase != NULL ) {
	    out->hostbase = (char *)hostbase + field->hostoffset;
	}
	*dest = out;
	SUCCEED_RETURN(errctx);
    }
    /*
     * A host-backed field is read from the host's memory every time, not from
     * the shadow slot -- the game may have moved it since the script last
     * looked, and "shared" has to mean shared in both directions.
     */
    if ( hostbase != NULL ) {
	PASS(errctx, akbasic_host_read_field(obj, field, hostbase, slot));
    }
    *dest = slot;
    SUCCEED_RETURN(errctx);
}

/**
 * @brief Render a structure the way PRINT does.
 *
 * `RECT(W#=3, H#=4)`. Bounded by depth because a pointer can make the graph
 * cyclic -- copy cannot follow one, but rendering must, or a linked list would
 * print as an unhelpful `NODE(VAL#=1, NEXT@=...)` and stop being worth printing.
 */
akerr_ErrorContext *akbasic_struct_to_string(akbasic_Runtime *obj, int typeindex, akbasic_Value *base,
					     int depth, char *dest, size_t len)
{
    PREPARE_ERROR(errctx);
    char rendered[AKBASIC_MAX_STRING_LENGTH];
    akbasic_StructType *type = NULL;
    const char *separator = NULL;
    size_t used = 0;
    size_t seplen = 0;
    size_t namelen = 0;
    size_t renderedlen = 0;
    int written = 0;
    int i = 0;

    FAIL_ZERO_RETURN(errctx, (obj != NULL && dest != NULL), AKERR_NULLPOINTER,
		     "NULL argument in struct to_string");
    FAIL_ZERO_RETURN(errctx, (typeindex >= 0 && typeindex < obj->structtypes.count),
		     AKBASIC_ERR_BOUNDS, "Structure type index %d is out of range", typeindex);
    type = &obj->structtypes.types[typeindex];

    /*
     * These two stay on raw snprintf on purpose, and are two of the six such
     * sites left in src/. Both want truncation as an *answer*: `dest` and `len`
     * come from the caller, this renders a value for display, and a name too long
     * for the buffer should print short rather than fail the whole PRINT. The
     * second one reads the return value to detect it -- on overflow `used` lands
     * past `len`, which is exactly what makes the field loop below and the
     * closing ")" both skip.
     *
     * aksl_snprintf treats truncation as AKERR_OUTOFBOUNDS and its `count` is 0
     * on that path, so it can express neither the tolerance nor the detection.
     * libakstdlib #34 is the issue that would give `count` the required length
     * back; until it lands there is nothing to convert these to.
     */
    if ( depth >= AKBASIC_MAX_STRUCT_DEPTH ) {
	snprintf(dest, len, "%s(...)", type->name);
	SUCCEED_RETURN(errctx);
    }
    written = snprintf(dest, len, "%s(", type->name);
    used = (written > 0 ? (size_t)written : 0);

    for ( i = 0; i < type->fieldcount && used + 1 < len; i++ ) {
	akbasic_StructField *field = &type->fields[i];
	akbasic_Value *slot = base + field->offset;

	switch ( field->kind ) {
	case AKBASIC_FIELD_STRUCT:
	    PASS(errctx, akbasic_struct_to_string(obj, field->typeindex, slot, depth + 1,
						  rendered, sizeof(rendered)));
	    break;
	case AKBASIC_FIELD_POINTER:
	    if ( slot->structbase == NULL ) {
		PASS(errctx, aksl_snprintf(&written, rendered, sizeof(rendered), "NOTHING"));
	    } else {
		PASS(errctx, akbasic_struct_to_string(obj, slot->structtype, slot->structbase,
						      depth + 1, rendered, sizeof(rendered)));
	    }
	    break;
	default:
	    PASS(errctx, akbasic_value_to_string(slot, rendered, sizeof(rendered)));
	    break;
	}
	separator = (i == 0 ? "" : ", ");
	PASS(errctx, aksl_strlen(separator, &seplen));
	PASS(errctx, aksl_strlen(field->name, &namelen));
	PASS(errctx, aksl_strlen(rendered, &renderedlen));
	/*
	 * A render that does not fit ends the list rather than failing it, so the
	 * fit is decided here -- aksl_snprintf treats truncation as an error, and
	 * the one byte counted beyond the three lengths is the `=`.
	 */
	if ( used + seplen + namelen + 1 + renderedlen >= len ) {
	    break;
	}
	PASS(errctx, aksl_snprintf(&written, dest + used, len - used, "%s%s=%s",
				   separator, field->name, rendered));
	used += (size_t)written;
    }
    if ( used + 1 < len ) {
	PASS(errctx, aksl_snprintf(&written, dest + used, len - used, ")"));
    }
    SUCCEED_RETURN(errctx);
}

/* ----------------------------------------------------------------- TYPE --- */

akerr_ErrorContext *akbasic_cmd_type(akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest)
{
    PREPARE_ERROR(errctx);
    int block = -1;

    (void)expr; (void)lval; (void)rval;
    FAIL_ZERO_RETURN(errctx, (obj != NULL && dest != NULL), AKERR_NULLPOINTER,
		     "NULL argument in TYPE");

    /*
     * The declaration was read before the program started; what is left to do at
     * run time is to *not* execute the block. Its field lines are declarations,
     * and letting them run would evaluate each field name as a bare identifier
     * and quietly create a global of that name -- so this jumps past END TYPE.
     */
    PASS(errctx, akbasic_structtype_block_at(&obj->structtypes, obj->environment->lineno, &block));
    FAIL_ZERO_RETURN(errctx, (block >= 0), AKBASIC_ERR_STATE,
		     "TYPE was not read by the prescan; this line is not the start of a block");
    obj->environment->nextline = obj->structtypes.types[block].lastline + 1;
    SUCCEED_TRUE(obj, dest);
    SUCCEED_RETURN(errctx);
}

/* ---------------------------------------------------------------- POINT --- */

/**
 * @brief Find the slot a pointer *lives in*, which is not the same as its value.
 *
 * `POINT` writes a reference into a pointer, so it needs the storage rather than
 * a copy of what is in it -- the same distinction `POKE` and `POINTER()` already
 * make with `eval_clone_identifiers`. Both spellings of a pointer are accepted:
 * a variable declared `AS PTR TO`, and a field declared the same way.
 */
static akerr_ErrorContext *pointer_slot(akbasic_Runtime *obj, akbasic_ASTLeaf *leaf,
					akbasic_Value **slotdest, int *typedest)
{
    PREPARE_ERROR(errctx);
    akbasic_Variable *variable = NULL;
    akbasic_StructField *field = NULL;
    akbasic_Value *slot = NULL;

    FAIL_ZERO_RETURN(errctx, (leaf != NULL), AKERR_NULLPOINTER, "NULL leaf in pointer_slot");

    if ( leaf->leaftype == AKBASIC_LEAF_FIELD ) {
	PASS(errctx, akbasic_struct_resolve(obj, leaf, &field, &slot, NULL));
	FAIL_ZERO_RETURN(errctx, (field->kind == AKBASIC_FIELD_POINTER), AKBASIC_ERR_TYPE,
			 "%s is not a pointer; only a field declared PTR TO can be POINTed",
			 field->name);
	*slotdest = slot;
	*typedest = field->typeindex;
	SUCCEED_RETURN(errctx);
    }

    FAIL_ZERO_RETURN(errctx, (leaf->leaftype == AKBASIC_LEAF_IDENTIFIER_STRUCT),
		     AKBASIC_ERR_TYPE, "POINT expects a pointer on its left");
    PASS(errctx, akbasic_environment_get(obj->environment, leaf->identifier, &variable));
    FAIL_ZERO_RETURN(errctx, (variable != NULL), AKBASIC_ERR_UNDEFINED,
		     "Identifier %s is undefined", leaf->identifier);
    FAIL_ZERO_RETURN(errctx, (variable->ispointer), AKBASIC_ERR_TYPE,
		     "%s was not DIMmed AS PTR TO a type, so it cannot point at anything",
		     leaf->identifier);
    *slotdest = &variable->values[0];
    *typedest = variable->structtype;
    SUCCEED_RETURN(errctx);
}

akerr_ErrorContext *akbasic_cmd_point(akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest)
{
    PREPARE_ERROR(errctx);
    akbasic_ASTLeaf *pointerleaf = NULL;
    akbasic_ASTLeaf *targetleaf = NULL;
    akbasic_Value *slot = NULL;
    akbasic_Value *target = NULL;
    int pointertype = -1;

    (void)lval; (void)rval;
    FAIL_ZERO_RETURN(errctx, (obj != NULL && expr != NULL && dest != NULL), AKERR_NULLPOINTER,
		     "NULL argument in POINT");
    pointerleaf = akbasic_leaf_first_argument(expr);
    FAIL_ZERO_RETURN(errctx, (pointerleaf != NULL && pointerleaf->next != NULL),
		     AKBASIC_ERR_SYNTAX, "Expected POINT <pointer> AT <structure>");
    targetleaf = pointerleaf->next;

    PASS(errctx, pointer_slot(obj, pointerleaf, &slot, &pointertype));
    PASS(errctx, akbasic_runtime_evaluate(obj, targetleaf, &target));

    /*
     * The target must be a structure, not another pointer. Pointing one pointer
     * at another is spelled `Q@ = P@` -- assignment copies a reference, which is
     * the one place in the language where copying does not deep-copy, and having
     * two ways to write it would blur exactly the line this feature draws.
     */
    FAIL_ZERO_RETURN(errctx, (target->valuetype == AKBASIC_TYPE_STRUCT), AKBASIC_ERR_TYPE,
		     (target->valuetype == AKBASIC_TYPE_POINTER
		      ? "POINT ... AT takes a structure; to copy one pointer to another, assign it"
		      : "POINT ... AT takes a structure"));
    FAIL_ZERO_RETURN(errctx, (target->structbase != NULL), AKBASIC_ERR_VALUE,
		     "That structure has no storage; DIM it AS a type first");
    FAIL_ZERO_RETURN(errctx, (target->structtype == pointertype), AKBASIC_ERR_TYPE,
		     "This pointer is to %s and cannot be pointed at a %s",
		     obj->structtypes.types[pointertype].name,
		     obj->structtypes.types[target->structtype].name);

    PASS(errctx, akbasic_value_zero(slot));
    slot->valuetype = AKBASIC_TYPE_POINTER;
    slot->structtype = target->structtype;
    slot->structbase = target->structbase;
    /*
     * And the host instance, when there is one. Without it a pointer aimed at a
     * host binding would write the shadow slot and stop there -- the script
     * would see its own change and the game would not, which is the one outcome
     * worse than refusing outright.
     */
    slot->hostbase = target->hostbase;
    SUCCEED_TRUE(obj, dest);
    SUCCEED_RETURN(errctx);
}

akerr_ErrorContext *akbasic_struct_init_slots(akbasic_Runtime *obj, int typeindex, akbasic_Value *base)
{
    PREPARE_ERROR(errctx);
    akbasic_StructType *type = NULL;
    int i = 0;

    FAIL_ZERO_RETURN(errctx, (obj != NULL && base != NULL), AKERR_NULLPOINTER,
		     "NULL argument in struct init_slots");
    FAIL_ZERO_RETURN(errctx, (typeindex >= 0 && typeindex < obj->structtypes.count),
		     AKBASIC_ERR_BOUNDS, "Structure type index %d is out of range", typeindex);
    type = &obj->structtypes.types[typeindex];

    for ( i = 0; i < type->fieldcount; i++ ) {
	akbasic_StructField *field = &type->fields[i];
	akbasic_Value *slot = base + field->offset;

	switch ( field->kind ) {
	case AKBASIC_FIELD_STRUCT:
	    /* Recurses over the type graph, which is finite: a TYPE cannot
	       contain itself by value, so this cannot run away. */
	    PASS(errctx, akbasic_struct_init_slots(obj, field->typeindex, slot));
	    break;
	case AKBASIC_FIELD_POINTER:
	    PASS(errctx, akbasic_value_zero(slot));
	    slot->valuetype = AKBASIC_TYPE_POINTER;
	    slot->structtype = field->typeindex;
	    slot->structbase = NULL;
	    break;
	default:
	    PASS(errctx, akbasic_value_zero(slot));
	    slot->valuetype = field->valuetype;
	    break;
	}
    }
    SUCCEED_RETURN(errctx);
}