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

Let DEF take structure parameters, and give call scopes back

Browse Source 
DEF AREA(S@ AS RECT) = S@.W# * S@.H#
    DEF POKEIT(P@ AS PTR TO RECT)

A parameter names its type, exactly as DIM does. A bare `DEF F(S@)` is refused:
@ says "a structure" without saying which, so it does not state a contract the
way S$ does, and accepting it would mean checking fields at the call rather than
at the declaration -- which is the hole naming the type closes. The cost is that
there are no generic functions, and that is a real loss rather than an oversight.

Passing is by value, because a parameter is bound by assignment and assignment
copies; a pointer parameter copies its reference and lets a function change its
caller's record on purpose. Neither is a special rule. What a structure
parameter does need is its storage prepared before the copy, since a structure
variable is a run of slots and there is nothing to copy into until the run
exists.

A DEF parameter list is no longer parsed as an argument list, because a
parameter is a declaration rather than an expression: `S@ AS RECT` stopped that
parser dead with "Unbalanced parenthesis".

akbasic_value_is_truthy() learned that a pointer is true when it points at
something, which had to come with this. Without it there is no way to test for
the end of a list at all -- comparing a pointer to 0 reads a numeric field it
does not carry and answers whatever that field held. A structure is deliberately
given no truth value: it always exists, so the question has no answer worth
guessing at.

And a regression I introduced last commit, plus the older one underneath it.
prev_environment() released a scope but not the variables the scope created, so
a call leaked one slot per parameter and two hundred calls exhausted the
128-slot pool. Giving each DEF call its own scope made that reachable; it was
there for GOSUB all along, measured on a stashed build -- a subroutine with a
local of its own failed after about 128 calls before any of this work. The
release is safe because a scope's table holds only what it created, and it is
the variable slot that comes back rather than its storage, so a pointer into a
record DIMmed in that scope stays sound.

Co-Authored-By: Claude Opus 5 (1M context) <noreply@anthropic.com>
This commit is contained in:
Andrew Kesterson
2026-08-01 13:05:32 -04:00
parent 00daa17a47
commit c1d06ee4b8
8 changed files with 452 additions and 40 deletions
Download Patch File Download Diff File Expand all files Collapse all files

45
TODO.md
View File

@@ -1575,6 +1575,45 @@ the reference's semantics reproduced faithfully; the third is the port's own.
### Found while fixing the DEF recursion hang ### Found while fixing the DEF recursion hang
27. ~~**A call leaked one variable slot per parameter.**~~ **Fixed.**
`akbasic_runtime_prev_environment()` released the scope but not the variables the scope
created, so a subroutine with a local of its own exhausted the 128-slot pool after
about 128 calls -- `Maximum runtime variables reached`, on a four-line program that
does nothing unusual.
**It was there for `GOSUB` all along**, measured on a build stashed back rather than
assumed: `FOR I# = 1 TO 300 : GOSUB 100 : NEXT` where the subroutine assigns a local
failed before this work and passes after it. Giving each `DEF` call its own scope
(item 26) simply made it reachable a second way, which is how it was found.
The release is safe because a scope's own table holds *only* what it created --
`akbasic_environment_get()` walks up to find an outer variable and returns it without
caching a reference. That is worth knowing before anyone adds caching there, and the
loop says so. It is the variable *slot* that comes back, not its storage: the value
pool never frees, so a pointer into a record `DIM`med in a scope stays sound after the
scope is gone, which is a documented property of structures rather than an accident
this could have taken away.
28. ~~**A function could not take a structure.**~~ **Done.**
`DEF AREA(S@ AS RECT)` and `DEF POKEIT(P@ AS PTR TO RECT)` now work, and a bare
`DEF F(S@)` is refused: `@` says "a structure" without saying which, so it does not
state a contract the way `S$` does. Accepting it would mean checking fields at the
call rather than at the declaration -- duck typing, and the hole naming the type
closes. **The cost is that there are no generic functions**, one `AREA` cannot serve
two types, and that is a real loss recorded rather than glossed.
Passing is by value because a parameter is bound by assignment and assignment copies;
a pointer parameter copies its reference. Neither is a special rule. A structure
parameter needs its storage prepared before the copy, which is the one thing a
primitive parameter does not -- a structure variable is a run of slots and there is
nothing to copy into until the run exists.
**`akbasic_value_is_truthy()` learned that a pointer is true when it points at
something**, which had to come with it: without it there is no way to test for the end
of a list at all, and comparing a pointer to 0 reads a numeric field it does not carry.
A *structure* is deliberately given no truth value -- it always exists, so the question
has no answer worth guessing at.
25. **A statement containing a failed multi-line `DEF` call still completes, and prints a 25. **A statement containing a failed multi-line `DEF` call still completes, and prints a
junk value.** The call's error is reported and the run stops, but the *enclosing* junk value.** The call's error is reported and the run stops, but the *enclosing*
statement carries on with whatever `*dest` was left holding: statement carries on with whatever `*dest` was left holding:
@@ -1764,12 +1803,12 @@ requirement; exactly one case has diverged on purpose since, and
| Gate | Result | | Gate | Result |
|---|---| |---|---|
| `ctest` | 106/106 — 41 reference golden cases, 20 local ones, 39 unit tests, 3 embedding examples, and `docs_examples` | | `ctest` | 107/107 — 41 reference golden cases, 20 local ones, 39 unit tests, 3 embedding examples, and `docs_examples` |
| `ctest` with `-DAKBASIC_WITH_AKGL=ON` | 106/106 on a machine with a display; 105 passed + 1 skipped headless. The same set minus the three `no_device` cases the SDL driver contradicts, plus `akgl_backends`, `akgl_frontend`, `docs_screenshots` and `akgl_typing` — the last of which is the skip, and the `akgl_build` CI job is where it skips | | `ctest` with `-DAKBASIC_WITH_AKGL=ON` | 107/107 on a machine with a display; 106 passed + 1 skipped headless. The same set minus the three `no_device` cases the SDL driver contradicts, plus `akgl_backends`, `akgl_frontend`, `docs_screenshots` and `akgl_typing` — the last of which is the skip, and the `akgl_build` CI job is where it skips |
| `docs_examples` | Every fenced block in `README.md`, `MAINTENANCE.md` and `docs/` executed and byte-compared: 49 programs, 9 transcripts, 57 output comparisons, 2 excerpts, 2 shell blocks and 8 figures in the default build; 65 programs and 56 output comparisons in the AKGL one. The C-snippet count reads 0 when the harness is run by hand without `--cflags-file`; CTest passes it. `MAINTENANCE.md` documents the fence-tag convention | | `docs_examples` | Every fenced block in `README.md`, `MAINTENANCE.md` and `docs/` executed and byte-compared: 49 programs, 9 transcripts, 57 output comparisons, 2 excerpts, 2 shell blocks and 8 figures in the default build; 65 programs and 56 output comparisons in the AKGL one. The C-snippet count reads 0 when the harness is run by hand without `--cflags-file`; CTest passes it. `MAINTENANCE.md` documents the fence-tag convention |
| `docs_screenshots` | 8/8 figures re-rendered and byte-identical to the checked-in PNGs. AKGL build only — rendering a picture needs the SDL half | | `docs_screenshots` | 8/8 figures re-rendered and byte-identical to the checked-in PNGs. AKGL build only — rendering a picture needs the SDL half |
| Golden corpus | 41/41 byte-exact from `tests/reference/` — **and 41/41 again through the SDL binary**, which is most of what proves the frontend changes no output | | Golden corpus | 41/41 byte-exact from `tests/reference/` — **and 41/41 again through the SDL binary**, which is most of what proves the frontend changes no output |
| ASan + UBSan | 106/106 | | ASan + UBSan | 107/107 |
| Line coverage | 94.8% (6648/7013) — above the 90% gate | | Line coverage | 94.8% (6648/7013) — above the 90% gate |
| Function coverage | 98.4% (441/448) | | Function coverage | 98.4% (441/448) |
| Warnings | none under `-Wall -Wextra` | | Warnings | none under `-Wall -Wextra` |

81
docs/16-structures.md
View File

@@ -186,15 +186,86 @@ Note line 130: assigning one *pointer* to another copies the reference, not the
That is the one place assignment does not deep-copy, and it is why pointers are declared That is the one place assignment does not deep-copy, and it is why pointers are declared
separately rather than being a mode a structure can be in. separately rather than being a mode a structure can be in.
A recursive `DEF` works too, and is bounded by the scope pool at 32 deep — the same **A pointer is true when it points at something**, which is how a walk knows where the
bound `GOSUB` has. What a function cannot yet do is take a structure *parameter*: list ends — and a recursive `DEF` can do the walking:
`DEF F(B@ AS NODE)` is not implemented, and a bare `DEF F(B@)` is refused because `@`
alone does not say which type. Until it is, a function reaches a record by name, which ```basic
the scoping already allows — a call can see the caller's variables. 10 TYPE NODE
20 COUNT#
30 TAIL@ AS PTR TO NODE
40 END TYPE
50 DIM N1@ AS NODE
60 DIM N2@ AS NODE
70 N1@.COUNT# = 10
80 N2@.COUNT# = 20
90 POINT N1@.TAIL@ AT N2@
100 DEF TOTAL(P@ AS PTR TO NODE)
110 IF P@->TAIL@ THEN RETURN P@->COUNT# + TOTAL(P@->TAIL@)
120 RETURN P@->COUNT#
130 DIM W@ AS PTR TO NODE
140 POINT W@ AT N1@
150 PRINT TOTAL(W@)
```
```output
30
```
`NOT` is the bitwise operator here, so write the test the positive way round as line 110
does. Recursion is bounded by the scope pool at 32 deep, the same bound `GOSUB` has.
`PRINT` follows pointers, so a cycle would not come back — it stops after four levels and `PRINT` follows pointers, so a cycle would not come back — it stops after four levels and
prints `(...)`. prints `(...)`.
## Passing a structure to a function
A parameter names its type, exactly as `DIM` does:
```basic
10 TYPE CRATE
20 W#
30 H#
40 END TYPE
50 DIM A@ AS CRATE
60 A@.W# = 5
70 A@.H# = 3
80 DEF AREA(B@ AS CRATE) = B@.W# * B@.H#
90 PRINT AREA(A@)
```
```output
15
```
**A bare `B@` is refused.** `@` says "a structure" without saying which, so it does not
state a contract the way `B$` does — and accepting it would mean checking fields at the
call instead of at the declaration, which is the hole naming the type closes. The cost is
that there are no generic functions: one `AREA` cannot serve `CRATE` and `BOXY`.
**Passing is by value**, because a parameter is bound by assignment and assignment copies:
```basic
10 TYPE CRATE
20 W#
30 END TYPE
40 DIM A@ AS CRATE
50 A@.W# = 5
60 DEF WIDEN(B@ AS CRATE)
70 B@.W# = 99
80 RETURN B@.W#
90 PRINT WIDEN(A@)
100 PRINT A@.W#
```
```output
99
5
```
The function saw 99; the caller still has 5. To change a caller's record on purpose, pass
a pointer — `DEF POKEIT(P@ AS PTR TO CRATE)` — and reach through it with `->`. Neither is
a special rule: both fall out of the parameter being assigned like any other variable.
## What is checked, and what is not ## What is checked, and what is not
A field name is checked against the set the type declared, and the refusal lists the A field name is checked against the set the type declared, and the refusal lists the

98
src/parser_commands.c
View File

@@ -673,6 +673,90 @@ akerr_ErrorContext *akbasic_parse_dim(akbasic_Parser *parser, akbasic_ASTLeaf **
* so the environment is told to skip forward to that RETURN rather than execute * so the environment is told to skip forward to that RETURN rather than execute
* the body during the definition. * the body during the definition.
*/ */
/**
* @brief A `DEF` parameter list, which is not an ordinary argument list.
*
* `akbasic_parser_argument_list()` parses *expressions*, and a parameter is a
* declaration -- `S@ AS RECT` is not an expression and stops that parser dead
* with "Unbalanced parenthesis". So this reads the list itself.
*
* **A structure parameter must name its type.** `@` says "a structure" without
* saying which: three primitive types fit in three suffix characters and N
* declared types do not fit in one, so `X$` fully states its contract and `X@`
* does not. A bare `X@` is refused rather than treated as "any structure",
* because that is duck typing and it puts back exactly the hole naming the type
* closes. The cost is that there are no generic functions, and it is a real one.
*
* The type name is parked on the parameter leaf in `literal_string`, with
* `literal_int` recording `PTR TO` -- the same two free fields, for the same
* reason, that `DIM ... AS` uses.
*/
static akerr_ErrorContext *parse_def_parameters(akbasic_Parser *parser, akbasic_ASTLeaf **dest)
{
PREPARE_ERROR(errctx);
akbasic_ASTLeaf *arglist = NULL;
akbasic_ASTLeaf *param = NULL;
akbasic_ASTLeaf *tail = NULL;
akbasic_Token *word = NULL;
FAIL_ZERO_RETURN(errctx, akbasic_parser_match1(parser, AKBASIC_TOK_LEFT_PAREN),
AKBASIC_ERR_SYNTAX, "Expected an argument list after DEF <name>");
PASS(errctx, akbasic_parser_new_leaf(parser, &arglist));
arglist->leaftype = AKBASIC_LEAF_ARGUMENTLIST;
arglist->operator_ = AKBASIC_TOK_FUNCTION_ARGUMENT;
do {
PASS(errctx, akbasic_parser_primary(parser, &param));
FAIL_ZERO_RETURN(errctx,
(param != NULL &&
(param->leaftype == AKBASIC_LEAF_IDENTIFIER_STRING ||
param->leaftype == AKBASIC_LEAF_IDENTIFIER_INT ||
param->leaftype == AKBASIC_LEAF_IDENTIFIER_FLOAT ||
param->leaftype == AKBASIC_LEAF_IDENTIFIER_STRUCT)),
AKBASIC_ERR_SYNTAX,
"Only variable identifiers are valid arguments for DEF");
if ( param->leaftype == AKBASIC_LEAF_IDENTIFIER_STRUCT ) {
FAIL_ZERO_RETURN(errctx, akbasic_parser_match1(parser, AKBASIC_TOK_IDENTIFIER),
AKBASIC_ERR_SYNTAX,
"%s must name its type: %s AS TYPENAME, or %s AS PTR TO TYPENAME",
param->identifier, param->identifier, param->identifier);
PASS(errctx, akbasic_parser_previous(parser, &word));
FAIL_ZERO_RETURN(errctx, (strcasecmp(word->lexeme, "AS") == 0), AKBASIC_ERR_SYNTAX,
"Expected AS after %s, not %s", param->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 ) {
param->literal_int = 1;
/* `TO` is already a verb -- FOR ... TO owns it -- so it arrives
as a command token rather than an identifier. */
FAIL_ZERO_RETURN(errctx, akbasic_parser_match1(parser, AKBASIC_TOK_COMMAND),
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(param->literal_string, sizeof(param->literal_string), "%s", word->lexeme);
}
if ( tail == NULL ) {
arglist->right = param;
} else {
tail->next = param;
}
tail = param;
} while ( akbasic_parser_match1(parser, AKBASIC_TOK_COMMA) );
FAIL_ZERO_RETURN(errctx, akbasic_parser_match1(parser, AKBASIC_TOK_RIGHT_PAREN),
AKBASIC_ERR_SYNTAX, "Expected ) after the argument list");
*dest = arglist;
SUCCEED_RETURN(errctx);
}
akerr_ErrorContext *akbasic_parse_def(akbasic_Parser *parser, akbasic_ASTLeaf **dest) akerr_ErrorContext *akbasic_parse_def(akbasic_Parser *parser, akbasic_ASTLeaf **dest)
{ {
PREPARE_ERROR(errctx); PREPARE_ERROR(errctx);
@@ -680,7 +764,6 @@ akerr_ErrorContext *akbasic_parse_def(akbasic_Parser *parser, akbasic_ASTLeaf **
akbasic_ASTLeaf *identifier = NULL; akbasic_ASTLeaf *identifier = NULL;
akbasic_ASTLeaf *arglist = NULL; akbasic_ASTLeaf *arglist = NULL;
akbasic_ASTLeaf *expression = NULL; akbasic_ASTLeaf *expression = NULL;
akbasic_ASTLeaf *walk = NULL;
akbasic_ASTLeaf *command = NULL; akbasic_ASTLeaf *command = NULL;
akbasic_FunctionDef *fndef = NULL; akbasic_FunctionDef *fndef = NULL;
size_t i = 0; size_t i = 0;
@@ -689,18 +772,7 @@ akerr_ErrorContext *akbasic_parse_def(akbasic_Parser *parser, akbasic_ASTLeaf **
FAIL_ZERO_RETURN(errctx, (identifier->leaftype == AKBASIC_LEAF_IDENTIFIER), FAIL_ZERO_RETURN(errctx, (identifier->leaftype == AKBASIC_LEAF_IDENTIFIER),
AKBASIC_ERR_SYNTAX, "Expected identifier"); AKBASIC_ERR_SYNTAX, "Expected identifier");
PASS(errctx, akbasic_parser_argument_list(parser, AKBASIC_TOK_FUNCTION_ARGUMENT, true, &arglist)); PASS(errctx, parse_def_parameters(parser, &arglist));
FAIL_ZERO_RETURN(errctx, (arglist != NULL), AKBASIC_ERR_SYNTAX,
"Expected argument list (identifier names)");
for ( walk = arglist->right; walk != NULL; walk = walk->next ) {
FAIL_ZERO_RETURN(errctx,
(walk->leaftype == AKBASIC_LEAF_IDENTIFIER_STRING ||
walk->leaftype == AKBASIC_LEAF_IDENTIFIER_INT ||
walk->leaftype == AKBASIC_LEAF_IDENTIFIER_FLOAT),
AKBASIC_ERR_SYNTAX,
"Only variable identifiers are valid arguments for DEF");
}
PASS(errctx, akbasic_runtime_new_function(runtime, &fndef)); PASS(errctx, akbasic_runtime_new_function(runtime, &fndef));

94
src/runtime.c
View File

@@ -122,12 +122,39 @@ akerr_ErrorContext *akbasic_runtime_prev_environment(akbasic_Runtime *obj)
{ {
PREPARE_ERROR(errctx); PREPARE_ERROR(errctx);
akbasic_Environment *popped = NULL; akbasic_Environment *popped = NULL;
int i = 0;
FAIL_ZERO_RETURN(errctx, (obj != NULL), AKERR_NULLPOINTER, "NULL runtime in prev_environment"); FAIL_ZERO_RETURN(errctx, (obj != NULL), AKERR_NULLPOINTER, "NULL runtime in prev_environment");
FAIL_ZERO_RETURN(errctx, (obj->environment->parent != NULL), AKBASIC_ERR_ENVIRONMENT, FAIL_ZERO_RETURN(errctx, (obj->environment->parent != NULL), AKBASIC_ERR_ENVIRONMENT,
"No previous environment to return to"); "No previous environment to return to");
popped = obj->environment; popped = obj->environment;
obj->environment = popped->parent; obj->environment = popped->parent;
/*
* Give back the variables this scope created, as well as the scope.
*
* Safe because a scope's own table holds *only* what it created:
* akbasic_environment_get() walks up to find an outer variable and returns
* it without caching a reference here, so nothing in this table belongs to
* anybody else. That is worth stating, because if it ever started caching,
* this loop would free a parent's variable out from under it.
*
* It is the variable *slot* that comes back, not its storage. The value pool
* never frees, so a pointer into a record DIMmed in this scope stays sound
* after the scope is gone -- which is a documented property of structures,
* not an accident this could take away.
*
* Without it, one variable leaked per call: a function called two hundred
* times exhausted the 128-slot pool and reported "Maximum runtime variables
* reached" on a four-line program.
*/
for ( i = 0; i < popped->variables.capacity; i++ ) {
akbasic_Variable *variable = (akbasic_Variable *)popped->variables.slots[i].value;
if ( popped->variables.slots[i].used && variable != NULL ) {
variable->used = false;
}
}
/* /*
* Release it. The reference never does, which is a leak the GC papers over; * Release it. The reference never does, which is a leak the GC papers over;
* here the pool is finite, so an unreleased environment is a bug that shows * here the pool is finite, so an unreleased environment is a bug that shows
@@ -758,6 +785,67 @@ akerr_ErrorContext *akbasic_runtime_interpret_immediate(akbasic_Runtime *obj, ak
SUCCEED_RETURN(errctx); SUCCEED_RETURN(errctx);
} }
/**
* @brief Give a structure parameter storage in the call's scope, then fill it.
*
* A primitive parameter needs no preparation: `akbasic_environment_assign()`
* creates the variable and writes a value into it. A structure does, because a
* structure variable is a *run* of slots sized by its type and there is nothing
* to copy into until that run exists -- which is the same thing `DIM ... AS`
* does, done here on the caller's behalf.
*
* **Passing is by value, because assignment is.** A structure argument is
* deep-copied, so a function cannot change its caller's record by accident; a
* pointer argument copies the reference, which is how a function changes one on
* purpose. Neither is a special rule -- both fall out of the parameter being
* assigned like any other variable.
*/
static akerr_ErrorContext *bind_structure_parameter(akbasic_Runtime *obj, akbasic_Environment *callenv,
akbasic_ASTLeaf *param, akbasic_Value *argvalue)
{
PREPARE_ERROR(errctx);
akbasic_Variable *variable = NULL;
int64_t sizes[1] = { 1 };
int typeindex = -1;
bool ispointer = (param->literal_int != 0);
PASS(errctx, akbasic_structtype_find(&obj->structtypes, param->literal_string, &typeindex));
FAIL_ZERO_RETURN(errctx, (typeindex >= 0), AKBASIC_ERR_UNDEFINED,
"%s is declared AS %s, which is not a type",
param->identifier, param->literal_string);
/*
* The type check a caller actually meets. `DEF AREA(S@ AS RECT)` handed a
* COORD is refused here, by name -- which is the whole reason a structure
* parameter has to name its type rather than saying only `@`.
*/
FAIL_ZERO_RETURN(errctx,
(argvalue->valuetype == (ispointer ? AKBASIC_TYPE_POINTER : AKBASIC_TYPE_STRUCT)),
AKBASIC_ERR_TYPE,
"%s expects %s%s", param->identifier,
(ispointer ? "a pointer to " : "a "), obj->structtypes.types[typeindex].name);
FAIL_ZERO_RETURN(errctx, (argvalue->structtype == typeindex), AKBASIC_ERR_TYPE,
"%s is %s%s and cannot take a %s", param->identifier,
(ispointer ? "a pointer to " : "a "),
obj->structtypes.types[typeindex].name,
obj->structtypes.types[argvalue->structtype].name);
PASS(errctx, akbasic_environment_create(callenv, param->identifier, &variable));
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_clone(argvalue, &variable->values[0]));
SUCCEED_RETURN(errctx);
}
PASS(errctx, akbasic_struct_init_slots(obj, typeindex, variable->values));
PASS(errctx, akbasic_struct_copy(obj, typeindex, argvalue->structbase, variable->values));
SUCCEED_RETURN(errctx);
}
akerr_ErrorContext *akbasic_runtime_user_function(akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value **dest) akerr_ErrorContext *akbasic_runtime_user_function(akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value **dest)
{ {
PREPARE_ERROR(errctx); PREPARE_ERROR(errctx);
@@ -808,7 +896,11 @@ akerr_ErrorContext *akbasic_runtime_user_function(akbasic_Runtime *obj, akbasic_
while ( leafptr != NULL && argptr != NULL ) { while ( leafptr != NULL && argptr != NULL ) {
PASS(errctx, akbasic_runtime_evaluate(obj, leafptr, &argvalue)); PASS(errctx, akbasic_runtime_evaluate(obj, leafptr, &argvalue));
obj->environment = callenv; obj->environment = callenv;
PASS(errctx, akbasic_environment_assign(callenv, argptr, argvalue, &unused)); if ( argptr->leaftype == AKBASIC_LEAF_IDENTIFIER_STRUCT ) {
PASS(errctx, bind_structure_parameter(obj, callenv, argptr, argvalue));
} else {
PASS(errctx, akbasic_environment_assign(callenv, argptr, argvalue, &unused));
}
obj->environment = targetenv; obj->environment = targetenv;
leafptr = leafptr->next; leafptr = leafptr->next;
argptr = argptr->next; argptr = argptr->next;

12
src/value.c
View File

@@ -287,6 +287,18 @@ bool akbasic_value_is_truthy(akbasic_Value *self)
switch ( self->valuetype ) { switch ( self->valuetype ) {
case AKBASIC_TYPE_BOOLEAN: case AKBASIC_TYPE_BOOLEAN:
return (self->boolvalue != 0); return (self->boolvalue != 0);
case AKBASIC_TYPE_POINTER:
/*
* **A pointer is true when it points at something**, which is what makes
* `IF P@ THEN` the way to ask. Without it there is no way to test for the
* end of a list at all: comparing a pointer to 0 reads a numeric field it
* does not carry and answers whatever that field happened to hold.
*
* A *structure* is deliberately not given a truth value. It always
* exists, so the question has no answer worth guessing at, and falling
* through to false keeps `IF A@ THEN` from quietly meaning something.
*/
return (self->structbase != NULL);
case AKBASIC_TYPE_INTEGER: case AKBASIC_TYPE_INTEGER:
return (self->intval != 0); return (self->intval != 0);
case AKBASIC_TYPE_FLOAT: case AKBASIC_TYPE_FLOAT:

47
tests/language/structures/parameters.bas Normal file
View File

@@ -0,0 +1,47 @@
10 REM A structure parameter must name its type: @ says "a structure" without
20 REM saying which, so B@ does not state a contract the way B$ does.
30 TYPE CRATE
40 W#
50 H#
60 END TYPE
70 DIM A@ AS CRATE
80 A@.W# = 5
90 A@.H# = 3
100 DEF AREA(B@ AS CRATE) = B@.W# * B@.H#
110 PRINT AREA(A@)
120 REM Passing is BY VALUE, because a parameter is bound by assignment and
130 REM assignment copies. A function cannot change its caller's record by
140 REM accident.
150 DEF WIDEN(B@ AS CRATE)
160 B@.W# = 99
170 RETURN B@.W#
180 PRINT WIDEN(A@)
190 PRINT A@.W#
200 REM To change one on purpose, pass a pointer. Assignment copies a pointer's
210 REM reference, so the callee is looking at the caller's own record.
220 DIM Q@ AS PTR TO CRATE
230 POINT Q@ AT A@
240 DEF POKEIT(P@ AS PTR TO CRATE)
250 P@->W# = 42
260 RETURN P@->W#
270 PRINT POKEIT(Q@)
280 PRINT A@.W#
290 REM And a recursive function can carry a record down with it.
300 TYPE NODE
310 COUNT#
320 TAIL@ AS PTR TO NODE
330 END TYPE
340 DIM N1@ AS NODE
350 DIM N2@ AS NODE
360 N1@.COUNT# = 10
370 N2@.COUNT# = 20
380 POINT N1@.TAIL@ AT N2@
390 DEF TOTAL(P@ AS PTR TO NODE)
395 REM A pointer is true when it points at something, which is how a walk knows
396 REM where the list ends. NOT is the bitwise operator here, so the test is
397 REM written the positive way round.
400 IF P@->TAIL@ THEN RETURN P@->COUNT# + TOTAL(P@->TAIL@)
410 RETURN P@->COUNT#
420 DIM W@ AS PTR TO NODE
430 POINT W@ AT N1@
440 PRINT TOTAL(W@)

6
tests/language/structures/parameters.txt Normal file
View File

@@ -0,0 +1,6 @@
15
99
5
42
42
30

109
tests/user_functions.c
View File

@@ -128,36 +128,107 @@ static void test_single_expression_form(void)
} }
/** /**
* @brief A function reaches a structure through the caller's scope. * @brief A structure parameter is passed by value, and a pointer one is not.
* *
* **Not through a parameter**: `DEF F(B@ AS CRATE)` is not implemented, and a * Neither is a special rule: a parameter is bound by assignment like any other
* bare `DEF F(B@)` is refused because `@` alone does not say *which* type. So * variable, and assignment copies a structure and copies a pointer's reference.
* the way a function works with a record today is by name, which the dynamic * The two halves of the feature seen from a function's side.
* scoping already allows -- a call's environment has the caller's as its parent.
*
* Pinned rather than left implicit, because it is the only route there is and a
* reader would otherwise reasonably assume the parameter form works.
*/ */
static void test_structures_reached_through_scope(void) static void test_structure_parameters(void)
{ {
TEST_REQUIRE_OK(run_program("10 TYPE CRATE\n" TEST_REQUIRE_OK(run_program("10 TYPE CRATE\n"
"20 W#\n" "20 W#\n"
"30 END TYPE\n" "30 END TYPE\n"
"40 DIM A@ AS CRATE\n" "40 DIM A@ AS CRATE\n"
"50 A@.W# = 5\n" "50 A@.W# = 5\n"
"60 DEF SCALED(N#) = A@.W# * N#\n" "60 DEF WIDEN(B@ AS CRATE)\n"
"70 PRINT SCALED(3)\n")); "70 B@.W# = 99\n"
TEST_REQUIRE_STR(HARNESS_OUTPUT, "15\n"); "80 RETURN B@.W#\n"
"90 PRINT WIDEN(A@)\n"
"100 PRINT A@.W#\n"));
/* The callee saw 99; the caller still has 5, because it was a copy. */
TEST_REQUIRE_STR(HARNESS_OUTPUT, "99\n5\n");
harness_stop(); harness_stop();
/* And a structure parameter is refused rather than silently misbehaving. */
TEST_REQUIRE_OK(run_program("10 TYPE CRATE\n" TEST_REQUIRE_OK(run_program("10 TYPE CRATE\n"
"20 W#\n" "20 W#\n"
"30 END TYPE\n" "30 END TYPE\n"
"40 DEF WID(B@) = B@.W#\n" "40 DIM A@ AS CRATE\n"
"50 PRINT 1\n")); "50 A@.W# = 5\n"
TEST_REQUIRE(strstr(HARNESS_OUTPUT, "ERROR") != NULL, "60 DIM Q@ AS PTR TO CRATE\n"
"a structure parameter should be refused for now, got \"%s\"", HARNESS_OUTPUT); "70 POINT Q@ AT A@\n"
"80 DEF POKEIT(P@ AS PTR TO CRATE)\n"
"90 P@->W# = 42\n"
"100 RETURN P@->W#\n"
"110 PRINT POKEIT(Q@)\n"
"120 PRINT A@.W#\n"));
/* And through a pointer the caller's record does change. */
TEST_REQUIRE_STR(HARNESS_OUTPUT, "42\n42\n");
harness_stop();
}
/**
* @brief A structure parameter must name its type, and the type is checked.
*
* `@` says "a structure" without saying which, so `X@` does not state a contract
* the way `X$` does. Naming the type is what closes that, and refusing a bare
* `X@` rather than treating it as "any structure" is what keeps the rule to one
* -- duck typing there would put the hole straight back.
*/
static void test_structure_parameter_types_are_checked(void)
{
static const struct { const char *tail; const char *expect; } CASES[] = {
{ "90 DEF F(B@) = B@.W#\n100 PRINT 1\n", "must name its type" },
{ "90 DEF F(B@ AS CRATE) = B@.W#\n100 PRINT F(O@)\n", "cannot take a OTHERT" },
{ "90 DEF F(B@ AS NOSUCH) = B@.W#\n100 PRINT F(A@)\n", "which is not a type" },
{ "90 DEF F(B@ AS PTR TO CRATE) = B@->W#\n100 PRINT F(A@)\n", "expects a pointer to" },
{ "90 DEF F(B@ AS) = 1\n100 PRINT 1\n", "Expected a type name" }
};
char source[2048];
size_t i = 0;
for ( i = 0; i < sizeof(CASES) / sizeof(CASES[0]); i++ ) {
snprintf(source, sizeof(source),
"10 TYPE CRATE\n20 W#\n30 END TYPE\n"
"40 TYPE OTHERT\n50 N#\n60 END TYPE\n"
"70 DIM A@ AS CRATE\n80 DIM O@ AS OTHERT\n%s", CASES[i].tail);
TEST_REQUIRE_OK(run_program(source));
TEST_REQUIRE(strstr(HARNESS_OUTPUT, CASES[i].expect) != NULL,
"case %zu should say \"%s\", got \"%s\"",
i, CASES[i].expect, HARNESS_OUTPUT);
harness_stop();
}
}
/**
* @brief A call gives its parameter variables back when it returns.
*
* One variable leaked per call before this, so a function called two hundred
* times exhausted the 128-slot pool and reported "Maximum runtime variables
* reached" on a four-line program. It was there for `GOSUB` all along --
* measured on a stashed build -- and giving each `DEF` call its own scope simply
* made it reachable a second way.
*/
static void test_call_scopes_are_reclaimed(void)
{
TEST_REQUIRE_OK(run_program("10 DEF DBL(N#) = N# * 2\n"
"20 T# = 0\n"
"30 FOR I# = 1 TO 200\n"
"40 T# = T# + DBL(I#)\n"
"50 NEXT I#\n"
"60 PRINT T#\n"));
TEST_REQUIRE_STR(HARNESS_OUTPUT, "40200\n");
harness_stop();
/* The GOSUB half, which is where the leak actually started. */
TEST_REQUIRE_OK(run_program("10 FOR I# = 1 TO 300\n"
"20 GOSUB 100\n"
"30 NEXT I#\n"
"40 PRINT \"OK\"\n"
"50 END\n"
"100 LOCALV# = I# * 2\n"
"110 RETURN\n"));
TEST_REQUIRE_STR(HARNESS_OUTPUT, "OK\n");
harness_stop(); harness_stop();
} }
@@ -170,7 +241,9 @@ int main(void)
test_arguments_are_per_call(); test_arguments_are_per_call();
test_runaway_recursion_is_diagnosed(); test_runaway_recursion_is_diagnosed();
test_single_expression_form(); test_single_expression_form();
test_structures_reached_through_scope(); test_structure_parameters();
test_structure_parameter_types_are_checked();
test_call_scopes_are_reclaimed();
return akbasic_test_failures; return akbasic_test_failures;
} }