Files
akbasic/src/structtype.c

432 lines
15 KiB
C
Raw Normal View History

Add records: TYPE, DIM ... AS, field access, copy on assign 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>
2026-08-01 11:39:47 -04:00
/**
* @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);
}