andrew/akbasic
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Add records: TYPE, DIM ... AS, field access, copy on assign

Browse Source 
BASIC 7.0 has no records at all, so none of this is a port. The `@` suffix was
not invented either: the Go reference reserved IDENTIFIER_STRUCT and never used
it, and src/grammar.c rendered such a leaf as "NOT IMPLEMENTED" until now.

Declaring the type is what buys the storage model. A TYPE states its fields, so
an instance has a known slot count and is laid out exactly as an array is -- one
contiguous run from the same value pool DIM already draws from, with field access
as offset arithmetic. No new pool holds data; the only new table holds
descriptors. A nested value flattens into its container's run, which is why
LINE with two POINTs and a string is five slots rather than three.

Each field takes its type from its own suffix, the same rule every other name
here follows, so a field list needs no type column. An `@` field is the
exception and has to name its type, because three primitive types fit in three
suffix characters and N declared types do not fit in one.

The declaration is prescanned before the program runs, like labels and DATA and
for the same reason: it has to be in effect wherever control goes. Three passes,
each for a case the one before cannot do -- names first so a field can refer to
a type declared later, then field lists, then sizes by repeated resolution. What
never resolves is a cycle of by-value containment, so "a TYPE cannot contain
itself by value" is a diagnosis rather than an assumption, and the message says
to use PTR TO instead.

Assignment copies. That interception is the whole feature and it cannot live in
akbasic_value_clone(), which copies one slot -- and one slot holds a *reference*
to an instance rather than the instance, so going through it would alias. A
structure is intercepted before that path and its slots are copied one at a
time, walking the descriptor rather than memcpy-ing the run, because a pointer
field must copy its reference where a value field must copy its slots.

Two smaller things the work required. All three prescans now sit inside one
ATTEMPT: a malformed declaration is the program's mistake, and it was printing a
stack trace and taking the driver with it, which is the boundary goal 3 exists
to draw. And a fresh variable's structtype is -1 rather than the 0 a memset
leaves, because 0 is a valid type index and every new variable was claiming to
be the first type declared.

Co-Authored-By: Claude Opus 5 (1M context) <noreply@anthropic.com>
This commit is contained in:
Andrew Kesterson
2026-08-01 11:39:47 -04:00
parent 8117fb564d
commit 6a7c8cd920
24 changed files with 1679 additions and 22 deletions
Download Patch File Download Diff File Expand all files Collapse all files

3
CMakeLists.txt
View File

@@ -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

19
include/akbasic/grammar.h
View File

@@ -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.
*

3
include/akbasic/runtime.h
View File

@@ -29,6 +29,7 @@
#include <akbasic/input.h>
#include <akbasic/sink.h>
#include <akbasic/sprite.h>
#include <akbasic/structtype.h>
#include <akbasic/symtab.h>
#include <akbasic/types.h>
#include <akbasic/value.h>
@@ -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;

180
include/akbasic/structtype.h Normal file
View File

@@ -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 <akerror.h>
#include <akbasic/grammar.h>
#include <akbasic/types.h>
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_

38
include/akbasic/types.h
View File

@@ -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_

8
include/akbasic/variable.h
View File

@@ -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;
/**

110
src/environment.c
View File

@@ -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));

33
src/grammar.c
View File

@@ -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)));

66
src/parser.c
View File

@@ -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);
}

59
src/parser_commands.c
View File

@@ -11,6 +11,7 @@
#include <inttypes.h>
#include <string.h>
#include <strings.h>
#include <akerror.h>
@@ -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);
}

83
src/runtime.c
View File

@@ -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, &copy));
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);

89
src/runtime_commands.c
View File

@@ -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));

255
src/runtime_struct.c Normal file
View File

@@ -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 <inttypes.h>
#include <stdio.h>
#include <string.h>
#include <akerror.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)
{
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);
}

16
src/scanner.c
View File

@@ -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

431
src/structtype.c Normal file
View File

@@ -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 <ctype.h>
#include <inttypes.h>
#include <stdio.h>
#include <string.h>
#include <akerror.h>
#include <akbasic/error.h>
#include <akbasic/runtime.h>
#include <akbasic/structtype.h>
/** @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);
}

20
src/value.c
View File

@@ -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);
}

7
src/variable.c
View File

@@ -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);

1
src/verbs.c
View File

@@ -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 },

4
src/verbs.h
View File

@@ -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 */

14
tests/language/structures/missing_field.bas Normal file
View File

@@ -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#

4
tests/language/structures/missing_field.txt Normal file
View File

@@ -0,0 +1,4 @@
3
0
? 140 : RUNTIME ERROR RECT has no field NOPE# (W#, H#)

29
tests/language/structures/records.bas Normal file
View File

@@ -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#

4
tests/language/structures/records.txt Normal file
View File

@@ -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

225
tests/struct_types.c Normal file
View File

@@ -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 <string.h>
#include <akbasic/error.h>
#include <akbasic/runtime.h>
#include <akbasic/structtype.h>
#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;
}