Honour a subscript in SSHAPE and GSHAPE

`shape_variable()` took the identifier off the leaf and looked the variable up
without ever evaluating the subscript, and both verbs then addressed element
zero with a literal. So `SSHAPE SH$(2), ...` wrote the handle into `SH$(0)` and
`GSHAPE SH$(2)` stamped whatever was in `SH$(0)`.

Ordinary assignment and `PRINT` honour the subscript, which is what made this
expensive: a program keeping several saved shapes in an array got every one of
them resolving to the same element, silently, and the only symptom was that
every stamp came out as the last shape captured. The Breakout in examples/ keeps
its six brick stamps in six separate scalars for exactly this reason.

`SPRSAV` was the counter-example and is the model -- it evaluates its argument
and handles an array element correctly. The subscript resolution itself is now
shared: `collect_subscripts()` comes out of src/environment.c as
`akbasic_environment_collect_subscripts()`, so a verb taking a variable by name
resolves a subscript the same way assignment does rather than each verb deciding
for itself.

tests/graphics_verbs.c covers TODO.md's reduction -- which used to print
"[SHAPE:0] []" and now prints "[] [SHAPE:0]" -- and the case a program actually
wants: two shapes captured into two elements, each stamped back through its own,
asserted against the device log so a fix that merely made the strings look right
would not pass.

Chapter 18's trap 4 becomes history, and Chapter 6 says an array works.

TODO.md section 9 item 6, struck.

Co-Authored-By: Claude Opus 5 (1M context) <noreply@anthropic.com>
This commit is contained in:
2026-08-02 00:10:24 -04:00
parent 694b446ce4
commit 8594d8471d
7 changed files with 122 additions and 24 deletions

11
TODO.md
View File

@@ -2704,8 +2704,15 @@ reduced against `build/basic`, the stdio build, unless it says otherwise.
This is worth a paragraph in chapter 13 beside the existing note, because "redraw it every This is worth a paragraph in chapter 13 beside the existing note, because "redraw it every
frame" is the advice there and it is not sufficient advice — the redraw also has to fit. frame" is the advice there and it is not sufficient advice — the redraw also has to fit.
6. **`SSHAPE` and `GSHAPE` ignore the subscript on a string array element.** Needs a graphics 6. ~~**`SSHAPE` and `GSHAPE` ignore the subscript on a string array element.**~~ **Done** --
device, so this one is reduced against `build-akgl/basic`. `shape_variable()` (`src/runtime_graphics.c`) now resolves the subscript the way
`SPRSAV` does, through a shared `akbasic_environment_collect_subscripts()` lifted out of
`src/environment.c` so that a verb taking a variable by name resolves one exactly as
assignment does. `tests/graphics_verbs.c` covers the reduction and the case a program
actually wants: two shapes captured into two elements and each stamped back by its own.
The original report, which needed a graphics device and was reduced against
`build-akgl/basic`:
```basic ```basic
DIM SH$(4) DIM SH$(4)

View File

@@ -227,6 +227,9 @@ parallel passes; see Chapter 13.
One disc drawn, captured, and stamped three times. One disc drawn, captured, and stamped three times.
A string array works: `SSHAPE SH$(2), ...` writes into element 2 and `GSHAPE SH$(2)`
stamps what element 2 names, so a program can keep a set of shapes in one array.
**`A$` holds a handle, not the pixels.** On a C128 the string holds the bitmap, so a **`A$` holds a handle, not the pixels.** On a C128 the string holds the bitmap, so a
program could save it to disk or take its `LEN`. Here a string is a fixed 255 bytes and program could save it to disk or take its `LEN`. Here a string is a fixed 255 bytes and
the region is a device surface, so what goes in the string is a reference to it — the region is a device surface, so what goes in the string is a reference to it —

View File

@@ -264,8 +264,9 @@ DATA 3, 9, 8, 6, 4, 5
Everything above the last four lines is a drawing nobody would ever see. `SSHAPE` and Everything above the last four lines is a drawing nobody would ever see. `SSHAPE` and
`SPRSAV` are what make it the screen. `SPRSAV` are what make it the screen.
The game keeps its six stamps in **six separate scalars** rather than an array, and that The game keeps its six stamps in **six separate scalars** rather than an array, which it
is not a style choice — see the fourth trap at the end of this chapter. had to when it was written — see the fourth trap at the end of this chapter. An array
works now.
## Step 4: Find the frame boundary ## Step 4: Find the frame boundary
@@ -704,7 +705,12 @@ is **evaluated**; the skip now releases what parsing pushed. **The listing still
its loops with `GOTO`**, which is where this chapter's own history shows: written that way its loops with `GOTO`**, which is where this chapter's own history shows: written that way
because it had to be, and left that way because it works. because it had to be, and left that way because it works.
### 4. `SSHAPE` and `GSHAPE` ignore the subscript on a string array ### 4. `SSHAPE` and `GSHAPE` ignoring a subscript — *fixed*
Also history. The handle used to land in element zero whatever subscript you wrote, and
`GSHAPE SH$(2)` stamped whatever was in `SH$(0)` — while ordinary assignment and `PRINT`
honoured the subscript, which is what made it expensive to find. The symptom was that
every brick came out the colour of the last stamp captured.
```basic requires=akgl ```basic requires=akgl
DIM SH$(4) DIM SH$(4)
@@ -713,17 +719,13 @@ PRINT "[" + SH$(0) + "] [" + SH$(2) + "]"
``` ```
```output ```output
[SHAPE:0] [] [] [SHAPE:0]
``` ```
The handle lands in element zero whatever subscript you write, and `GSHAPE SH$(2)` then An array of shapes works now. **The listing in `examples/` still keeps its six brick
stamps whatever is in `SH$(0)`. Ordinary assignment and `PRINT` honour the subscript, so stamps in six scalars** — `S0$` to `S5$` — because that is what it had to do, and the
this is the two verbs reading their leaf directly rather than evaluating it. The symptom field is still drawn as six runs of one colour rather than brick by brick, which turned
is that every brick comes out the colour of the last stamp captured. out to be cheaper anyway.
**Keep saved shapes in separate scalars.** The six brick stamps are `S0$` to `S5$` for
this reason, and the field is drawn as six runs of one colour rather than brick by brick
— which turned out to be cheaper anyway.
### 5. `READ` walks one cursor through every `DATA` item in the file ### 5. `READ` walks one cursor through every `DATA` item in the file

View File

@@ -197,6 +197,25 @@ akerr_ErrorContext AKERR_NOIGNORE *akbasic_environment_stop_waiting(akbasic_Envi
*/ */
akerr_ErrorContext AKERR_NOIGNORE *akbasic_environment_get(akbasic_Environment *obj, const char *varname, akbasic_Variable **dest); akerr_ErrorContext AKERR_NOIGNORE *akbasic_environment_get(akbasic_Environment *obj, const char *varname, akbasic_Variable **dest);
/**
* @brief Evaluate an lvalue's subscript list, or yield {0} when it has none.
*
* A bare identifier addresses element zero, because every variable here is
* really a one-element array. Shared so that a verb taking a variable by name
* -- `SSHAPE` and `GSHAPE` do -- resolves a subscript the same way assignment
* does, rather than reading the leaf and quietly using element zero for
* everything.
*
* @param obj The environment the subscript expressions are evaluated in.
* @param lval The identifier leaf, whose `.expr` carries any subscript list.
* @param subscripts Output: one index per dimension, AKBASIC_MAX_ARRAY_DEPTH wide.
* @param count Output: how many were written; at least one.
* @return `NULL` on success, otherwise an error context owned by the caller.
* @throws AKBASIC_ERR_TYPE When a subscript does not evaluate to an integer.
* @throws AKBASIC_ERR_BOUNDS When there are more than AKBASIC_MAX_ARRAY_DEPTH.
*/
akerr_ErrorContext AKERR_NOIGNORE *akbasic_environment_collect_subscripts(akbasic_Environment *obj, akbasic_ASTLeaf *lval, int64_t *subscripts, int *count);
/** /**
* @brief Find a variable in exactly this scope, creating it here if it is absent. * @brief Find a variable in exactly this scope, creating it here if it is absent.
* *

View File

@@ -329,12 +329,14 @@ akerr_ErrorContext *akbasic_environment_create(akbasic_Environment *obj, const c
* identifier yields the single subscript {0}, which is how a scalar is addressed * identifier yields the single subscript {0}, which is how a scalar is addressed
* -- every variable is really a one-element array. * -- every variable is really a one-element array.
*/ */
static akerr_ErrorContext *collect_subscripts(akbasic_Environment *obj, akbasic_ASTLeaf *lval, int64_t *subscripts, int *count) akerr_ErrorContext *akbasic_environment_collect_subscripts(akbasic_Environment *obj, akbasic_ASTLeaf *lval, int64_t *subscripts, int *count)
{ {
PREPARE_ERROR(errctx); PREPARE_ERROR(errctx);
akbasic_ASTLeaf *expr = NULL; akbasic_ASTLeaf *expr = NULL;
akbasic_Value *tval = NULL; akbasic_Value *tval = NULL;
FAIL_ZERO_RETURN(errctx, (obj != NULL && lval != NULL && subscripts != NULL && count != NULL),
AKERR_NULLPOINTER, "NULL argument in collect_subscripts");
*count = 0; *count = 0;
if ( lval->expr != NULL && if ( lval->expr != NULL &&
lval->expr->leaftype == AKBASIC_LEAF_ARGUMENTLIST && lval->expr->leaftype == AKBASIC_LEAF_ARGUMENTLIST &&
@@ -452,7 +454,7 @@ akerr_ErrorContext *akbasic_environment_assign(akbasic_Environment *obj, akbasic
PASS(errctx, akbasic_environment_get(obj, lval->identifier, &variable)); PASS(errctx, akbasic_environment_get(obj, lval->identifier, &variable));
FAIL_ZERO_RETURN(errctx, (variable != NULL), AKBASIC_ERR_UNDEFINED, FAIL_ZERO_RETURN(errctx, (variable != NULL), AKBASIC_ERR_UNDEFINED,
"Identifier %s is undefined", lval->identifier); "Identifier %s is undefined", lval->identifier);
PASS(errctx, collect_subscripts(obj, lval, subscripts, &subscriptcount)); PASS(errctx, akbasic_environment_collect_subscripts(obj, lval, subscripts, &subscriptcount));
/* /*
* Resolve the slot before the type switch. The reference notes that moving * Resolve the slot before the type switch. The reference notes that moving

View File

@@ -646,19 +646,32 @@ akerr_ErrorContext *akbasic_cmd_paint(akbasic_Runtime *obj, akbasic_ASTLeaf *exp
/* ---------------------------------------------------- SSHAPE and GSHAPE --- */ /* ---------------------------------------------------- SSHAPE and GSHAPE --- */
/** /**
* @brief Find the string variable a shape verb reads or writes. * @brief Find the string variable a shape verb reads or writes, and its subscript.
* *
* SSHAPE and GSHAPE are the only two verbs in the group whose first argument is * SSHAPE and GSHAPE are the only two verbs in the group whose first argument is
* an identifier rather than a number, so they walk the leaf themselves instead * an identifier rather than a number, so they walk the leaf themselves instead
* of going through akbasic_args_numbers(). * of going through akbasic_args_numbers().
*
* **The subscript is evaluated**, which it was not: this used to hand back the
* variable and both verbs then addressed element zero with a literal, so
* `SSHAPE SH$(2), ...` wrote the handle into `SH$(0)` and `GSHAPE SH$(2)`
* stamped whatever was in `SH$(0)`. Ordinary assignment and `PRINT` honour the
* subscript, so a program keeping several saved shapes in an array got every one
* of them resolving to the same element -- silently, the symptom being that
* every stamp came out as the last shape captured. TODO.md section 9 item 6.
*
* `SPRSAV` was the counter-example and is the model: it evaluates its argument
* (`src/runtime_sprite.c`) and handles an array element correctly.
*/ */
static akerr_ErrorContext *shape_variable(akbasic_Runtime *obj, akbasic_ASTLeaf *expr, const char *verb, akbasic_Variable **dest, akbasic_ASTLeaf **rest) static akerr_ErrorContext *shape_variable(akbasic_Runtime *obj, akbasic_ASTLeaf *expr, const char *verb, akbasic_Variable **dest, int64_t *subscripts, int *subscriptcount, akbasic_ASTLeaf **rest)
{ {
PREPARE_ERROR(errctx); PREPARE_ERROR(errctx);
akbasic_ASTLeaf *arg = NULL; akbasic_ASTLeaf *arg = NULL;
FAIL_ZERO_RETURN(errctx, (obj != NULL && expr != NULL && dest != NULL && rest != NULL), FAIL_ZERO_RETURN(errctx, (obj != NULL && expr != NULL && dest != NULL && rest != NULL),
AKERR_NULLPOINTER, "NULL argument in shape_variable"); AKERR_NULLPOINTER, "NULL argument in shape_variable");
FAIL_ZERO_RETURN(errctx, (subscripts != NULL && subscriptcount != NULL),
AKERR_NULLPOINTER, "NULL subscript output in shape_variable");
arg = akbasic_leaf_first_argument(expr); arg = akbasic_leaf_first_argument(expr);
FAIL_ZERO_RETURN(errctx, (arg != NULL), AKBASIC_ERR_SYNTAX, FAIL_ZERO_RETURN(errctx, (arg != NULL), AKBASIC_ERR_SYNTAX,
"%s expected a string variable", verb); "%s expected a string variable", verb);
@@ -667,6 +680,8 @@ static akerr_ErrorContext *shape_variable(akbasic_Runtime *obj, akbasic_ASTLeaf
PASS(errctx, akbasic_environment_get(obj->environment, arg->identifier, dest)); PASS(errctx, akbasic_environment_get(obj->environment, arg->identifier, dest));
FAIL_ZERO_RETURN(errctx, (*dest != NULL), AKBASIC_ERR_UNDEFINED, FAIL_ZERO_RETURN(errctx, (*dest != NULL), AKBASIC_ERR_UNDEFINED,
"%s could not reach the variable %s", verb, arg->identifier); "%s could not reach the variable %s", verb, arg->identifier);
PASS(errctx, akbasic_environment_collect_subscripts(obj->environment, arg,
subscripts, subscriptcount));
*rest = arg->next; *rest = arg->next;
SUCCEED_RETURN(errctx); SUCCEED_RETURN(errctx);
} }
@@ -681,11 +696,13 @@ akerr_ErrorContext *akbasic_cmd_sshape(akbasic_Runtime *obj, akbasic_ASTLeaf *ex
int count = 0; int count = 0;
int handle = -1; int handle = -1;
char encoded[AKBASIC_MAX_STRING_LENGTH]; char encoded[AKBASIC_MAX_STRING_LENGTH];
int64_t zerosubscript[1] = { 0 }; int64_t subscripts[AKBASIC_MAX_ARRAY_DEPTH];
int subscriptcount = 0;
(void)lval; (void)rval; (void)lval; (void)rval;
PASS(errctx, require_graphics(obj, "SSHAPE")); PASS(errctx, require_graphics(obj, "SSHAPE"));
PASS(errctx, shape_variable(obj, expr, "SSHAPE", &variable, &arg)); PASS(errctx, shape_variable(obj, expr, "SSHAPE", &variable,
subscripts, &subscriptcount, &arg));
while ( arg != NULL && count < 4 ) { while ( arg != NULL && count < 4 ) {
PASS(errctx, akbasic_runtime_evaluate(obj, arg, &value)); PASS(errctx, akbasic_runtime_evaluate(obj, arg, &value));
@@ -715,7 +732,7 @@ akerr_ErrorContext *akbasic_cmd_sshape(akbasic_Runtime *obj, akbasic_ASTLeaf *ex
* take its LEN and get a size. TODO.md section 5. * take its LEN and get a size. TODO.md section 5.
*/ */
snprintf(encoded, sizeof(encoded), "%s%d", SHAPE_PREFIX, handle); snprintf(encoded, sizeof(encoded), "%s%d", SHAPE_PREFIX, handle);
PASS(errctx, akbasic_variable_set_string(variable, encoded, zerosubscript, 1)); PASS(errctx, akbasic_variable_set_string(variable, encoded, subscripts, subscriptcount));
SUCCEED_TRUE(obj, dest); SUCCEED_TRUE(obj, dest);
SUCCEED_RETURN(errctx); SUCCEED_RETURN(errctx);
} }
@@ -733,11 +750,13 @@ akerr_ErrorContext *akbasic_cmd_gshape(akbasic_Runtime *obj, akbasic_ASTLeaf *ex
long long converted = 0; long long converted = 0;
double x = 0.0; double x = 0.0;
double y = 0.0; double y = 0.0;
int64_t zerosubscript[1] = { 0 }; int64_t subscripts[AKBASIC_MAX_ARRAY_DEPTH];
int subscriptcount = 0;
(void)lval; (void)rval; (void)lval; (void)rval;
PASS(errctx, require_graphics(obj, "GSHAPE")); PASS(errctx, require_graphics(obj, "GSHAPE"));
PASS(errctx, shape_variable(obj, expr, "GSHAPE", &variable, &arg)); PASS(errctx, shape_variable(obj, expr, "GSHAPE", &variable,
subscripts, &subscriptcount, &arg));
while ( arg != NULL && count < 2 ) { while ( arg != NULL && count < 2 ) {
PASS(errctx, akbasic_runtime_evaluate(obj, arg, &value)); PASS(errctx, akbasic_runtime_evaluate(obj, arg, &value));
@@ -751,7 +770,7 @@ akerr_ErrorContext *akbasic_cmd_gshape(akbasic_Runtime *obj, akbasic_ASTLeaf *ex
x = (count >= 1) ? coords[0] : obj->gfx.x; x = (count >= 1) ? coords[0] : obj->gfx.x;
y = (count >= 2) ? coords[1] : obj->gfx.y; y = (count >= 2) ? coords[1] : obj->gfx.y;
PASS(errctx, akbasic_variable_get_subscript(variable, zerosubscript, 1, &stored)); PASS(errctx, akbasic_variable_get_subscript(variable, subscripts, subscriptcount, &stored));
FAIL_ZERO_RETURN(errctx, FAIL_ZERO_RETURN(errctx,
(strncmp(stored->stringval, SHAPE_PREFIX, strlen(SHAPE_PREFIX)) == 0), (strncmp(stored->stringval, SHAPE_PREFIX, strlen(SHAPE_PREFIX)) == 0),
AKBASIC_ERR_VALUE, AKBASIC_ERR_VALUE,

View File

@@ -359,6 +359,51 @@ static void test_shapes(void)
harness_stop(); harness_stop();
} }
/**
* @brief Both verbs honour a subscript on a string array.
*
* They used to ignore it. `shape_variable()` took the identifier and looked the
* variable up without evaluating the subscript, and both verbs then addressed
* element zero with a literal -- so `SSHAPE SH$(2), ...` wrote the handle into
* `SH$(0)` and `GSHAPE SH$(2)` stamped whatever was in `SH$(0)`.
*
* Ordinary assignment and `PRINT` honour the subscript, which is what made it
* expensive: a program keeping several saved shapes in an array got every one of
* them resolving to the same element, silently, and the only symptom was that
* every stamp came out as the last shape captured. The Breakout in `examples/`
* keeps its six brick stamps in six separate scalars because of this. TODO.md
* section 9 item 6.
*/
static void test_shape_subscripts(void)
{
TEST_REQUIRE_OK(run_program("10 DIM SH$(4)\n"
"20 SSHAPE SH$(2), 0, 0, 8, 8\n"
"30 PRINT \"[\" + SH$(0) + \"] [\" + SH$(2) + \"]\"\n"));
/* The reduction from TODO.md, which used to print "[SHAPE:0] []". */
TEST_REQUIRE_STR(HARNESS_OUTPUT, "[] [SHAPE:0]\n");
harness_stop();
/*
* Two shapes in two elements, which is the case a program actually wants and
* the one that came out wrong: the second capture used to overwrite the
* first, so both elements named the same handle.
*/
TEST_REQUIRE_OK(run_program("10 DIM SH$(4)\n"
"20 SSHAPE SH$(1), 0, 0, 8, 8\n"
"30 SSHAPE SH$(2), 0, 0, 4, 4\n"
"40 PRINT \"[\" + SH$(1) + \"] [\" + SH$(2) + \"]\"\n"
"50 GSHAPE SH$(2), 10, 10\n"
"60 GSHAPE SH$(1), 20, 20\n"));
TEST_REQUIRE_STR(HARNESS_OUTPUT, "[SHAPE:0] [SHAPE:1]\n");
/* And each GSHAPE stamps the handle its own element names. */
TEST_REQUIRE_STR(MOCK.log,
"save 0,0-8,8 -> 0\n"
"save 0,0-4,4 -> 1\n"
"paste 1 at 10.0,10.0\n"
"paste 0 at 20.0,20.0\n");
harness_stop();
}
/** /**
* @brief Every verb that needs a device says so by name when it has none. * @brief Every verb that needs a device says so by name when it has none.
* *
@@ -398,6 +443,7 @@ int main(void)
test_rgr(); test_rgr();
test_graphic(); test_graphic();
test_shapes(); test_shapes();
test_shape_subscripts();
test_no_device(); test_no_device();
return akbasic_test_failures; return akbasic_test_failures;
} }