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

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