From c1d06ee4b8fd39309e6eac0acab0498cdc2bb906 Mon Sep 17 00:00:00 2001 From: Andrew Kesterson Date: Sat, 1 Aug 2026 13:05:32 -0400 Subject: [PATCH] Let DEF take structure parameters, and give call scopes back 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) --- TODO.md | 45 +++++++++- docs/16-structures.md | 81 +++++++++++++++-- src/parser_commands.c | 98 +++++++++++++++++--- src/runtime.c | 94 ++++++++++++++++++- src/value.c | 12 +++ tests/language/structures/parameters.bas | 47 ++++++++++ tests/language/structures/parameters.txt | 6 ++ tests/user_functions.c | 109 +++++++++++++++++++---- 8 files changed, 452 insertions(+), 40 deletions(-) create mode 100644 tests/language/structures/parameters.bas create mode 100644 tests/language/structures/parameters.txt diff --git a/TODO.md b/TODO.md index 29f613f..60a37d6 100644 --- a/TODO.md +++ b/TODO.md @@ -1575,6 +1575,45 @@ the reference's semantics reproduced faithfully; the third is the port's own. ### 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 junk value.** The call's error is reported and the run stops, but the *enclosing* 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 | |---|---| -| `ctest` | 106/106 — 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` | 107/107 — 41 reference golden cases, 20 local ones, 39 unit tests, 3 embedding examples, and `docs_examples` | +| `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_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 | -| ASan + UBSan | 106/106 | +| ASan + UBSan | 107/107 | | Line coverage | 94.8% (6648/7013) — above the 90% gate | | Function coverage | 98.4% (441/448) | | Warnings | none under `-Wall -Wextra` | diff --git a/docs/16-structures.md b/docs/16-structures.md index 85d2bf0..5fbdcb2 100644 --- a/docs/16-structures.md +++ b/docs/16-structures.md @@ -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 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 -bound `GOSUB` has. What a function cannot yet do is take a structure *parameter*: -`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 -the scoping already allows — a call can see the caller's variables. +**A pointer is true when it points at something**, which is how a walk knows where the +list ends — and a recursive `DEF` can do the walking: + +```basic +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 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 A field name is checked against the set the type declared, and the refusal lists the diff --git a/src/parser_commands.c b/src/parser_commands.c index 1b02580..7cf2f05 100644 --- a/src/parser_commands.c +++ b/src/parser_commands.c @@ -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 * 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 "); + 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, ¶m)); + 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) { PREPARE_ERROR(errctx); @@ -680,7 +764,6 @@ akerr_ErrorContext *akbasic_parse_def(akbasic_Parser *parser, akbasic_ASTLeaf ** akbasic_ASTLeaf *identifier = NULL; akbasic_ASTLeaf *arglist = NULL; akbasic_ASTLeaf *expression = NULL; - akbasic_ASTLeaf *walk = NULL; akbasic_ASTLeaf *command = NULL; akbasic_FunctionDef *fndef = NULL; 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), AKBASIC_ERR_SYNTAX, "Expected identifier"); - PASS(errctx, akbasic_parser_argument_list(parser, AKBASIC_TOK_FUNCTION_ARGUMENT, true, &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, parse_def_parameters(parser, &arglist)); PASS(errctx, akbasic_runtime_new_function(runtime, &fndef)); diff --git a/src/runtime.c b/src/runtime.c index 1cf0952..9de8d2b 100644 --- a/src/runtime.c +++ b/src/runtime.c @@ -122,12 +122,39 @@ akerr_ErrorContext *akbasic_runtime_prev_environment(akbasic_Runtime *obj) { PREPARE_ERROR(errctx); 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->environment->parent != NULL), AKBASIC_ERR_ENVIRONMENT, "No previous environment to return to"); popped = obj->environment; 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; * 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); } +/** + * @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) { PREPARE_ERROR(errctx); @@ -808,7 +896,11 @@ akerr_ErrorContext *akbasic_runtime_user_function(akbasic_Runtime *obj, akbasic_ while ( leafptr != NULL && argptr != NULL ) { PASS(errctx, akbasic_runtime_evaluate(obj, leafptr, &argvalue)); 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; leafptr = leafptr->next; argptr = argptr->next; diff --git a/src/value.c b/src/value.c index 09ce6a4..ab30f8f 100644 --- a/src/value.c +++ b/src/value.c @@ -287,6 +287,18 @@ bool akbasic_value_is_truthy(akbasic_Value *self) switch ( self->valuetype ) { case AKBASIC_TYPE_BOOLEAN: 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: return (self->intval != 0); case AKBASIC_TYPE_FLOAT: diff --git a/tests/language/structures/parameters.bas b/tests/language/structures/parameters.bas new file mode 100644 index 0000000..b204c20 --- /dev/null +++ b/tests/language/structures/parameters.bas @@ -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@) diff --git a/tests/language/structures/parameters.txt b/tests/language/structures/parameters.txt new file mode 100644 index 0000000..03a4d6b --- /dev/null +++ b/tests/language/structures/parameters.txt @@ -0,0 +1,6 @@ +15 +99 +5 +42 +42 +30 diff --git a/tests/user_functions.c b/tests/user_functions.c index 7bbe5e0..f989572 100644 --- a/tests/user_functions.c +++ b/tests/user_functions.c @@ -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 - * bare `DEF F(B@)` is refused because `@` alone does not say *which* type. So - * the way a function works with a record today is by name, which the dynamic - * 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. + * Neither is a special rule: a parameter is bound by assignment like any other + * variable, and assignment copies a structure and copies a pointer's reference. + * The two halves of the feature seen from a function's side. */ -static void test_structures_reached_through_scope(void) +static void test_structure_parameters(void) { TEST_REQUIRE_OK(run_program("10 TYPE CRATE\n" "20 W#\n" "30 END TYPE\n" "40 DIM A@ AS CRATE\n" "50 A@.W# = 5\n" - "60 DEF SCALED(N#) = A@.W# * N#\n" - "70 PRINT SCALED(3)\n")); - TEST_REQUIRE_STR(HARNESS_OUTPUT, "15\n"); + "60 DEF WIDEN(B@ AS CRATE)\n" + "70 B@.W# = 99\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(); - /* And a structure parameter is refused rather than silently misbehaving. */ TEST_REQUIRE_OK(run_program("10 TYPE CRATE\n" "20 W#\n" "30 END TYPE\n" - "40 DEF WID(B@) = B@.W#\n" - "50 PRINT 1\n")); - TEST_REQUIRE(strstr(HARNESS_OUTPUT, "ERROR") != NULL, - "a structure parameter should be refused for now, got \"%s\"", HARNESS_OUTPUT); + "40 DIM A@ AS CRATE\n" + "50 A@.W# = 5\n" + "60 DIM Q@ AS PTR TO CRATE\n" + "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(); } @@ -170,7 +241,9 @@ int main(void) test_arguments_are_per_call(); test_runaway_recursion_is_diagnosed(); 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; }