diff --git a/CMakeLists.txt b/CMakeLists.txt index b3a2278..1b52853 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -138,12 +138,14 @@ set(AKBASIC_SOURCES src/renumber.c src/runtime_input.c src/runtime_sprite.c + src/runtime_struct.c src/runtime_structure.c src/runtime_trap.c src/scanner.c src/sink_stdio.c src/sink_tee.c src/sprite_tables.c + src/structtype.c src/symtab.c src/value.c src/variable.c @@ -292,6 +294,7 @@ set(AKBASIC_TESTS sink_tee sprite_verbs structure_verbs + struct_types trap_verbs symtab value_arithmetic diff --git a/include/akbasic/grammar.h b/include/akbasic/grammar.h index e81596c..8b18e00 100644 --- a/include/akbasic/grammar.h +++ b/include/akbasic/grammar.h @@ -60,6 +60,8 @@ typedef enum AKBASIC_TOK_FUNCTION_ARGUMENT, /* 38 */ AKBASIC_TOK_ATSYMBOL, /* 39 */ AKBASIC_TOK_IDENTIFIER_STRUCT, /* 40 */ + AKBASIC_TOK_DOT, /* 41 -- field of a structure value */ + AKBASIC_TOK_ARROW, /* 42 -- field through a pointer */ /* * 41, 42 -- MOVSPR's two separators, and nothing else in the language uses * either. Appended rather than filed in with the other punctuation because @@ -91,7 +93,8 @@ typedef enum AKBASIC_LEAF_FUNCTION, /* 17 */ AKBASIC_LEAF_BRANCH, /* 18 */ AKBASIC_LEAF_ARGUMENTLIST, /* 19 */ - AKBASIC_LEAF_IDENTIFIER_STRUCT /* 20 */ + AKBASIC_LEAF_IDENTIFIER_STRUCT, /* 20 */ + AKBASIC_LEAF_FIELD /* 21 -- `base . name`; base on .left */ } akbasic_LeafType; typedef struct @@ -338,6 +341,20 @@ akerr_ErrorContext AKERR_NOIGNORE *akbasic_leaf_new_literal_string(akbasic_ASTLe */ akerr_ErrorContext AKERR_NOIGNORE *akbasic_leaf_new_identifier(akbasic_ASTLeaf *obj, akbasic_LeafType leaftype, const char *lexeme); +/** + * @brief Build a field access: `base . name`, or `base -> name`. + * + * @param obj Leaf to initialize. + * @param base The expression the field is read from; stored on `.left`. + * @param name The field name, suffix included. + * @param operator_ AKBASIC_TOK_DOT or AKBASIC_TOK_ARROW, which is what says + * whether the base must be a structure or a pointer to one. + * @return `NULL` on success, otherwise an error context owned by the caller. + * @throws AKERR_NULLPOINTER When `obj` or `base` is NULL. + * @throws AKBASIC_ERR_BOUNDS When the name is too long. + */ +akerr_ErrorContext AKERR_NOIGNORE *akbasic_leaf_new_field(akbasic_ASTLeaf *obj, akbasic_ASTLeaf *base, const char *name, akbasic_TokenType operator_); + /** * @brief Render a leaf the way the reference's toString() does. * diff --git a/include/akbasic/runtime.h b/include/akbasic/runtime.h index 9d4aa00..368e98b 100644 --- a/include/akbasic/runtime.h +++ b/include/akbasic/runtime.h @@ -29,6 +29,7 @@ #include #include #include +#include #include #include #include @@ -106,6 +107,8 @@ typedef struct akbasic_Runtime akbasic_Variable variables[AKBASIC_MAX_VARIABLES]; akbasic_FunctionDef functions[AKBASIC_MAX_FUNCTIONS]; akbasic_ValuePool valuepool; + /* Every TYPE the program declared, prescanned like labels and DATA. */ + akbasic_StructTypeTable structtypes; akbasic_Value staticTrueValue; akbasic_Value staticFalseValue; diff --git a/include/akbasic/structtype.h b/include/akbasic/structtype.h new file mode 100644 index 0000000..4b1c3f9 --- /dev/null +++ b/include/akbasic/structtype.h @@ -0,0 +1,180 @@ +/** + * @file structtype.h + * @brief Declares the table of `TYPE` declarations and how a field is found in one. + * + * BASIC 7.0 has no records at all, so none of this is a port -- see TODO.md + * section 5 for what was invented and why. + * + * **Declaring the type is what buys the storage model.** Because a `TYPE` states + * its fields up front, an instance has a known slot count and is laid out + * exactly as an array is: one contiguous run taken from the runtime's value pool + * by akbasic_valuepool_take(). A field access is then offset arithmetic against + * an offset this table already knows, and no new pool is needed for the data -- + * only this table of descriptors, which holds names and offsets rather than + * values. + * + * A field nested **by value** flattens into its parent's run at an offset. A + * field declared `PTR TO` occupies one slot holding a reference. That is the + * whole difference, and it is why a `TYPE` may refer to itself only through a + * pointer: by value it would have no finite size, which is refused at + * declaration rather than discovered when the pool runs out. + */ + +#ifndef _AKBASIC_STRUCTTYPE_H_ +#define _AKBASIC_STRUCTTYPE_H_ + +#include + +#include +#include + +struct akbasic_Runtime; + +/** @brief What a field holds, which is what says how much room it needs. */ +typedef enum +{ + AKBASIC_FIELD_PRIMITIVE = 0, /* one slot, type from the name's suffix */ + AKBASIC_FIELD_STRUCT, /* nested by value; flattened into the parent */ + AKBASIC_FIELD_POINTER /* one slot holding a reference */ +} akbasic_FieldKind; + +/** @brief One declared field: what it is called, what it holds, and where it sits. */ +typedef struct +{ + char name[AKBASIC_MAX_STRUCT_NAME]; /** as written, suffix included */ + akbasic_FieldKind kind; + akbasic_Type valuetype; /** for a primitive, from the suffix */ + int typeindex; /** for STRUCT and POINTER */ + int offset; /** slots from the start of the instance */ + int slotcount; /** slots this field occupies */ +} akbasic_StructField; + +/** + * @brief One `TYPE` declaration. + * + * `firstline` and `lastline` are the `TYPE` and `END TYPE` source lines. They + * are kept because the block has to be *skipped* at run time: its field lines + * are declarations, and letting them execute would evaluate each field name as a + * bare identifier and quietly create a global of that name. + */ +typedef struct +{ + char name[AKBASIC_MAX_STRUCT_NAME]; + akbasic_StructField fields[AKBASIC_MAX_STRUCT_FIELDS]; + int fieldcount; + int slotcount; /** total slots for one instance */ + int64_t firstline; + int64_t lastline; + bool used; +} akbasic_StructType; + +/** @brief Every `TYPE` a program declared. Lives on the runtime. */ +typedef struct +{ + akbasic_StructType types[AKBASIC_MAX_STRUCT_TYPES]; + int count; +} akbasic_StructTypeTable; + +/** + * @brief Empty the table. + * @param obj Object to initialize, inspect, or modify. + * @return `NULL` on success, otherwise an error context owned by the caller. + * @throws AKERR_NULLPOINTER When `obj` is NULL. + */ +akerr_ErrorContext AKERR_NOIGNORE *akbasic_structtype_table_init(akbasic_StructTypeTable *obj); + +/** + * @brief Find a declared type by name. + * @param obj Table to search. + * @param name Type name, without a suffix. + * @param dest Output destination populated by the function; the index, or -1. + * @return `NULL` on success, otherwise an error context owned by the caller. + * @throws AKERR_NULLPOINTER When any argument is NULL. + */ +akerr_ErrorContext AKERR_NOIGNORE *akbasic_structtype_find(akbasic_StructTypeTable *obj, const char *name, int *dest); + +/** + * @brief Resolve a field of a declared type, refusing one it does not declare. + * + * The refusal lists the fields the type *does* have, because the whole reason a + * misspelled field can be caught at all is that the set is closed and written + * down -- so the diagnostic may as well show it. + * + * @param obj Table the type lives in. + * @param typeindex Which type. + * @param name Field name, suffix included. + * @param dest Output destination populated by the function. + * @return `NULL` on success, otherwise an error context owned by the caller. + * @throws AKERR_NULLPOINTER When `obj`, `name` or `dest` is NULL. + * @throws AKBASIC_ERR_BOUNDS When `typeindex` names no type. + * @throws AKBASIC_ERR_UNDEFINED When the type does not declare that field. + */ +akerr_ErrorContext AKERR_NOIGNORE *akbasic_structtype_field(akbasic_StructTypeTable *obj, int typeindex, const char *name, akbasic_StructField **dest); + +/** + * @brief Read every `TYPE` block out of the program before it runs. + * + * Called from akbasic_runtime_set_mode() beside the label and `DATA` prescans, + * and for the same reason all three are prescans: a declaration has to be in + * effect wherever control happens to go, including when a branch skips over the + * lines that made it. It also means `DIM P@ AS RECT` can never run before the + * type it names exists. + * + * @param obj The runtime, whose source is read and whose table is filled. + * @return `NULL` on success, otherwise an error context owned by the caller. + * @throws AKERR_NULLPOINTER When `obj` is NULL. + * @throws AKBASIC_ERR_SYNTAX When a block is malformed or unterminated. + * @throws AKBASIC_ERR_VALUE When a type contains itself by value, or redeclares a name. + * @throws AKBASIC_ERR_BOUNDS When the table or a field list is full. + */ +akerr_ErrorContext AKERR_NOIGNORE *akbasic_structtype_scan(struct akbasic_Runtime *obj); + +/** + * @brief Which `TYPE` block a source line opens, or -1. + * + * How `TYPE` skips its own body at run time: the verb asks what block it is + * looking at and jumps past its `END TYPE`. + * + * @param obj Table to search. + * @param lineno The line the interpreter is on. + * @param dest Output destination populated by the function; the index, or -1. + * @return `NULL` on success, otherwise an error context owned by the caller. + * @throws AKERR_NULLPOINTER When `obj` or `dest` is NULL. + */ +akerr_ErrorContext AKERR_NOIGNORE *akbasic_structtype_block_at(akbasic_StructTypeTable *obj, int64_t lineno, int *dest); + +/* --------------------------------------------------- the runtime half --- */ + +/** + * @brief Fill @p dest with a description of an instance: which type, and where. + * + * What a structure-valued *expression* evaluates to. Not the data -- an instance + * is a run of slots and a value is one slot -- so this is the reference that + * lets assignment find the slots to copy, or lets `.` step into them. + */ +akerr_ErrorContext AKERR_NOIGNORE *akbasic_struct_describe(struct akbasic_Runtime *obj, int typeindex, akbasic_Value *base, bool pointer, akbasic_Value *dest); + +/** + * @brief Copy one instance's slots onto another's. + * + * Deep through nested values, and stops at pointers -- as it does for a C struct + * holding a pointer. A `TYPE` cannot contain itself by value, so the depth is + * fixed by the type graph before the program runs and this cannot recurse away. + */ +akerr_ErrorContext AKERR_NOIGNORE *akbasic_struct_copy(struct akbasic_Runtime *obj, int typeindex, akbasic_Value *src, akbasic_Value *dest); + +/** + * @brief Resolve a field-access leaf to the slot it addresses. + * + * Enforces the strict-pointer rule on the way: `.` requires a structure on its + * left and `->` requires a pointer, and neither stands in for the other. + */ +akerr_ErrorContext AKERR_NOIGNORE *akbasic_struct_resolve(struct akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_StructField **fielddest, akbasic_Value **slotdest); + +/** @brief Evaluate a field access to the value it yields. */ +akerr_ErrorContext AKERR_NOIGNORE *akbasic_struct_evaluate_field(struct akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value **dest); + +/** @brief Render an instance the way PRINT does, bounded by depth. */ +akerr_ErrorContext AKERR_NOIGNORE *akbasic_struct_to_string(struct akbasic_Runtime *obj, int typeindex, akbasic_Value *base, int depth, char *dest, size_t len); + +#endif // _AKBASIC_STRUCTTYPE_H_ diff --git a/include/akbasic/types.h b/include/akbasic/types.h index c60840d..ec8462a 100644 --- a/include/akbasic/types.h +++ b/include/akbasic/types.h @@ -39,6 +39,23 @@ */ #define AKBASIC_MAX_CONDITION_LEAVES 16 +/* + * Structure types. These bound the *descriptors* -- names and slot offsets -- + * and not the data: an instance's fields are ordinary values drawn from the same + * AKBASIC_MAX_ARRAY_VALUES pool an array uses, because a declared TYPE has a + * known slot count and so is laid out exactly as an array is. + */ +#define AKBASIC_MAX_STRUCT_TYPES 16 /* distinct TYPE declarations */ +#define AKBASIC_MAX_STRUCT_FIELDS 16 /* fields in one TYPE */ +#define AKBASIC_MAX_STRUCT_NAME 32 /* a type or field name */ +/* + * How deep a chain of by-value nesting may go. A TYPE cannot contain itself by + * value -- that is refused at declaration -- so this is not what stops infinite + * recursion; it bounds the *rendering* of a structure, where a pointer can make + * the graph cyclic and PRINT would otherwise not come back. + */ +#define AKBASIC_MAX_STRUCT_DEPTH 8 + /* Commodore convention: true is -1, not 1. */ #define AKBASIC_TRUE -1 #define AKBASIC_FALSE 0 @@ -56,7 +73,9 @@ typedef enum AKBASIC_TYPE_INTEGER, /* 1 -- identifier suffix '#' */ AKBASIC_TYPE_FLOAT, /* 2 -- identifier suffix '%' */ AKBASIC_TYPE_STRING, /* 3 -- identifier suffix '$' */ - AKBASIC_TYPE_BOOLEAN /* 4 */ + AKBASIC_TYPE_BOOLEAN, /* 4 */ + AKBASIC_TYPE_STRUCT, /* 5 -- identifier suffix '@' */ + AKBASIC_TYPE_POINTER /* 6 -- identifier suffix '@', declared PTR TO */ } akbasic_Type; /* @@ -76,6 +95,23 @@ typedef struct akbasic_Value double floatval; int64_t boolvalue; bool mutable_; + + /* + * What a STRUCT or POINTER value carries. Not a payload: a *reference* to + * one, because an instance is a run of slots and cannot fit in the one slot + * a value occupies. + * + * These are their own members rather than a reuse of `intval`, and that is + * deliberate -- section 6 item 5 was an operator reading a numeric field + * that happened to be the wrong one, and putting a slot index somewhere + * arithmetic already looks would set the same trap again. + * + * The distinction between the two types is what an *assignment* does with + * this reference, not what the reference is: a STRUCT copies the slots it + * points at, and a POINTER copies the reference itself. + */ + int structtype; /* index into the type table, -1 for none */ + struct akbasic_Value *structbase; /* first slot of the instance */ } akbasic_Value; #endif // _AKBASIC_TYPES_H_ diff --git a/include/akbasic/variable.h b/include/akbasic/variable.h index 606091c..fdcca84 100644 --- a/include/akbasic/variable.h +++ b/include/akbasic/variable.h @@ -26,6 +26,14 @@ typedef struct int dimensioncount; bool mutable_; bool used; /** Pool bookkeeping */ + /* + * What DIM ... AS recorded. A structure variable's `values` run is one + * instance laid out by the type's offsets, exactly as an array's run is its + * elements -- so these two are what tell the difference between the two + * kinds of run. + */ + int structtype; /** type index, -1 when not a structure */ + bool ispointer; /** declared PTR TO rather than a value */ } akbasic_Variable; /** diff --git a/src/environment.c b/src/environment.c index b83caa8..82d4a15 100644 --- a/src/environment.c +++ b/src/environment.c @@ -357,6 +357,66 @@ static akerr_ErrorContext *collect_subscripts(akbasic_Environment *obj, akbasic_ SUCCEED_RETURN(errctx); } +/** + * @brief Assign into a field, checking the field's declared type as it goes. + * + * The type check is the same one a variable gets, and it comes from the same + * place: the field's suffix said what it holds when the TYPE was declared. What + * is different is that a *field* name is checked for existence at all, which a + * variable name never is -- the set of fields is closed and written down, and + * akbasic_structtype_field() lists them when one is missed. + */ +static akerr_ErrorContext *assign_field(akbasic_Environment *obj, akbasic_ASTLeaf *lval, + akbasic_Value *rval, akbasic_Value **dest) +{ + PREPARE_ERROR(errctx); + akbasic_StructField *field = NULL; + akbasic_Value *slot = NULL; + + PASS(errctx, akbasic_struct_resolve(obj->runtime, lval, &field, &slot)); + + switch ( field->kind ) { + case AKBASIC_FIELD_STRUCT: + FAIL_ZERO_RETURN(errctx, (rval->valuetype == AKBASIC_TYPE_STRUCT), AKBASIC_ERR_TYPE, + "Incompatible types in assignment to %s", field->name); + FAIL_ZERO_RETURN(errctx, (rval->structtype == field->typeindex), AKBASIC_ERR_TYPE, + "%s is a %s and cannot be assigned a %s", field->name, + obj->runtime->structtypes.types[field->typeindex].name, + obj->runtime->structtypes.types[rval->structtype].name); + PASS(errctx, akbasic_struct_copy(obj->runtime, field->typeindex, rval->structbase, slot)); + break; + case AKBASIC_FIELD_POINTER: + FAIL_ZERO_RETURN(errctx, (rval->valuetype == AKBASIC_TYPE_POINTER), AKBASIC_ERR_TYPE, + "%s is a pointer; POINT it AT a structure rather than assigning one to it", + field->name); + FAIL_ZERO_RETURN(errctx, (rval->structtype == field->typeindex), AKBASIC_ERR_TYPE, + "%s points to %s and cannot hold a pointer to %s", field->name, + obj->runtime->structtypes.types[field->typeindex].name, + obj->runtime->structtypes.types[rval->structtype].name); + PASS(errctx, akbasic_value_clone(rval, slot)); + break; + default: + if ( field->valuetype == AKBASIC_TYPE_INTEGER && rval->valuetype == AKBASIC_TYPE_FLOAT ) { + PASS(errctx, akbasic_value_zero(slot)); + slot->valuetype = AKBASIC_TYPE_INTEGER; + slot->intval = (int64_t)rval->floatval; + break; + } + if ( field->valuetype == AKBASIC_TYPE_FLOAT && rval->valuetype == AKBASIC_TYPE_INTEGER ) { + PASS(errctx, akbasic_value_zero(slot)); + slot->valuetype = AKBASIC_TYPE_FLOAT; + slot->floatval = (double)rval->intval; + break; + } + FAIL_ZERO_RETURN(errctx, (rval->valuetype == field->valuetype), AKBASIC_ERR_TYPE, + "Incompatible types in assignment to %s", field->name); + PASS(errctx, akbasic_value_clone(rval, slot)); + break; + } + *dest = slot; + SUCCEED_RETURN(errctx); +} + akerr_ErrorContext *akbasic_environment_assign(akbasic_Environment *obj, akbasic_ASTLeaf *lval, akbasic_Value *rval, akbasic_Value **dest) { PREPARE_ERROR(errctx); @@ -368,6 +428,16 @@ akerr_ErrorContext *akbasic_environment_assign(akbasic_Environment *obj, akbasic FAIL_ZERO_RETURN(errctx, (obj != NULL && lval != NULL && rval != NULL && dest != NULL), AKERR_NULLPOINTER, "nil pointer"); + /* + * A field is addressed by walking the chain, not by looking a name up in a + * scope -- `E@.POS@.X#` names no variable called `X#`. So it is resolved and + * assigned here, before the by-name lookup the rest of this function does. + */ + if ( lval->leaftype == AKBASIC_LEAF_FIELD ) { + PASS(errctx, assign_field(obj, lval, rval, dest)); + SUCCEED_RETURN(errctx); + } + PASS(errctx, akbasic_environment_get(obj, lval->identifier, &variable)); FAIL_ZERO_RETURN(errctx, (variable != NULL), AKBASIC_ERR_UNDEFINED, "Identifier %s is undefined", lval->identifier); @@ -382,6 +452,46 @@ akerr_ErrorContext *akbasic_environment_assign(akbasic_Environment *obj, akbasic PASS(errctx, akbasic_variable_get_subscript(variable, subscripts, subscriptcount, &slot)); switch ( lval->leaftype ) { + case AKBASIC_LEAF_IDENTIFIER_STRUCT: + /* + * **This is the whole of copy-on-assign**, and it has to happen here + * rather than in akbasic_value_clone(): a clone copies one slot, and one + * slot holds a *reference* to an instance rather than the instance. Going + * through clone would therefore alias -- exactly the reference semantics + * the language does not have -- so a structure is intercepted before it + * reaches that path and its slots are copied one at a time. + * + * A pointer variable is the opposite and takes the clone: copying a + * pointer copies the reference, which is what makes `POINT` the only way + * to share and assignment always a copy. + */ + FAIL_ZERO_RETURN(errctx, (variable->structtype >= 0), AKBASIC_ERR_STATE, + "%s has not been DIMmed AS a type", lval->identifier); + if ( variable->ispointer ) { + FAIL_ZERO_RETURN(errctx, (rval->valuetype == AKBASIC_TYPE_POINTER), + AKBASIC_ERR_TYPE, + "%s is a pointer; POINT it AT a structure rather than assigning one to it", + lval->identifier); + FAIL_ZERO_RETURN(errctx, (rval->structtype == variable->structtype), + AKBASIC_ERR_TYPE, + "%s points to %s and cannot hold a pointer to %s", + lval->identifier, + obj->runtime->structtypes.types[variable->structtype].name, + obj->runtime->structtypes.types[rval->structtype].name); + PASS(errctx, akbasic_value_clone(rval, slot)); + break; + } + FAIL_ZERO_RETURN(errctx, (rval->valuetype == AKBASIC_TYPE_STRUCT), AKBASIC_ERR_TYPE, + "Incompatible types in variable assignment"); + FAIL_ZERO_RETURN(errctx, (rval->structtype == variable->structtype), AKBASIC_ERR_TYPE, + "%s is a %s and cannot be assigned a %s", + lval->identifier, + obj->runtime->structtypes.types[variable->structtype].name, + obj->runtime->structtypes.types[rval->structtype].name); + PASS(errctx, akbasic_struct_copy(obj->runtime, variable->structtype, + rval->structbase, slot)); + *dest = slot; + SUCCEED_RETURN(errctx); case AKBASIC_LEAF_IDENTIFIER_INT: if ( rval->valuetype == AKBASIC_TYPE_INTEGER ) { PASS(errctx, akbasic_variable_set_integer(variable, rval->intval, subscripts, subscriptcount)); diff --git a/src/grammar.c b/src/grammar.c index d67577c..f7b313e 100644 --- a/src/grammar.c +++ b/src/grammar.c @@ -140,7 +140,8 @@ bool akbasic_leaf_is_identifier(akbasic_ASTLeaf *self) (self->leaftype == AKBASIC_LEAF_IDENTIFIER || self->leaftype == AKBASIC_LEAF_IDENTIFIER_INT || self->leaftype == AKBASIC_LEAF_IDENTIFIER_FLOAT || - self->leaftype == AKBASIC_LEAF_IDENTIFIER_STRING)); + self->leaftype == AKBASIC_LEAF_IDENTIFIER_STRING || + self->leaftype == AKBASIC_LEAF_IDENTIFIER_STRUCT)); } akbasic_Type akbasic_leaf_identifier_type(akbasic_ASTLeaf *self) @@ -155,6 +156,8 @@ akbasic_Type akbasic_leaf_identifier_type(akbasic_ASTLeaf *self) return AKBASIC_TYPE_FLOAT; case AKBASIC_LEAF_IDENTIFIER_STRING: return AKBASIC_TYPE_STRING; + case AKBASIC_LEAF_IDENTIFIER_STRUCT: + return AKBASIC_TYPE_STRUCT; default: /* A bare identifier is a label, and a label has no storage to fill. */ return AKBASIC_TYPE_UNDEFINED; @@ -338,6 +341,27 @@ akerr_ErrorContext *akbasic_leaf_new_identifier(akbasic_ASTLeaf *obj, akbasic_Le SUCCEED_RETURN(errctx); } +akerr_ErrorContext *akbasic_leaf_new_field(akbasic_ASTLeaf *obj, akbasic_ASTLeaf *base, const char *name, akbasic_TokenType operator_) +{ + PREPARE_ERROR(errctx); + + FAIL_ZERO_RETURN(errctx, (obj != NULL && base != NULL), AKERR_NULLPOINTER, + "NULL leaf in new_field"); + PASS(errctx, akbasic_leaf_init(obj, AKBASIC_LEAF_FIELD)); + PASS(errctx, copy_bounded(obj->identifier, name, "field name")); + /* + * The base hangs off `.left`, which is free for this leaf type and is where + * a unary leaf already keeps its operand. Deliberately not `.right` or + * `.expr`: this header's own note records three separate defects that came + * from giving one link field two meanings, and a field chain is the fourth + * thing that would have wanted one. + */ + obj->left = base; + base->parent = obj; + obj->operator_ = operator_; + SUCCEED_RETURN(errctx); +} + static const char *operator_to_str(akbasic_TokenType op) { switch ( op ) { @@ -386,7 +410,12 @@ akerr_ErrorContext *akbasic_leaf_to_string(akbasic_ASTLeaf *self, char *dest, si snprintf(dest, len, "%s", self->identifier); break; case AKBASIC_LEAF_IDENTIFIER_STRUCT: - snprintf(dest, len, "NOT IMPLEMENTED"); + snprintf(dest, len, "%s", self->identifier); + break; + case AKBASIC_LEAF_FIELD: + PASS(errctx, akbasic_leaf_to_string(self->left, sub1, sizeof(sub1))); + snprintf(dest, len, "%s%s%s", sub1, + (self->operator_ == AKBASIC_TOK_ARROW ? "->" : "."), self->identifier); break; case AKBASIC_LEAF_UNARY: PASS(errctx, akbasic_leaf_to_string(self->left, sub1, sizeof(sub1))); diff --git a/src/parser.c b/src/parser.c index 9b03165..cc68806 100644 --- a/src/parser.c +++ b/src/parser.c @@ -249,10 +249,17 @@ akerr_ErrorContext *akbasic_parser_assignment(akbasic_Parser *obj, akbasic_ASTLe akbasic_ASTLeaf *right = NULL; PASS(errctx, akbasic_parser_expression(obj, &identifier)); + /* + * A field access is assignable too, and it is not an identifier: the + * name on the left of the = is reached by walking a chain rather than by + * looking one name up. Both spellings continue into the = below. + */ if ( identifier == NULL || (identifier->leaftype != AKBASIC_LEAF_IDENTIFIER_INT && identifier->leaftype != AKBASIC_LEAF_IDENTIFIER_FLOAT && - identifier->leaftype != AKBASIC_LEAF_IDENTIFIER_STRING) ) { + identifier->leaftype != AKBASIC_LEAF_IDENTIFIER_STRING && + identifier->leaftype != AKBASIC_LEAF_IDENTIFIER_STRUCT && + identifier->leaftype != AKBASIC_LEAF_FIELD) ) { *dest = identifier; SUCCEED_RETURN(errctx); } @@ -623,19 +630,67 @@ static akerr_ErrorContext *function_call(akbasic_Parser *obj, akbasic_ASTLeaf ** SUCCEED_RETURN(errctx); } +/** + * @brief Consume a run of `.field` and `->field` after a primary. + * + * Left-associative, so `A@.B@.C#` reads as `(A@.B@).C#` and each step's base is + * the leaf before it. The two operators are kept apart all the way to the + * runtime rather than folded into one "field access", because which one was + * written is the whole of the strict-pointer rule: `.` requires a structure and + * `->` requires a pointer to one, and getting it wrong is an error rather than a + * convenience the interpreter silently absorbs. + */ +static akerr_ErrorContext *parse_field_chain(akbasic_Parser *obj, akbasic_ASTLeaf **expr) +{ + PREPARE_ERROR(errctx); + static const akbasic_TokenType ACCESSORS[] = { AKBASIC_TOK_DOT, AKBASIC_TOK_ARROW }; + /* + * A field name carries its own type suffix, exactly as a variable does, so + * the four suffixed identifier tokens are the whole set. A bare identifier + * is not among them: that spelling is a label everywhere else and a field + * with no suffix would have no type. + */ + static const akbasic_TokenType FIELDNAMES[] = { + AKBASIC_TOK_IDENTIFIER_INT, AKBASIC_TOK_IDENTIFIER_FLOAT, + AKBASIC_TOK_IDENTIFIER_STRING, AKBASIC_TOK_IDENTIFIER_STRUCT + }; + akbasic_ASTLeaf *field = NULL; + akbasic_Token *accessor = NULL; + akbasic_Token *name = NULL; + akbasic_TokenType op = AKBASIC_TOK_DOT; + + while ( akbasic_parser_match(obj, ACCESSORS, 2) ) { + PASS(errctx, akbasic_parser_previous(obj, &accessor)); + op = accessor->tokentype; + FAIL_ZERO_RETURN(errctx, akbasic_parser_match(obj, FIELDNAMES, 4), AKBASIC_ERR_SYNTAX, + "Expected a field name after %s", (op == AKBASIC_TOK_ARROW ? "->" : ".")); + PASS(errctx, akbasic_parser_previous(obj, &name)); + PASS(errctx, akbasic_parser_new_leaf(obj, &field)); + PASS(errctx, akbasic_leaf_new_field(field, *expr, name->lexeme, op)); + /* + * A field may itself be an array element -- `E@.DROPS#(2)` -- and the + * subscript list belongs to the field, not to the base, so it is + * collected here and onto the field leaf's own `.expr`. + */ + PASS(errctx, akbasic_parser_argument_list(obj, AKBASIC_TOK_ARRAY_SUBSCRIPT, true, &field->expr)); + *expr = field; + } + SUCCEED_RETURN(errctx); +} + akerr_ErrorContext *akbasic_parser_primary(akbasic_Parser *obj, akbasic_ASTLeaf **dest) { PREPARE_ERROR(errctx); static const akbasic_TokenType PRIMARIES[] = { AKBASIC_TOK_LITERAL_INT, AKBASIC_TOK_LITERAL_FLOAT, AKBASIC_TOK_LITERAL_STRING, AKBASIC_TOK_IDENTIFIER, AKBASIC_TOK_IDENTIFIER_STRING, AKBASIC_TOK_IDENTIFIER_FLOAT, - AKBASIC_TOK_IDENTIFIER_INT, AKBASIC_TOK_FUNCTION + AKBASIC_TOK_IDENTIFIER_INT, AKBASIC_TOK_FUNCTION, AKBASIC_TOK_IDENTIFIER_STRUCT }; akbasic_ASTLeaf *expr = NULL; akbasic_ASTLeaf *groupexpr = NULL; akbasic_Token *previous = NULL; - if ( akbasic_parser_match(obj, PRIMARIES, 8) ) { + if ( akbasic_parser_match(obj, PRIMARIES, 9) ) { PASS(errctx, akbasic_parser_previous(obj, &previous)); PASS(errctx, akbasic_parser_new_leaf(obj, &expr)); switch ( previous->tokentype ) { @@ -660,6 +715,10 @@ akerr_ErrorContext *akbasic_parser_primary(akbasic_Parser *obj, akbasic_ASTLeaf PASS(errctx, akbasic_leaf_new_identifier(expr, AKBASIC_LEAF_IDENTIFIER_STRING, previous->lexeme)); PASS(errctx, akbasic_parser_argument_list(obj, AKBASIC_TOK_ARRAY_SUBSCRIPT, true, &expr->expr)); break; + case AKBASIC_TOK_IDENTIFIER_STRUCT: + PASS(errctx, akbasic_leaf_new_identifier(expr, AKBASIC_LEAF_IDENTIFIER_STRUCT, previous->lexeme)); + PASS(errctx, akbasic_parser_argument_list(obj, AKBASIC_TOK_ARRAY_SUBSCRIPT, true, &expr->expr)); + break; case AKBASIC_TOK_FUNCTION: case AKBASIC_TOK_IDENTIFIER: PASS(errctx, akbasic_leaf_new_identifier(expr, AKBASIC_LEAF_IDENTIFIER, previous->lexeme)); @@ -667,6 +726,7 @@ akerr_ErrorContext *akbasic_parser_primary(akbasic_Parser *obj, akbasic_ASTLeaf default: FAIL_RETURN(errctx, AKBASIC_ERR_SYNTAX, "Invalid literal type, command or function name"); } + PASS(errctx, parse_field_chain(obj, &expr)); *dest = expr; SUCCEED_RETURN(errctx); } diff --git a/src/parser_commands.c b/src/parser_commands.c index 48b5475..4c4ab1c 100644 --- a/src/parser_commands.c +++ b/src/parser_commands.c @@ -11,6 +11,7 @@ #include #include +#include #include @@ -553,11 +554,67 @@ akerr_ErrorContext *akbasic_parse_label(akbasic_Parser *parser, akbasic_ASTLeaf SUCCEED_RETURN(errctx); } -akerr_ErrorContext *akbasic_parse_dim(akbasic_Parser *parser, akbasic_ASTLeaf **dest) +/** + * @brief `DIM NAME(SIZES)`, or `DIM NAME@ AS TYPE` / `DIM NAME@ AS PTR TO TYPE`. + * + * The `AS` clause is read here and parked on the *command* leaf: `literal_string` + * takes the type name and `literal_int` records whether `PTR TO` was written. + * Both fields are free on a command leaf, which is the same reasoning the field + * leaf uses for `.left` -- this file's header note about three defects from one + * overloaded link field is about giving a field two meanings on the *same* leaf + * type, not about using an unused one. + * + * `AS`, `PTR` and `TO` are matched by lexeme rather than promoted to keywords. + * Making them reserved words would break any existing program with a variable + * called `AS#`, and they are only meaningful in this one position. + */ +/** + * @brief `TYPE NAME`, whose body was already read by the prescan. + * + * Only the opening line is ever parsed: the verb jumps past its own `END TYPE`, + * so the field lines never reach the parser at all. That is deliberate -- a + * field line is a declaration, and `W#` on its own would otherwise evaluate as a + * bare identifier and quietly create a global called `W#`. + */ +akerr_ErrorContext *akbasic_parse_type(akbasic_Parser *parser, akbasic_ASTLeaf **dest) { PREPARE_ERROR(errctx); + PASS(errctx, parse_verb_with_identifier(parser, "TYPE", dest)); + SUCCEED_RETURN(errctx); +} + +akerr_ErrorContext *akbasic_parse_dim(akbasic_Parser *parser, akbasic_ASTLeaf **dest) +{ + PREPARE_ERROR(errctx); + akbasic_ASTLeaf *command = NULL; + akbasic_Token *word = NULL; + PASS(errctx, parse_verb_with_identifier(parser, "DIM", dest)); + command = *dest; + + if ( !akbasic_parser_match1(parser, AKBASIC_TOK_IDENTIFIER) ) { + SUCCEED_RETURN(errctx); + } + PASS(errctx, akbasic_parser_previous(parser, &word)); + FAIL_ZERO_RETURN(errctx, (strcasecmp(word->lexeme, "AS") == 0), AKBASIC_ERR_SYNTAX, + "Expected AS after DIM %s, not %s", command->right->identifier, word->lexeme); + + FAIL_ZERO_RETURN(errctx, akbasic_parser_match1(parser, AKBASIC_TOK_IDENTIFIER), + AKBASIC_ERR_SYNTAX, "Expected a type name after AS"); + PASS(errctx, akbasic_parser_previous(parser, &word)); + if ( strcasecmp(word->lexeme, "PTR") == 0 ) { + command->literal_int = 1; + FAIL_ZERO_RETURN(errctx, akbasic_parser_match1(parser, AKBASIC_TOK_IDENTIFIER), + AKBASIC_ERR_SYNTAX, "Expected TO after PTR"); + PASS(errctx, akbasic_parser_previous(parser, &word)); + FAIL_ZERO_RETURN(errctx, (strcasecmp(word->lexeme, "TO") == 0), AKBASIC_ERR_SYNTAX, + "Expected PTR TO TYPENAME, not PTR %s", word->lexeme); + FAIL_ZERO_RETURN(errctx, akbasic_parser_match1(parser, AKBASIC_TOK_IDENTIFIER), + AKBASIC_ERR_SYNTAX, "Expected a type name after PTR TO"); + PASS(errctx, akbasic_parser_previous(parser, &word)); + } + snprintf(command->literal_string, sizeof(command->literal_string), "%s", word->lexeme); SUCCEED_RETURN(errctx); } diff --git a/src/runtime.c b/src/runtime.c index 4e5b840..a056ee5 100644 --- a/src/runtime.c +++ b/src/runtime.c @@ -30,6 +30,13 @@ akerr_ErrorContext *akbasic_runtime_new_variable(akbasic_Runtime *obj, akbasic_V if ( !obj->variables[i].used ) { memset(&obj->variables[i], 0, sizeof(obj->variables[i])); obj->variables[i].used = true; + /* + * Not zero: zero is a valid structure type index, so a memset alone + * would hand back a fresh variable already claiming to be the first + * TYPE the program declared -- and `DIM P@ AS RECT` would then refuse + * it as a re-DIM of something never DIMmed at all. + */ + obj->variables[i].structtype = -1; *dest = &obj->variables[i]; SUCCEED_RETURN(errctx); } @@ -345,14 +352,53 @@ akerr_ErrorContext *akbasic_runtime_set_mode(akbasic_Runtime *obj, int mode) * argv takes, where the program does not exist yet when start() is called. */ if ( obj->mode == AKBASIC_MODE_RUN && obj->environment != NULL ) { - PASS(errctx, akbasic_runtime_scan_labels(obj)); /* - * And the DATA items, for the same reason and at the same moment: READ - * walks a cursor along a list built before the program runs, so a DATA - * line *before* its READ is found -- which it was not when READ skipped - * forward looking for one. + * All three prescans, and all three inside one ATTEMPT. + * + * **A prescan failure is the program's mistake, not the host's**, so it + * has to leave here as a BASIC error line rather than as a raised + * context -- goal 3, the same boundary process_line_run() draws around + * parsing. Without this a malformed TYPE printed a stack trace and took + * the driver with it, which is exactly what section 8 records for the + * scanner on a path this one would otherwise have joined. + * + * It matters most for TYPE because a mistyped declaration is an ordinary + * thing to write; labels and DATA are wrapped with it because they can + * fail too and there is no reason for three different answers. */ - PASS(errctx, akbasic_data_scan(obj)); + ATTEMPT { + /* + * Labels first, filed here rather than in any one of the several + * places that start a run. Every one of them -- + * akbasic_runtime_start(), RUN, CONT, and the end of a RUNSTREAM + * load -- arrives through this function, and the last of those is + * the one a driver reading a file from argv takes, where the program + * does not exist yet when start() is called. + */ + CATCH(errctx, akbasic_runtime_scan_labels(obj)); + /* + * Then the DATA items, for the same reason: READ walks a cursor + * along a list built before the program runs, so a DATA line + * *before* its READ is found -- which it was not when READ skipped + * forward looking for one. + */ + CATCH(errctx, akbasic_data_scan(obj)); + /* + * Then the TYPE declarations, for the third time and the same + * reason: a declaration has to be in effect wherever control goes, + * so `DIM P@ AS RECT` cannot run before RECT exists even if a branch + * skipped the lines that declared it. + */ + CATCH(errctx, akbasic_structtype_scan(obj)); + } CLEANUP { + } PROCESS(errctx) { + } HANDLE_DEFAULT(errctx) { + char message[AKERR_MAX_ERROR_CONTEXT_STRING_LENGTH]; + snprintf(message, sizeof(message), "%s", errctx->message); + obj->lasterrorstatus = errctx->status; + IGNORE(akbasic_runtime_error(obj, AKBASIC_ERRCLASS_PARSE, message)); + IGNORE(akbasic_runtime_set_mode(obj, obj->run_finished_mode)); + } FINISH(errctx, false); } SUCCEED_RETURN(errctx); } @@ -423,6 +469,26 @@ static akerr_ErrorContext *evaluate_identifier(akbasic_Runtime *obj, akbasic_AST "Identifier %s is undefined", expr->identifier); PASS(errctx, akbasic_variable_get_subscript(variable, subscripts, subscriptcount, &slot)); + /* + * A structure variable's *slots are* the instance, so what an expression + * gets is a description of where it lives rather than a copy of it -- one + * value cannot hold a run of them. Assignment is what turns that + * description into a copy, which is the one place a copy was actually asked + * for. + */ + if ( variable->valuetype == AKBASIC_TYPE_STRUCT && variable->structtype >= 0 ) { + PASS(errctx, akbasic_environment_new_value(obj->environment, ©)); + PASS(errctx, akbasic_struct_describe(obj, variable->structtype, slot, + variable->ispointer, copy)); + if ( variable->ispointer ) { + /* A pointer variable holds its reference in its own slot. */ + copy->structtype = slot->structtype; + copy->structbase = slot->structbase; + } + *dest = copy; + SUCCEED_RETURN(errctx); + } + if ( !obj->eval_clone_identifiers ) { *dest = slot; SUCCEED_RETURN(errctx); @@ -568,6 +634,7 @@ akerr_ErrorContext *akbasic_runtime_evaluate(akbasic_Runtime *obj, akbasic_ASTLe case AKBASIC_LEAF_IDENTIFIER_INT: case AKBASIC_LEAF_IDENTIFIER_FLOAT: case AKBASIC_LEAF_IDENTIFIER_STRING: + case AKBASIC_LEAF_IDENTIFIER_STRUCT: PASS(errctx, evaluate_identifier(obj, expr, dest)); SUCCEED_RETURN(errctx); @@ -624,6 +691,10 @@ akerr_ErrorContext *akbasic_runtime_evaluate(akbasic_Runtime *obj, akbasic_ASTLe PASS(errctx, verb->exec(obj, expr, lval, rval, dest)); SUCCEED_RETURN(errctx); + case AKBASIC_LEAF_FIELD: + PASS(errctx, akbasic_struct_evaluate_field(obj, expr, dest)); + SUCCEED_RETURN(errctx); + case AKBASIC_LEAF_BINARY: PASS(errctx, evaluate_binary(obj, expr, dest)); SUCCEED_RETURN(errctx); diff --git a/src/runtime_commands.c b/src/runtime_commands.c index f071c6b..86af933 100644 --- a/src/runtime_commands.c +++ b/src/runtime_commands.c @@ -88,7 +88,22 @@ akerr_ErrorContext *akbasic_cmd_print(akbasic_Runtime *obj, akbasic_ASTLeaf *exp } PASS(errctx, akbasic_runtime_evaluate(obj, expr->right, dest)); - PASS(errctx, akbasic_value_to_string(*dest, rendered, sizeof(rendered))); + /* + * A structure renders through the type table rather than through + * akbasic_value_to_string(), which sees one slot and cannot know an instance + * is a run of them. Split out here rather than pushed down into value.c, + * because value.c deliberately knows nothing about the runtime. + */ + if ( (*dest)->valuetype == AKBASIC_TYPE_STRUCT || (*dest)->valuetype == AKBASIC_TYPE_POINTER ) { + if ( (*dest)->structbase == NULL ) { + snprintf(rendered, sizeof(rendered), "NOTHING"); + } else { + PASS(errctx, akbasic_struct_to_string(obj, (*dest)->structtype, (*dest)->structbase, + 0, rendered, sizeof(rendered))); + } + } else { + PASS(errctx, akbasic_value_to_string(*dest, rendered, sizeof(rendered))); + } PASS(errctx, akbasic_runtime_println(obj, rendered)); SUCCEED_TRUE(obj, dest); SUCCEED_RETURN(errctx); @@ -255,6 +270,57 @@ akerr_ErrorContext *akbasic_cmd_auto(akbasic_Runtime *obj, akbasic_ASTLeaf *expr SUCCEED_RETURN(errctx); } +/** + * @brief `DIM NAME@ AS TYPE`, or `DIM NAME@ AS PTR TO TYPE`. + * + * A value takes one run of slots sized by the type. A pointer takes one slot, + * whatever it ends up pointing at -- it holds a reference, and a reference is + * one value wide however large the thing on the other end is. + */ +static akerr_ErrorContext *dim_structure(akbasic_Runtime *obj, akbasic_ASTLeaf *expr) +{ + PREPARE_ERROR(errctx); + akbasic_Variable *variable = NULL; + int64_t sizes[1] = { 1 }; + int typeindex = -1; + bool ispointer = (expr->literal_int != 0); + + FAIL_ZERO_RETURN(errctx, + (expr->right->leaftype == AKBASIC_LEAF_IDENTIFIER_STRUCT), + AKBASIC_ERR_TYPE, + "DIM ... AS declares a structure, so %s must end in @", + expr->right->identifier); + PASS(errctx, akbasic_structtype_find(&obj->structtypes, expr->literal_string, &typeindex)); + FAIL_ZERO_RETURN(errctx, (typeindex >= 0), AKBASIC_ERR_UNDEFINED, + "TYPE %s is not declared", expr->literal_string); + + PASS(errctx, akbasic_environment_get(obj->environment, expr->right->identifier, &variable)); + FAIL_ZERO_RETURN(errctx, (variable != NULL), AKBASIC_ERR_UNDEFINED, + "Unable to get variable for identifier %s", expr->right->identifier); + /* + * Re-DIMming a structure is refused rather than allowed to grow. The value + * pool never frees, so a growing re-DIM abandons its old slots -- and a + * pointer still aimed at them would go on reading the abandoned copy, which + * is stale rather than wild but wrong either way. Nothing needs it. + */ + FAIL_NONZERO_RETURN(errctx, (variable->structtype >= 0), AKBASIC_ERR_STATE, + "%s is already DIMmed as a structure and cannot be re-DIMmed", + expr->right->identifier); + + sizes[0] = (ispointer ? 1 : obj->structtypes.types[typeindex].slotcount); + PASS(errctx, akbasic_variable_init(variable, &obj->valuepool, sizes, 1)); + variable->valuetype = AKBASIC_TYPE_STRUCT; + variable->structtype = typeindex; + variable->ispointer = ispointer; + if ( ispointer ) { + PASS(errctx, akbasic_value_zero(&variable->values[0])); + variable->values[0].valuetype = AKBASIC_TYPE_POINTER; + variable->values[0].structtype = typeindex; + variable->values[0].structbase = NULL; + } + SUCCEED_RETURN(errctx); +} + akerr_ErrorContext *akbasic_cmd_dim(akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest) { PREPARE_ERROR(errctx); @@ -265,11 +331,26 @@ akerr_ErrorContext *akbasic_cmd_dim(akbasic_Runtime *obj, akbasic_ASTLeaf *expr, int sizecount = 0; (void)lval; (void)rval; + FAIL_ZERO_RETURN(errctx, (expr != NULL && expr->right != NULL && + akbasic_leaf_is_identifier(expr->right)), + AKBASIC_ERR_SYNTAX, "Expected DIM IDENTIFIER(DIMENSIONS, ...)"); + + /* + * `DIM P@ AS RECT` takes a run of slots sized by the type, which is the same + * thing `DIM A#(10)` does and deliberately so: a declared TYPE has a known + * slot count, so an instance is laid out exactly as an array is and needs no + * pool of its own. + */ + if ( expr->literal_string[0] != '\0' ) { + PASS(errctx, dim_structure(obj, expr)); + SUCCEED_TRUE(obj, dest); + SUCCEED_RETURN(errctx); + } + FAIL_ZERO_RETURN(errctx, - (expr != NULL && expr->right != NULL && expr->right->expr != NULL && + (expr->right->expr != NULL && expr->right->expr->leaftype == AKBASIC_LEAF_ARGUMENTLIST && - expr->right->expr->operator_ == AKBASIC_TOK_ARRAY_SUBSCRIPT && - akbasic_leaf_is_identifier(expr->right)), + expr->right->expr->operator_ == AKBASIC_TOK_ARRAY_SUBSCRIPT), AKBASIC_ERR_SYNTAX, "Expected DIM IDENTIFIER(DIMENSIONS, ...)"); PASS(errctx, akbasic_environment_get(obj->environment, expr->right->identifier, &variable)); diff --git a/src/runtime_struct.c b/src/runtime_struct.c new file mode 100644 index 0000000..001cf8e --- /dev/null +++ b/src/runtime_struct.c @@ -0,0 +1,255 @@ +/** + * @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 +#include +#include + +#include + +#include +#include +#include + +#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) +{ + 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; + } + *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; + + PASS(errctx, akbasic_struct_resolve(obj, expr, &field, &slot)); + + /* + * 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)); + *dest = out; + SUCCEED_RETURN(errctx); + } + *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; + size_t used = 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]; + + 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 ) { + snprintf(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; + } + written = snprintf(dest + used, len - used, "%s%s=%s", + (i == 0 ? "" : ", "), field->name, rendered); + if ( written < 0 || (size_t)written >= len - used ) { + break; + } + used += (size_t)written; + } + if ( used + 1 < len ) { + snprintf(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); +} diff --git a/src/scanner.c b/src/scanner.c index 6ca8d2e..93043a4 100644 --- a/src/scanner.c +++ b/src/scanner.c @@ -335,11 +335,25 @@ akerr_ErrorContext *akbasic_scanner_scan(akbasic_Runtime *obj, const char *line, case '(': obj->tokentype = AKBASIC_TOK_LEFT_PAREN; break; case ')': obj->tokentype = AKBASIC_TOK_RIGHT_PAREN; break; case '+': obj->tokentype = AKBASIC_TOK_PLUS; break; - case '-': obj->tokentype = AKBASIC_TOK_MINUS; break; + /* + * `->` reaches a field through a pointer, so a minus has to look ahead + * one character before it can call itself a minus. Nothing else in the + * language begins `->`, and `A# - >` is not an expression, so there is + * no spelling this makes ambiguous. + */ + case '-': + (void)match_next_char(obj, '>', AKBASIC_TOK_ARROW, AKBASIC_TOK_MINUS); + break; case '/': obj->tokentype = AKBASIC_TOK_LEFT_SLASH; break; case '*': obj->tokentype = AKBASIC_TOK_STAR; break; case ',': obj->tokentype = AKBASIC_TOK_COMMA; break; case ':': obj->tokentype = AKBASIC_TOK_COLON; break; + /* + * A field separator. It only reaches this switch when it is *not* part + * of a number: match_number() is entered on a digit and consumes its own + * decimal point, so `1.5` never gets here and `P@.X#` always does. + */ + case '.': obj->tokentype = AKBASIC_TOK_DOT; break; /* * MOVSPR's two separators. Both were UNKNOWN TOKEN until sprites, so * scanning them breaks nothing -- and a `#` only reaches this switch diff --git a/src/structtype.c b/src/structtype.c new file mode 100644 index 0000000..e96c806 --- /dev/null +++ b/src/structtype.c @@ -0,0 +1,431 @@ +/** + * @file structtype.c + * @brief Implements the `TYPE` table and the prescan that fills it. + * + * The prescan is textual and runs before the program does, exactly as the label + * and `DATA` prescans do and for the same reason: a declaration has to be in + * effect wherever control goes, including when a branch skips the lines that + * made it. + * + * **It is three passes, and each one exists for a case that cannot be done in + * the pass before it.** Pass 1 registers names and line ranges, so a field can + * name a type declared further down the program. Pass 2 parses field lists, now + * able to resolve every type reference. Pass 3 computes sizes and offsets by + * repeated resolution, because a type nested by value must know its own size + * before its container can -- and a group of types that never resolve is + * precisely a cycle of by-value containment, which is what makes "a TYPE cannot + * contain itself by value" a diagnosis rather than an assumption. + */ + +#include +#include +#include +#include + +#include + +#include +#include +#include + +/** @brief Step over spaces and tabs. */ +static const char *skip_space(const char *cursor) +{ + while ( *cursor != '\0' && isspace((unsigned char)*cursor) ) { + cursor += 1; + } + return cursor; +} + +/** + * @brief Step over a stored line's own line number, if it still carries one. + * + * A line arrives either from akbasic_runtime_load(), which files what the + * scanner already stripped, or from RUNSTREAM, which files the raw text. Both + * spellings are real, so both are handled here -- the same allowance + * scan_line_labels() makes. + */ +static const char *skip_lineno(const char *cursor) +{ + cursor = skip_space(cursor); + if ( isdigit((unsigned char)*cursor) ) { + while ( isdigit((unsigned char)*cursor) ) { + cursor += 1; + } + } + return skip_space(cursor); +} + +/** @brief Copy the next whitespace-delimited word, uppercased. Empty when the line ends. */ +static const char *next_word(const char *cursor, char *dest, size_t len) +{ + size_t used = 0; + + dest[0] = '\0'; + cursor = skip_space(cursor); + while ( *cursor != '\0' && !isspace((unsigned char)*cursor) ) { + if ( used + 1 < len ) { + dest[used] = (char)toupper((unsigned char)*cursor); + used += 1; + } + cursor += 1; + } + dest[used] = '\0'; + return cursor; +} + +/** @brief Compare a word against a keyword. Verbs are case-insensitive here as everywhere. */ +static bool word_is(const char *word, const char *keyword) +{ + return (strcmp(word, keyword) == 0); +} + +/** + * @brief The type a field name's suffix declares. + * + * The same rule every other name in the language follows, which is the reason a + * field list needs no type column: `W#` is an integer because it says so. + */ +static akerr_ErrorContext *type_from_suffix(const char *name, akbasic_Type *dest) +{ + PREPARE_ERROR(errctx); + size_t len = strlen(name); + + FAIL_ZERO_RETURN(errctx, (len >= 2), AKBASIC_ERR_SYNTAX, + "Field name \"%s\" carries no type suffix", name); + switch ( name[len - 1] ) { + case '#': *dest = AKBASIC_TYPE_INTEGER; break; + case '%': *dest = AKBASIC_TYPE_FLOAT; break; + case '$': *dest = AKBASIC_TYPE_STRING; break; + case '@': *dest = AKBASIC_TYPE_STRUCT; break; + default: + FAIL_RETURN(errctx, AKBASIC_ERR_SYNTAX, + "Field name \"%s\" carries no type suffix (# integer, %% float, $ string, @ structure)", + name); + } + SUCCEED_RETURN(errctx); +} + +akerr_ErrorContext *akbasic_structtype_table_init(akbasic_StructTypeTable *obj) +{ + PREPARE_ERROR(errctx); + + FAIL_ZERO_RETURN(errctx, (obj != NULL), AKERR_NULLPOINTER, "NULL table in structtype init"); + memset(obj, 0, sizeof(*obj)); + obj->count = 0; + SUCCEED_RETURN(errctx); +} + +akerr_ErrorContext *akbasic_structtype_find(akbasic_StructTypeTable *obj, const char *name, int *dest) +{ + PREPARE_ERROR(errctx); + int i = 0; + + FAIL_ZERO_RETURN(errctx, (obj != NULL && name != NULL && dest != NULL), AKERR_NULLPOINTER, + "NULL argument in structtype find"); + *dest = -1; + for ( i = 0; i < obj->count; i++ ) { + if ( obj->types[i].used && strcmp(obj->types[i].name, name) == 0 ) { + *dest = i; + SUCCEED_RETURN(errctx); + } + } + SUCCEED_RETURN(errctx); +} + +akerr_ErrorContext *akbasic_structtype_field(akbasic_StructTypeTable *obj, int typeindex, const char *name, akbasic_StructField **dest) +{ + PREPARE_ERROR(errctx); + char known[AKBASIC_MAX_STRING_LENGTH]; + akbasic_StructType *type = NULL; + size_t used = 0; + int i = 0; + + FAIL_ZERO_RETURN(errctx, (obj != NULL && name != NULL && dest != NULL), AKERR_NULLPOINTER, + "NULL argument in structtype field"); + FAIL_ZERO_RETURN(errctx, (typeindex >= 0 && typeindex < obj->count), AKBASIC_ERR_BOUNDS, + "Structure type index %d is outside 0..%d", typeindex, obj->count - 1); + type = &obj->types[typeindex]; + + for ( i = 0; i < type->fieldcount; i++ ) { + if ( strcmp(type->fields[i].name, name) == 0 ) { + *dest = &type->fields[i]; + SUCCEED_RETURN(errctx); + } + } + + /* + * List what the type does have. The only reason a misspelled field can be + * caught at all is that the set is closed and the program wrote it down, so + * the diagnostic may as well show it -- this is the message that turns "why + * is my total zero" into a one-line fix. + */ + known[0] = '\0'; + for ( i = 0; i < type->fieldcount; i++ ) { + int written = snprintf(known + used, sizeof(known) - used, "%s%s", + (i == 0 ? "" : ", "), type->fields[i].name); + if ( written < 0 || (size_t)written >= sizeof(known) - used ) { + break; + } + used += (size_t)written; + } + FAIL_RETURN(errctx, AKBASIC_ERR_UNDEFINED, "%s has no field %s (%s)", + type->name, name, (type->fieldcount > 0 ? known : "it has none")); +} + +akerr_ErrorContext *akbasic_structtype_block_at(akbasic_StructTypeTable *obj, int64_t lineno, int *dest) +{ + PREPARE_ERROR(errctx); + int i = 0; + + FAIL_ZERO_RETURN(errctx, (obj != NULL && dest != NULL), AKERR_NULLPOINTER, + "NULL argument in structtype block_at"); + *dest = -1; + for ( i = 0; i < obj->count; i++ ) { + if ( obj->types[i].used && obj->types[i].firstline == lineno ) { + *dest = i; + SUCCEED_RETURN(errctx); + } + } + SUCCEED_RETURN(errctx); +} + +/* ----------------------------------------------------------------- pass 1 -- */ + +/** + * @brief Register every type's name and line range. + * + * Names first and fields later, so a field may name a type declared further down + * the program. A linked list needs that even for itself -- `NEXT@ AS PTR TO + * NODE` inside `TYPE NODE` refers to a type that is not finished being read. + */ +static akerr_ErrorContext *scan_names(akbasic_Runtime *obj) +{ + PREPARE_ERROR(errctx); + akbasic_StructTypeTable *table = &obj->structtypes; + char word[AKBASIC_MAX_STRUCT_NAME]; + char name[AKBASIC_MAX_STRUCT_NAME]; + const char *cursor = NULL; + int64_t i = 0; + int open = -1; + int existing = 0; + + for ( i = 0; i < AKBASIC_MAX_SOURCE_LINES; i++ ) { + if ( obj->source[i].code[0] == '\0' ) { + continue; + } + cursor = next_word(skip_lineno(obj->source[i].code), word, sizeof(word)); + + if ( word_is(word, "END") ) { + (void)next_word(cursor, name, sizeof(name)); + if ( !word_is(name, "TYPE") ) { + continue; /* an ordinary END, not our terminator */ + } + FAIL_ZERO_RETURN(errctx, (open >= 0), AKBASIC_ERR_SYNTAX, + "END TYPE on line %" PRId64 " closes nothing", i); + table->types[open].lastline = i; + open = -1; + continue; + } + if ( !word_is(word, "TYPE") ) { + continue; + } + + FAIL_ZERO_RETURN(errctx, (open < 0), AKBASIC_ERR_SYNTAX, + "TYPE on line %" PRId64 " opens inside %s, which is not closed", + i, table->types[open].name); + (void)next_word(cursor, name, sizeof(name)); + FAIL_ZERO_RETURN(errctx, (name[0] != '\0'), AKBASIC_ERR_SYNTAX, + "TYPE on line %" PRId64 " has no name", i); + PASS(errctx, akbasic_structtype_find(table, name, &existing)); + FAIL_NONZERO_RETURN(errctx, (existing >= 0), AKBASIC_ERR_VALUE, + "TYPE %s is declared twice", name); + FAIL_ZERO_RETURN(errctx, (table->count < AKBASIC_MAX_STRUCT_TYPES), AKBASIC_ERR_BOUNDS, + "More than %d TYPE declarations", AKBASIC_MAX_STRUCT_TYPES); + + open = table->count; + memset(&table->types[open], 0, sizeof(table->types[open])); + strncpy(table->types[open].name, name, sizeof(table->types[open].name) - 1); + table->types[open].used = true; + table->types[open].firstline = i; + table->types[open].lastline = -1; + table->types[open].slotcount = -1; /* unresolved until pass 3 */ + table->count += 1; + } + + FAIL_NONZERO_RETURN(errctx, (open >= 0), AKBASIC_ERR_SYNTAX, + "TYPE %s is never closed with END TYPE", table->types[open >= 0 ? open : 0].name); + SUCCEED_RETURN(errctx); +} + +/* ----------------------------------------------------------------- pass 2 -- */ + +/** @brief Parse one field declaration line into a descriptor. */ +static akerr_ErrorContext *parse_field(akbasic_StructTypeTable *table, akbasic_StructType *type, + const char *line, int64_t lineno) +{ + PREPARE_ERROR(errctx); + char fieldname[AKBASIC_MAX_STRUCT_NAME]; + char word[AKBASIC_MAX_STRUCT_NAME]; + const char *cursor = NULL; + akbasic_StructField *field = NULL; + akbasic_Type valuetype = AKBASIC_TYPE_UNDEFINED; + int referenced = 0; + int i = 0; + + cursor = next_word(skip_lineno(line), fieldname, sizeof(fieldname)); + if ( fieldname[0] == '\0' || fieldname[0] == '\'' ) { + SUCCEED_RETURN(errctx); /* a blank line inside the block */ + } + if ( word_is(fieldname, "REM") ) { + SUCCEED_RETURN(errctx); + } + + FAIL_ZERO_RETURN(errctx, (type->fieldcount < AKBASIC_MAX_STRUCT_FIELDS), AKBASIC_ERR_BOUNDS, + "TYPE %s declares more than %d fields", type->name, AKBASIC_MAX_STRUCT_FIELDS); + for ( i = 0; i < type->fieldcount; i++ ) { + FAIL_NONZERO_RETURN(errctx, (strcmp(type->fields[i].name, fieldname) == 0), + AKBASIC_ERR_VALUE, + "TYPE %s declares %s twice", type->name, fieldname); + } + + PASS(errctx, type_from_suffix(fieldname, &valuetype)); + field = &type->fields[type->fieldcount]; + memset(field, 0, sizeof(*field)); + strncpy(field->name, fieldname, sizeof(field->name) - 1); + field->valuetype = valuetype; + field->typeindex = -1; + field->offset = -1; + + if ( valuetype != AKBASIC_TYPE_STRUCT ) { + /* A primitive needs no more words, and anything after it is a typo. */ + cursor = next_word(cursor, word, sizeof(word)); + FAIL_NONZERO_RETURN(errctx, (word[0] != '\0'), AKBASIC_ERR_SYNTAX, + "Line %" PRId64 ": %s is a %s field and takes no AS clause", + lineno, fieldname, + (valuetype == AKBASIC_TYPE_INTEGER ? "integer" : + valuetype == AKBASIC_TYPE_FLOAT ? "float" : "string")); + field->kind = AKBASIC_FIELD_PRIMITIVE; + field->slotcount = 1; + type->fieldcount += 1; + SUCCEED_RETURN(errctx); + } + + /* + * An `@` field is a structure, and `@` alone does not say which -- three + * primitive types fit in three suffix characters and N declared types do + * not fit in one. So the declaration has to name it. + */ + cursor = next_word(cursor, word, sizeof(word)); + FAIL_ZERO_RETURN(errctx, word_is(word, "AS"), AKBASIC_ERR_SYNTAX, + "Line %" PRId64 ": %s must name its type -- %s AS TYPENAME, or %s AS PTR TO TYPENAME", + lineno, fieldname, fieldname, fieldname); + cursor = next_word(cursor, word, sizeof(word)); + if ( word_is(word, "PTR") ) { + cursor = next_word(cursor, word, sizeof(word)); + FAIL_ZERO_RETURN(errctx, word_is(word, "TO"), AKBASIC_ERR_SYNTAX, + "Line %" PRId64 ": expected PTR TO TYPENAME", lineno); + cursor = next_word(cursor, word, sizeof(word)); + field->kind = AKBASIC_FIELD_POINTER; + field->valuetype = AKBASIC_TYPE_POINTER; + field->slotcount = 1; /* a reference, whatever it points at */ + } else { + field->kind = AKBASIC_FIELD_STRUCT; + field->slotcount = -1; /* the nested type's size, in pass 3 */ + } + + FAIL_ZERO_RETURN(errctx, (word[0] != '\0'), AKBASIC_ERR_SYNTAX, + "Line %" PRId64 ": %s names no type", lineno, fieldname); + PASS(errctx, akbasic_structtype_find(table, word, &referenced)); + FAIL_ZERO_RETURN(errctx, (referenced >= 0), AKBASIC_ERR_UNDEFINED, + "Line %" PRId64 ": %s names TYPE %s, which is not declared", + lineno, fieldname, word); + field->typeindex = referenced; + type->fieldcount += 1; + SUCCEED_RETURN(errctx); +} + +/* ----------------------------------------------------------------- pass 3 -- */ + +/** + * @brief Resolve sizes and offsets, and diagnose by-value recursion. + * + * A type whose fields are all sized can be sized. Repeating that until nothing + * changes resolves every legal arrangement however the declarations were + * ordered -- and whatever is left unresolved is a group of types that contain + * each other by value, which has no finite size. That is the diagnosis rather + * than a stack overflow later. + */ +static akerr_ErrorContext *resolve_sizes(akbasic_StructTypeTable *table) +{ + PREPARE_ERROR(errctx); + bool progress = true; + int i = 0; + int f = 0; + + while ( progress ) { + progress = false; + for ( i = 0; i < table->count; i++ ) { + akbasic_StructType *type = &table->types[i]; + int offset = 0; + bool ready = true; + + if ( type->slotcount >= 0 ) { + continue; + } + for ( f = 0; f < type->fieldcount; f++ ) { + akbasic_StructField *field = &type->fields[f]; + if ( field->kind == AKBASIC_FIELD_STRUCT ) { + if ( table->types[field->typeindex].slotcount < 0 ) { + ready = false; + break; + } + field->slotcount = table->types[field->typeindex].slotcount; + } + field->offset = offset; + offset += field->slotcount; + } + if ( ready ) { + type->slotcount = offset; + progress = true; + } + } + } + + for ( i = 0; i < table->count; i++ ) { + FAIL_NONZERO_RETURN(errctx, (table->types[i].slotcount < 0), AKBASIC_ERR_VALUE, + "TYPE %s contains itself by value, so it has no size. " + "A type may only refer to itself through PTR TO", + table->types[i].name); + FAIL_NONZERO_RETURN(errctx, (table->types[i].slotcount == 0), AKBASIC_ERR_VALUE, + "TYPE %s declares no fields", table->types[i].name); + } + SUCCEED_RETURN(errctx); +} + +akerr_ErrorContext *akbasic_structtype_scan(akbasic_Runtime *obj) +{ + PREPARE_ERROR(errctx); + akbasic_StructTypeTable *table = NULL; + int64_t i = 0; + int t = 0; + + FAIL_ZERO_RETURN(errctx, (obj != NULL), AKERR_NULLPOINTER, "NULL runtime in structtype scan"); + table = &obj->structtypes; + PASS(errctx, akbasic_structtype_table_init(table)); + + PASS(errctx, scan_names(obj)); + + for ( t = 0; t < table->count; t++ ) { + akbasic_StructType *type = &table->types[t]; + for ( i = type->firstline + 1; i < type->lastline; i++ ) { + if ( obj->source[i].code[0] == '\0' ) { + continue; + } + PASS(errctx, parse_field(table, type, obj->source[i].code, i)); + } + } + + PASS(errctx, resolve_sizes(table)); + SUCCEED_RETURN(errctx); +} diff --git a/src/value.c b/src/value.c index e111fa4..66930ce 100644 --- a/src/value.c +++ b/src/value.c @@ -59,15 +59,17 @@ static const char *TYPE_NAMES[] = { "an integer", /* AKBASIC_TYPE_INTEGER */ "a float", /* AKBASIC_TYPE_FLOAT */ "a string", /* AKBASIC_TYPE_STRING */ - "a truth value" /* AKBASIC_TYPE_BOOLEAN */ + "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_BOOLEAN + 1) ? 1 : -1]; + [(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_BOOLEAN ) { + if ( valuetype < 0 || valuetype > AKBASIC_TYPE_POINTER ) { return "a value of unknown type"; } return TYPE_NAMES[valuetype]; @@ -182,6 +184,8 @@ akerr_ErrorContext *akbasic_value_zero(akbasic_Value *obj) obj->intval = 0; obj->floatval = 0.0; obj->boolvalue = AKBASIC_FALSE; + obj->structtype = -1; + obj->structbase = NULL; SUCCEED_RETURN(errctx); } @@ -200,6 +204,16 @@ akerr_ErrorContext *akbasic_value_clone(akbasic_Value *self, akbasic_Value *dest 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; /* mutable_ is deliberately not copied: the reference's clone() does not. */ SUCCEED_RETURN(errctx); } diff --git a/src/variable.c b/src/variable.c index 7fa7aa2..7473a05 100644 --- a/src/variable.c +++ b/src/variable.c @@ -113,6 +113,13 @@ 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); diff --git a/src/verbs.c b/src/verbs.c index a7a6107..c2ce0e7 100644 --- a/src/verbs.c +++ b/src/verbs.c @@ -170,6 +170,7 @@ static const akbasic_Verb VERBS[] = { { "TRAP", AKBASIC_TOK_COMMAND, -1, NULL, akbasic_cmd_trap }, { "TROFF", AKBASIC_TOK_COMMAND, -1, NULL, akbasic_cmd_troff }, { "TRON", AKBASIC_TOK_COMMAND, -1, NULL, akbasic_cmd_tron }, + { "TYPE", AKBASIC_TOK_COMMAND, -1, akbasic_parse_type, akbasic_cmd_type }, { "UNTIL", AKBASIC_TOK_COMMAND, -1, NULL, NULL }, { "USING", AKBASIC_TOK_COMMAND, -1, NULL, NULL }, { "VAL", AKBASIC_TOK_FUNCTION, 1, NULL, akbasic_fn_val }, diff --git a/src/verbs.h b/src/verbs.h index 8eb75da..632f60b 100644 --- a/src/verbs.h +++ b/src/verbs.h @@ -171,6 +171,10 @@ akerr_ErrorContext AKERR_NOIGNORE *akbasic_cmd_locate(struct akbasic_Runtime *ob akerr_ErrorContext AKERR_NOIGNORE *akbasic_cmd_paint(struct akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest); akerr_ErrorContext AKERR_NOIGNORE *akbasic_cmd_scale(struct akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest); akerr_ErrorContext AKERR_NOIGNORE *akbasic_cmd_sshape(struct akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest); +/* Structures -- src/runtime_struct.c and src/parser_commands.c */ +akerr_ErrorContext AKERR_NOIGNORE *akbasic_parse_type(struct akbasic_Parser *parser, akbasic_ASTLeaf **dest); +akerr_ErrorContext AKERR_NOIGNORE *akbasic_cmd_type(struct akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest); + akerr_ErrorContext AKERR_NOIGNORE *akbasic_fn_rgr(struct akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest); /* Group I sound verbs -- src/runtime_audio.c */ diff --git a/tests/language/structures/missing_field.bas b/tests/language/structures/missing_field.bas new file mode 100644 index 0000000..97477ef --- /dev/null +++ b/tests/language/structures/missing_field.bas @@ -0,0 +1,14 @@ +10 REM A field name is checked against a closed set the program declared, which +20 REM is the one thing in this language whose valid spellings are written down. +30 REM A misspelled *variable* is still silent -- see the last two lines. +40 TYPE RECT +50 W# +60 H# +70 END TYPE +80 DIM R@ AS RECT +90 R@.W# = 3 +100 PRINT R@.W# +110 REM A variable nobody assigned is zero, with no complaint at all. +120 PRINT TOTLA# +130 REM A field the type does not declare is refused, and lists the real ones. +140 PRINT R@.NOPE# diff --git a/tests/language/structures/missing_field.txt b/tests/language/structures/missing_field.txt new file mode 100644 index 0000000..54432c9 --- /dev/null +++ b/tests/language/structures/missing_field.txt @@ -0,0 +1,4 @@ +3 +0 +? 140 : RUNTIME ERROR RECT has no field NOPE# (W#, H#) + diff --git a/tests/language/structures/records.bas b/tests/language/structures/records.bas new file mode 100644 index 0000000..c5633ec --- /dev/null +++ b/tests/language/structures/records.bas @@ -0,0 +1,29 @@ +10 REM A TYPE declares its fields; each takes its own type from its own suffix, +20 REM which is the same rule every other name in this language follows. +30 TYPE POINT +40 X# +50 Y# +60 END TYPE +70 TYPE SHAPE +80 NAME$ +90 ORIGIN@ AS POINT +100 AREA% +110 END TYPE +120 DIM A@ AS SHAPE +130 DIM B@ AS SHAPE +140 A@.NAME$ = "FIRST" +150 A@.ORIGIN@.X# = 10 +160 A@.ORIGIN@.Y# = 20 +170 A@.AREA% = 2.5 +180 REM Assignment COPIES. B@ is its own record from here on. +190 B@ = A@ +200 A@.NAME$ = "CHANGED" +210 A@.ORIGIN@.X# = 99 +220 PRINT A@ +230 PRINT B@ +240 REM A whole nested record copies as a unit too. +250 DIM P@ AS POINT +260 P@ = B@.ORIGIN@ +270 PRINT P@ +280 REM And a structure renders with its type name and its fields. +290 PRINT B@.ORIGIN@.X# + B@.ORIGIN@.Y# diff --git a/tests/language/structures/records.txt b/tests/language/structures/records.txt new file mode 100644 index 0000000..3beecac --- /dev/null +++ b/tests/language/structures/records.txt @@ -0,0 +1,4 @@ +SHAPE(NAME$=CHANGED, ORIGIN@=POINT(X#=99, Y#=20), AREA%=2.500000) +SHAPE(NAME$=FIRST, ORIGIN@=POINT(X#=10, Y#=20), AREA%=2.500000) +POINT(X#=10, Y#=20) +30 diff --git a/tests/struct_types.c b/tests/struct_types.c new file mode 100644 index 0000000..65ab295 --- /dev/null +++ b/tests/struct_types.c @@ -0,0 +1,225 @@ +/** + * @file struct_types.c + * @brief Tests `TYPE` declarations, their layout, and records by value. + * + * The assertions here are about the *descriptor* -- what the prescan read out of + * the source and how it laid an instance out -- because that is the part a BASIC + * program cannot see and therefore cannot pin. What a program can see is pinned + * by tests/language/structures/ instead. + * + * The layout assertions matter more than they look. A field's offset is the only + * thing standing between `R@.H#` and `R@.W#`, and an off-by-one there reads the + * neighbouring field rather than failing -- so it would pass every test that + * only ever set one field and read it back. + */ + +#include + +#include +#include +#include + +#include "harness.h" +#include "testutil.h" + +/** @brief Load a program and start it, which is what runs the prescan. */ +static akerr_ErrorContext AKERR_NOIGNORE *declare(const char *source) +{ + PREPARE_ERROR(errctx); + + PASS(errctx, harness_start(NULL)); + PASS(errctx, akbasic_runtime_load(&HARNESS_RUNTIME, source)); + PASS(errctx, akbasic_runtime_start(&HARNESS_RUNTIME, AKBASIC_MODE_RUN)); + SUCCEED_RETURN(errctx); +} + +static const char *RECT = + "10 TYPE RECT\n" + "20 W#\n" + "30 H#\n" + "40 END TYPE\n" + "50 PRINT 1\n"; + +/** @brief A declaration becomes a descriptor with names, types and offsets. */ +static void test_layout(void) +{ + akbasic_StructField *field = NULL; + int index = -1; + + TEST_REQUIRE_OK(declare(RECT)); + TEST_REQUIRE_OK(akbasic_structtype_find(&HARNESS_RUNTIME.structtypes, "RECT", &index)); + TEST_REQUIRE(index >= 0, "RECT should have been declared"); + TEST_REQUIRE_INT(HARNESS_RUNTIME.structtypes.types[index].fieldcount, 2); + TEST_REQUIRE_INT(HARNESS_RUNTIME.structtypes.types[index].slotcount, 2); + + /* + * Offsets, in declaration order. This is the assertion an off-by-one hides + * from: swapping these two would still let a program set W# and read W#. + */ + TEST_REQUIRE_OK(akbasic_structtype_field(&HARNESS_RUNTIME.structtypes, index, "W#", &field)); + TEST_REQUIRE_INT(field->offset, 0); + TEST_REQUIRE_INT(field->valuetype, AKBASIC_TYPE_INTEGER); + TEST_REQUIRE_INT(field->slotcount, 1); + TEST_REQUIRE_OK(akbasic_structtype_field(&HARNESS_RUNTIME.structtypes, index, "H#", &field)); + TEST_REQUIRE_INT(field->offset, 1); + harness_stop(); +} + +/** + * @brief A nested value flattens into its container's run. + * + * The property that lets an instance be one contiguous slice of the value pool, + * exactly as an array is, and so needs no pool of its own. + */ +static void test_nesting_flattens(void) +{ + akbasic_StructField *field = NULL; + int index = -1; + + TEST_REQUIRE_OK(declare("10 TYPE POINT\n" + "20 X#\n" + "30 Y#\n" + "40 END TYPE\n" + "50 TYPE LINE\n" + "60 FROM@ AS POINT\n" + "70 TO@ AS POINT\n" + "80 NAME$\n" + "90 END TYPE\n" + "100 PRINT 1\n")); + TEST_REQUIRE_OK(akbasic_structtype_find(&HARNESS_RUNTIME.structtypes, "LINE", &index)); + TEST_REQUIRE(index >= 0, "LINE should have been declared"); + /* Two points of two slots each, plus one string: five, not three. */ + TEST_REQUIRE_INT(HARNESS_RUNTIME.structtypes.types[index].slotcount, 5); + + TEST_REQUIRE_OK(akbasic_structtype_field(&HARNESS_RUNTIME.structtypes, index, "FROM@", &field)); + TEST_REQUIRE_INT(field->offset, 0); + TEST_REQUIRE_INT(field->slotcount, 2); + TEST_REQUIRE_OK(akbasic_structtype_field(&HARNESS_RUNTIME.structtypes, index, "TO@", &field)); + TEST_REQUIRE_INT(field->offset, 2); + TEST_REQUIRE_OK(akbasic_structtype_field(&HARNESS_RUNTIME.structtypes, index, "NAME$", &field)); + TEST_REQUIRE_INT(field->offset, 4); + harness_stop(); +} + +/** + * @brief A type may be named before it is declared. + * + * Which is why the prescan registers every name before it reads any field list. + * A linked list needs it even for itself, and this is the case that pins it. + */ +static void test_forward_reference(void) +{ + int index = -1; + + TEST_REQUIRE_OK(declare("10 TYPE OUTER\n" + "20 INNER@ AS INNERT\n" + "30 END TYPE\n" + "40 TYPE INNERT\n" + "50 N#\n" + "60 END TYPE\n" + "70 PRINT 1\n")); + TEST_REQUIRE_OK(akbasic_structtype_find(&HARNESS_RUNTIME.structtypes, "OUTER", &index)); + TEST_REQUIRE(index >= 0, "OUTER should have been declared"); + TEST_REQUIRE_INT(HARNESS_RUNTIME.structtypes.types[index].slotcount, 1); + harness_stop(); +} + +/** @brief The field-missing refusal names the type and lists what it does have. */ +static void test_missing_field_lists_the_others(void) +{ + akbasic_StructField *field = NULL; + akerr_ErrorContext *raised = NULL; + int index = -1; + + TEST_REQUIRE_OK(declare(RECT)); + TEST_REQUIRE_OK(akbasic_structtype_find(&HARNESS_RUNTIME.structtypes, "RECT", &index)); + + raised = akbasic_structtype_field(&HARNESS_RUNTIME.structtypes, index, "NOPE#", &field); + TEST_REQUIRE(raised != NULL, "a field the type does not declare must be refused"); + TEST_REQUIRE_INT(raised->status, AKBASIC_ERR_UNDEFINED); + /* + * The list is the point. A misspelled field is catchable only because the + * set is closed and the program wrote it down, so the message shows it -- + * that is what turns "why is my total zero" into a one-line fix. + */ + TEST_REQUIRE(strstr(raised->message, "W#") != NULL && strstr(raised->message, "H#") != NULL, + "the refusal should list the fields RECT does have, got \"%s\"", raised->message); + test_discard_error(raised); + harness_stop(); +} + +/** + * @brief A type containing itself by value is refused, by name. + * + * It has no finite size, so the prescan's size resolution never completes for + * it -- and "the set of types that never resolved" is exactly the set that + * contains itself. Diagnosed there rather than discovered when the pool runs + * out, and the message says what to do instead. + */ +static void test_self_by_value_refused(void) +{ + TEST_REQUIRE_OK(harness_start(NULL)); + TEST_REQUIRE_OK(akbasic_runtime_load(&HARNESS_RUNTIME, + "10 TYPE NODE\n" + "20 COUNT#\n" + "30 TAIL@ AS NODE\n" + "40 END TYPE\n" + "50 PRINT 1\n")); + TEST_REQUIRE_OK(akbasic_runtime_start(&HARNESS_RUNTIME, AKBASIC_MODE_RUN)); + TEST_REQUIRE_OK(akbasic_runtime_run(&HARNESS_RUNTIME, 0)); + /* + * Reported as a BASIC error rather than raised at the host. A malformed + * declaration is the program's mistake, and goal 3 says a script's mistakes + * do not reach the embedding program. + */ + TEST_REQUIRE(strstr(HARNESS_OUTPUT, "contains itself by value") != NULL, + "self-containment should be refused by name, got \"%s\"", HARNESS_OUTPUT); + TEST_REQUIRE(strstr(HARNESS_OUTPUT, "PTR TO") != NULL, + "the refusal should say what to do instead, got \"%s\"", HARNESS_OUTPUT); + harness_stop(); + + /* And through a pointer it is legal, which is how a list is built at all. */ + TEST_REQUIRE_OK(declare("10 TYPE NODE\n" + "20 COUNT#\n" + "30 TAIL@ AS PTR TO NODE\n" + "40 END TYPE\n" + "50 PRINT 1\n")); + harness_stop(); +} + +/** @brief A declaration error reaches the program, not the host. */ +static void test_declaration_errors_are_basic_errors(void) +{ + static const char *CASES[] = { + "10 TYPE RECT\n20 W\n30 END TYPE\n40 PRINT 1\n", + "10 TYPE RECT\n20 W#\n30 PRINT 1\n", + "10 TYPE RECT\n20 W#\n30 END TYPE\n40 TYPE RECT\n50 H#\n60 END TYPE\n70 PRINT 1\n", + "10 TYPE RECT\n20 W#\n30 W#\n40 END TYPE\n50 PRINT 1\n", + "10 TYPE RECT\n20 INNER@\n30 END TYPE\n40 PRINT 1\n" + }; + size_t i = 0; + + for ( i = 0; i < sizeof(CASES) / sizeof(CASES[0]); i++ ) { + TEST_REQUIRE_OK(harness_start(NULL)); + TEST_REQUIRE_OK(akbasic_runtime_load(&HARNESS_RUNTIME, CASES[i])); + TEST_REQUIRE_OK(akbasic_runtime_start(&HARNESS_RUNTIME, AKBASIC_MODE_RUN)); + TEST_REQUIRE_OK(akbasic_runtime_run(&HARNESS_RUNTIME, 0)); + TEST_REQUIRE(strstr(HARNESS_OUTPUT, "PARSE ERROR") != NULL, + "case %zu should report a parse error, got \"%s\"", i, HARNESS_OUTPUT); + harness_stop(); + } +} + +int main(void) +{ + TEST_REQUIRE_OK(akbasic_error_register()); + + test_layout(); + test_nesting_flattens(); + test_forward_reference(); + test_missing_field_lists_the_others(); + test_self_by_value_refused(); + test_declaration_errors_are_basic_errors(); + + return akbasic_test_failures; +}