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

Finish the language: every remaining verb group, and the defects that blocked them

Browse Source 
Closes groups A, C, D, E, F, H and J of TODO.md section 4, plus RESTORE and
RENUMBER, and closes section 6 -- all seventeen reference defects. Seven of
those turned out to have been fixed or never ported and nobody had written it
down; the audit records the evidence for each.

Two of the seventeen were real. math_plus mutated its left operand when the
operand was mutable, so A# + 1 could modify A#; it was gated on FOR/NEXT
coverage because NEXT relied on the mutation, so tests/for_next.c came first
and NEXT now writes the counter back itself. And the binary operators summed
both numeric fields of their right operand, which no BASIC program can reach
-- that one needed a test written against the value API.

Writing the tests turned up eight defects nobody had listed. Seven are fixed:

  IF A = 2 THEN was a parse error; only == worked
  IF ... AND ... was a parse error, because a condition parsed as one relation
  IF A = 1 OR B = 2 THEN was silently always false, and so was IF A THEN
  EXIT before any NEXT restarted the program and exhausted the variable pool
  READ never found a DATA line above it, and swallowed the lines between
  PRINT 2 + 2 at the prompt was filed as program text instead of answering
  a short read discarded its bytes, so COPY produced empty files
  every verb taking an argument list said "peek() returned nil token!" on none

The eighth is not fixed and cannot be quietly: a FOR whose step overshoots
runs its body one extra time, and FOR I = 1 TO 1 runs it zero times. The two
errors cancel for a step of 1, which is why neither was noticed. Correcting
them changes the expected output of a checked-in acceptance file, and
tests/reference/README.md forbids editing one to suit this interpreter. It is
tests/for_semantics.c in AKBASIC_KNOWN_FAILING_TESTS, asserting the correct
contract, and TODO.md items 19 and 20.

Sprites are real libakgl actors with a renderfunc of their own, because
akgl_actor_render draws every sprite square and an actor has no per-axis
scale. Both are filed upstream. SPRSAV takes an image file, an SSHAPE handle
or a 63-element integer array -- a string here cannot hold a zero byte.

Verbs that need hardware that does not exist are refused by name with the
reason rather than faked: SYS, HEADER, COLLECT, BACKUP, BOOT, FILTER, and
DIRECTORY, which is refused for a missing libakstdlib wrapper filed upstream.

94 tests in the default build, 93 with SDL, 94 under ASan and UBSan, doxygen
clean. The Go acceptance corpus stayed green throughout.

Co-Authored-By: Claude Opus 5 (1M context) <noreply@anthropic.com>
This commit is contained in:
Andrew Kesterson
2026-07-31 21:50:37 -04:00
parent 3aade4947a
commit 9845e77a5c
87 changed files with 11024 additions and 325 deletions
Download Patch File Download Diff File Expand all files Collapse all files

43
src/args.c Normal file
View File

@@ -0,0 +1,43 @@
/**
* @file args.c
* @brief Implements the shared positional-argument collector.
*/
#include <akerror.h>
#include <akbasic/args.h>
#include <akbasic/error.h>
#include <akbasic/runtime.h>
akerr_ErrorContext *akbasic_args_numbers(akbasic_Runtime *obj, akbasic_ASTLeaf *expr, const char *verb, double *values, int max, int *count)
{
PREPARE_ERROR(errctx);
akbasic_ASTLeaf *arg = NULL;
akbasic_Value *value = NULL;
FAIL_ZERO_RETURN(errctx, (obj != NULL && expr != NULL && values != NULL && count != NULL),
AKERR_NULLPOINTER, "NULL argument in args_numbers");
*count = 0;
arg = akbasic_leaf_first_argument(expr);
/*
* A loop, so CATCH and the _BREAK macros are banned in here -- they expand to
* a C break and would leave the loop with an error still pending. PASS and
* the _RETURN forms only.
*/
while ( arg != NULL ) {
FAIL_NONZERO_RETURN(errctx, (*count >= max), AKBASIC_ERR_SYNTAX,
"%s takes at most %d arguments", verb, max);
PASS(errctx, akbasic_runtime_evaluate(obj, arg, &value));
FAIL_NONZERO_RETURN(errctx, (value->valuetype == AKBASIC_TYPE_STRING),
AKBASIC_ERR_TYPE,
"%s expected a number in argument %d", verb, *count + 1);
if ( value->valuetype == AKBASIC_TYPE_FLOAT ) {
values[*count] = value->floatval;
} else {
values[*count] = (double)value->intval;
}
*count += 1;
arg = arg->next;
}
SUCCEED_RETURN(errctx);
}

211
src/data.c Normal file
View File

@@ -0,0 +1,211 @@
/**
* @file data.c
* @brief Implements the `DATA` item list and the `READ` cursor.
*/
#include <ctype.h>
#include <inttypes.h>
#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#include <strings.h>
#include <akerror.h>
#include <akstdlib.h>
#include <akbasic/data.h>
#include <akbasic/error.h>
#include <akbasic/runtime.h>
akerr_ErrorContext *akbasic_data_state_init(akbasic_DataState *obj)
{
PREPARE_ERROR(errctx);
FAIL_ZERO_RETURN(errctx, (obj != NULL), AKERR_NULLPOINTER, "NULL data state in init");
obj->count = 0;
obj->cursor = 0;
SUCCEED_RETURN(errctx);
}
/**
* @brief Collect the items of one `DATA` statement.
*
* @param obj The list to append to.
* @param cursor Points just past the `DATA` keyword; advanced past what is read.
* @param lineno The line these items were written on.
* @return `NULL` on success, otherwise an error context owned by the caller.
* @throws AKBASIC_ERR_BOUNDS When the list is full or an item is too long.
*/
static akerr_ErrorContext *collect_items(akbasic_DataState *obj, const char **cursor, int64_t lineno)
{
PREPARE_ERROR(errctx);
const char *p = *cursor;
for ( ;; ) {
akbasic_DataItem *item = NULL;
size_t used = 0;
while ( *p == ' ' || *p == '\t' ) {
p += 1;
}
if ( *p == '\0' || *p == ':' ) {
break;
}
FAIL_ZERO_RETURN(errctx, (obj->count < AKBASIC_MAX_DATA_ITEMS), AKBASIC_ERR_BOUNDS,
"The program holds more than %d DATA items", AKBASIC_MAX_DATA_ITEMS);
item = &obj->items[obj->count];
item->lineno = lineno;
item->quoted = false;
if ( *p == '"' ) {
/*
* A quoted item runs to its closing quote and may hold anything --
* commas, colons, spaces. That is the only way to put a comma in a
* DATA item, and it is why the scan has to understand quotes at all.
*/
item->quoted = true;
p += 1;
while ( *p != '\0' && *p != '"' && used < sizeof(item->text) - 1 ) {
item->text[used] = *p;
used += 1;
p += 1;
}
if ( *p == '"' ) {
p += 1;
}
} else {
while ( *p != '\0' && *p != ',' && *p != ':' && used < sizeof(item->text) - 1 ) {
item->text[used] = *p;
used += 1;
p += 1;
}
/* Trailing spaces are not part of an unquoted item. */
while ( used > 0 && (item->text[used - 1] == ' ' || item->text[used - 1] == '\t') ) {
used -= 1;
}
}
item->text[used] = '\0';
obj->count += 1;
while ( *p == ' ' || *p == '\t' ) {
p += 1;
}
if ( *p != ',' ) {
break;
}
p += 1;
}
*cursor = p;
SUCCEED_RETURN(errctx);
}
/**
* @brief Scan one source line for `DATA` statements.
*
* Walks statement by statement, the way scan_line_labels() does, because `DATA`
* is a verb and a verb starts a statement -- and a string literal is the only
* thing that can hide a separator.
*/
static akerr_ErrorContext *scan_line(akbasic_DataState *obj, const char *code, int64_t lineno)
{
PREPARE_ERROR(errctx);
const char *cursor = code;
bool statementstart = true;
bool instring = false;
while ( *cursor != '\0' ) {
if ( instring ) {
instring = (*cursor != '"');
cursor += 1;
continue;
}
if ( *cursor == '"' ) {
instring = true;
statementstart = false;
cursor += 1;
continue;
}
if ( *cursor == ':' ) {
statementstart = true;
cursor += 1;
continue;
}
if ( isspace((unsigned char)*cursor) ) {
cursor += 1;
continue;
}
/* A stored line may still carry its own number; see scan_line_labels(). */
if ( statementstart && isdigit((unsigned char)*cursor) ) {
while ( isdigit((unsigned char)*cursor) ) {
cursor += 1;
}
continue;
}
if ( statementstart && strncasecmp(cursor, "DATA", 4) == 0
&& !isalnum((unsigned char)cursor[4]) ) {
cursor += 4;
PASS(errctx, collect_items(obj, &cursor, lineno));
statementstart = false;
continue;
}
statementstart = false;
cursor += 1;
}
SUCCEED_RETURN(errctx);
}
akerr_ErrorContext *akbasic_data_scan(akbasic_Runtime *obj)
{
PREPARE_ERROR(errctx);
int64_t i = 0;
FAIL_ZERO_RETURN(errctx, (obj != NULL), AKERR_NULLPOINTER, "NULL runtime in data_scan");
PASS(errctx, akbasic_data_state_init(&obj->data_state));
for ( i = 0; i < AKBASIC_MAX_SOURCE_LINES; i++ ) {
if ( obj->source[i].code[0] != '\0' ) {
PASS(errctx, scan_line(&obj->data_state, obj->source[i].code, i));
}
}
SUCCEED_RETURN(errctx);
}
akerr_ErrorContext *akbasic_data_next(akbasic_Runtime *obj, akbasic_Type type, akbasic_Value *dest)
{
PREPARE_ERROR(errctx);
akbasic_DataItem *item = NULL;
FAIL_ZERO_RETURN(errctx, (obj != NULL && dest != NULL), AKERR_NULLPOINTER,
"NULL argument in data_next");
FAIL_ZERO_RETURN(errctx, (obj->data_state.cursor < obj->data_state.count),
AKBASIC_ERR_STATE, "OUT OF DATA");
item = &obj->data_state.items[obj->data_state.cursor];
obj->data_state.cursor += 1;
PASS(errctx, akbasic_value_zero(dest));
if ( type == AKBASIC_TYPE_STRING ) {
dest->valuetype = AKBASIC_TYPE_STRING;
snprintf(dest->stringval, sizeof(dest->stringval), "%s", item->text);
SUCCEED_RETURN(errctx);
}
/*
* A quoted item is a string and reading it into a number is a mistake worth
* reporting -- `READ A#` against `DATA "TEXT"` would otherwise quietly yield
* zero. An *unquoted* item that is not a number is caught the same way, by
* the conversion refusing it.
*/
FAIL_NONZERO_RETURN(errctx, item->quoted, AKBASIC_ERR_TYPE,
"READ: DATA item \"%s\" on line %" PRId64 " is a string",
item->text, item->lineno);
if ( type == AKBASIC_TYPE_FLOAT ) {
dest->valuetype = AKBASIC_TYPE_FLOAT;
PASS(errctx, aksl_atof(item->text, &dest->floatval));
} else {
long long converted = 0;
dest->valuetype = AKBASIC_TYPE_INTEGER;
PASS(errctx, aksl_atoll(item->text, &converted));
dest->intval = (int64_t)converted;
}
SUCCEED_RETURN(errctx);
}

7
src/environment.c
View File

@@ -30,12 +30,19 @@ akerr_ErrorContext *akbasic_environment_init(akbasic_Environment *obj, akbasic_R
obj->forToLeaf = NULL;
obj->loopFirstLine = 0;
obj->loopExitLine = 0;
obj->exiting = false;
obj->doConditionLeaf = NULL;
obj->doConditionKind = AKBASIC_LOOPCOND_NONE;
obj->isDoLoop = false;
obj->gosubReturnLine = 0;
obj->readReturnLine = 0;
obj->readIdentifierIdx = 0;
obj->waitingForCommand[0] = '\0';
obj->errorToken = NULL;
memset(obj->readIdentifierLeaves, 0, sizeof(obj->readIdentifierLeaves));
obj->doLeafPool.next = 0;
obj->doLeafPool.capacity = AKBASIC_MAX_CONDITION_LEAVES;
obj->doLeafPool.leaves = obj->doLeafStorage;
obj->readLeafPool.next = 0;
obj->readLeafPool.capacity = AKBASIC_MAX_LEAVES;
obj->readLeafPool.leaves = obj->readLeafStorage;

354
src/format.c Normal file
View File

@@ -0,0 +1,354 @@
/**
* @file format.c
* @brief Implements `PRINT USING` field formatting.
*
* One field per call, with whatever literal text surrounds it copied through.
* The work splits three ways: find the field, measure it, then fill it.
*/
#include <inttypes.h>
#include <math.h>
#include <stdio.h>
#include <string.h>
#include <akerror.h>
#include <akbasic/error.h>
#include <akbasic/format.h>
/** @brief The PUDEF defaults, in PUDEF's own order. */
static const char PUDEF_DEFAULTS[AKBASIC_PUDEF_CHARS] = { ' ', ',', '.', '$' };
/** @brief True for a character that can only appear inside a numeric field. */
static bool is_numeric_field_char(char c)
{
return (c == '#' || c == ',' || c == '.');
}
/** @brief True for a character that can only appear inside a string field. */
static bool is_string_field_char(char c)
{
return (c == '=' || c == '>');
}
akerr_ErrorContext *akbasic_format_state_init(akbasic_FormatState *obj)
{
PREPARE_ERROR(errctx);
FAIL_ZERO_RETURN(errctx, (obj != NULL), AKERR_NULLPOINTER, "NULL format state in init");
memcpy(obj->chars, PUDEF_DEFAULTS, sizeof(obj->chars));
SUCCEED_RETURN(errctx);
}
akerr_ErrorContext *akbasic_format_pudef(akbasic_FormatState *obj, const char *chars)
{
PREPARE_ERROR(errctx);
int i = 0;
FAIL_ZERO_RETURN(errctx, (obj != NULL && chars != NULL), AKERR_NULLPOINTER,
"NULL argument in pudef");
/*
* Only as many as were given. `PUDEF "*"` redefines the leading blank and
* leaves the comma, the point and the dollar alone, which is BASIC 7.0's
* rule and is what makes the one-character form useful.
*/
for ( i = 0; i < AKBASIC_PUDEF_CHARS && chars[i] != '\0'; i++ ) {
obj->chars[i] = chars[i];
}
SUCCEED_RETURN(errctx);
}
/**
* @brief Locate the first field in a format string.
*
* @param format The format string.
* @param start Output: index of the field's first character.
* @param length Output: how many characters the field spans.
* @param numeric Output: true for a numeric field, false for a string field.
* @return `NULL` on success, otherwise an error context owned by the caller.
* @throws AKBASIC_ERR_SYNTAX When there is no field.
*/
static akerr_ErrorContext *find_field(const char *format, size_t *start, size_t *length, bool *numeric)
{
PREPARE_ERROR(errctx);
size_t i = 0;
for ( i = 0; format[i] != '\0'; i++ ) {
if ( format[i] == '#' || format[i] == '.' ) {
*numeric = true;
break;
}
if ( is_string_field_char(format[i]) ) {
*numeric = false;
break;
}
}
FAIL_ZERO_RETURN(errctx, (format[i] != '\0'), AKBASIC_ERR_SYNTAX,
"PRINT USING format \"%s\" contains no field", format);
/*
* A `$`, `+` or `-` immediately before the field belongs to it. Scanning
* backwards is how a leading sign or currency sign is told apart from
* literal text: `"COST $###"` has a field of `$###`, and `"A + B ###"` does
* not, because the `+` is not adjacent.
*/
*start = i;
while ( *start > 0 && (format[*start - 1] == '$' || format[*start - 1] == '+' ||
format[*start - 1] == '-') ) {
*start -= 1;
}
for ( ; format[i] != '\0'; i++ ) {
if ( *numeric && is_numeric_field_char(format[i]) ) {
continue;
}
if ( !(*numeric) && is_string_field_char(format[i]) ) {
continue;
}
break;
}
/* A trailing sign belongs to the field too. */
if ( format[i] == '+' || format[i] == '-' ) {
i += 1;
}
*length = i - *start;
SUCCEED_RETURN(errctx);
}
/** @brief Measure a numeric field: digits before and after the point, and its decorations. */
static void measure_numeric(const char *field, size_t length, int *before, int *after,
bool *commas, bool *dollar, bool *leadsign, bool *trailsign)
{
size_t i = 0;
bool seenpoint = false;
*before = 0;
*after = 0;
*commas = false;
*dollar = false;
*leadsign = false;
*trailsign = false;
for ( i = 0; i < length; i++ ) {
switch ( field[i] ) {
case '#':
if ( seenpoint ) {
*after += 1;
} else {
*before += 1;
}
break;
case '.':
seenpoint = true;
break;
case ',':
*commas = true;
break;
case '$':
*dollar = true;
break;
case '+':
case '-':
if ( i == 0 ) {
*leadsign = true;
} else {
*trailsign = true;
}
break;
default:
break;
}
}
}
/** @brief Fill @p dest with @p width copies of `*`, the overflow marker. */
static void overflow(char *dest, size_t width)
{
memset(dest, '*', width);
dest[width] = '\0';
}
/**
* @brief Render a number into a measured numeric field.
*
* @return `NULL` on success, otherwise an error context owned by the caller.
*/
static akerr_ErrorContext *render_numeric(akbasic_FormatState *obj, const char *field, size_t length,
double number, char *dest, size_t len)
{
PREPARE_ERROR(errctx);
char digits[AKBASIC_MAX_STRING_LENGTH];
char grouped[AKBASIC_MAX_STRING_LENGTH];
char *point = NULL;
size_t used = 0;
size_t i = 0;
size_t intlen = 0;
int before = 0;
int after = 0;
int group = 0;
bool commas = false;
bool dollar = false;
bool leadsign = false;
bool trailsign = false;
bool negative = (number < 0.0);
measure_numeric(field, length, &before, &after, &commas, &dollar, &leadsign, &trailsign);
FAIL_ZERO_RETURN(errctx, (length + 1 <= len), AKBASIC_ERR_BOUNDS,
"PRINT USING field of %zu characters does not fit", length);
snprintf(digits, sizeof(digits), "%.*f", after, (negative ? -number : number));
point = strchr(digits, '.');
intlen = (point != NULL ? (size_t)(point - digits) : strlen(digits));
/* Group the integer part, if the field asked for separators. */
used = 0;
if ( commas ) {
for ( i = 0; i < intlen; i++ ) {
if ( i > 0 && ((intlen - i) % 3) == 0 ) {
grouped[used] = obj->chars[AKBASIC_PUDEF_COMMA];
used += 1;
}
grouped[used] = digits[i];
used += 1;
}
} else {
memcpy(grouped, digits, intlen);
used = intlen;
}
grouped[used] = '\0';
group = (int)used;
/*
* Does it fit? The field's `#` positions before the point are the budget,
* and a separator or a sign that the field asked for costs nothing extra
* because it was written into the field. Overflow fills with `*` rather than
* printing wider than asked, which would misalign every later column.
*/
if ( (int)intlen > before ) {
overflow(dest, length);
SUCCEED_RETURN(errctx);
}
used = 0;
if ( leadsign ) {
dest[used] = (negative ? '-' : '+');
used += 1;
}
if ( dollar ) {
dest[used] = obj->chars[AKBASIC_PUDEF_DOLLAR];
used += 1;
}
/*
* Right-justify inside the digit positions, padding with the PUDEF blank.
* The width to pad to counts the separators the field will actually use, so
* `###,###` holding 1234 pads to the same column every time.
*/
{
int width = before + (commas ? (before - 1) / 3 : 0);
for ( i = (size_t)group; (int)i < width; i++ ) {
dest[used] = obj->chars[AKBASIC_PUDEF_BLANK];
used += 1;
}
}
memcpy(dest + used, grouped, (size_t)group);
used += (size_t)group;
if ( after > 0 ) {
dest[used] = obj->chars[AKBASIC_PUDEF_POINT];
used += 1;
memcpy(dest + used, (point != NULL ? point + 1 : ""), (size_t)after);
used += (size_t)after;
}
if ( trailsign ) {
dest[used] = (negative ? '-' : '+');
used += 1;
}
/*
* A negative number in a field with no sign position still has to say so.
* BASIC 7.0 overflows the field in that case rather than dropping the minus,
* because a printed -5 that reads as 5 is worse than a row of stars.
*/
if ( negative && !leadsign && !trailsign ) {
overflow(dest, length);
SUCCEED_RETURN(errctx);
}
dest[used] = '\0';
SUCCEED_RETURN(errctx);
}
/** @brief Render a string into a measured string field: `=` centres, `>` right-justifies. */
static akerr_ErrorContext *render_string(const char *field, size_t length, const char *text,
char *dest, size_t len)
{
PREPARE_ERROR(errctx);
size_t textlen = strlen(text);
size_t pad = 0;
FAIL_ZERO_RETURN(errctx, (length + 1 <= len), AKBASIC_ERR_BOUNDS,
"PRINT USING field of %zu characters does not fit", length);
if ( textlen > length ) {
/* Truncated, not starred: BASIC 7.0 cuts a string to its field. */
memcpy(dest, text, length);
dest[length] = '\0';
SUCCEED_RETURN(errctx);
}
memset(dest, ' ', length);
dest[length] = '\0';
if ( field[0] == '=' ) {
pad = (length - textlen) / 2;
} else {
pad = length - textlen;
}
memcpy(dest + pad, text, textlen);
SUCCEED_RETURN(errctx);
}
akerr_ErrorContext *akbasic_format_using(akbasic_FormatState *obj, const char *format, akbasic_Value *value, char *dest, size_t len)
{
PREPARE_ERROR(errctx);
char rendered[AKBASIC_MAX_STRING_LENGTH];
size_t start = 0;
size_t length = 0;
size_t used = 0;
bool numeric = false;
FAIL_ZERO_RETURN(errctx, (obj != NULL && format != NULL && value != NULL && dest != NULL),
AKERR_NULLPOINTER, "NULL argument in format_using");
FAIL_ZERO_RETURN(errctx, (len > 0), AKBASIC_ERR_BOUNDS, "Zero-length destination");
PASS(errctx, find_field(format, &start, &length, &numeric));
if ( numeric ) {
double number = 0.0;
FAIL_NONZERO_RETURN(errctx, (value->valuetype == AKBASIC_TYPE_STRING), AKBASIC_ERR_TYPE,
"PRINT USING: a numeric field cannot print a string");
if ( value->valuetype == AKBASIC_TYPE_FLOAT ) {
number = value->floatval;
} else if ( value->valuetype == AKBASIC_TYPE_BOOLEAN ) {
number = (double)value->boolvalue;
} else {
number = (double)value->intval;
}
PASS(errctx, render_numeric(obj, format + start, length, number,
rendered, sizeof(rendered)));
} else {
FAIL_NONZERO_RETURN(errctx, (value->valuetype != AKBASIC_TYPE_STRING), AKBASIC_ERR_TYPE,
"PRINT USING: a string field cannot print a number");
PASS(errctx, render_string(format + start, length, value->stringval,
rendered, sizeof(rendered)));
}
/* Literal text before the field, the field, then literal text after it. */
used = strlen(rendered) + strlen(format) - length;
FAIL_ZERO_RETURN(errctx, (used + 1 <= len), AKBASIC_ERR_BOUNDS,
"PRINT USING result of %zu characters does not fit", used);
memcpy(dest, format, start);
memcpy(dest + start, rendered, strlen(rendered));
snprintf(dest + start + strlen(rendered), len - start - strlen(rendered),
"%s", format + start + length);
SUCCEED_RETURN(errctx);
}

55
src/frontend_akgl.c
View File

@@ -37,6 +37,8 @@
* to populate it itself. deps/libakgl/tests/draw.c does the same.
*/
#include <akgl/game.h>
#include <akgl/heap.h>
#include <akgl/registry.h>
#include <akgl/renderer.h>
#include <akbasic/error.h>
@@ -102,6 +104,41 @@ akerr_ErrorContext *akbasic_frontend_akgl_init(akbasic_AkglFrontend *obj, const
*/
PASS(errctx, akgl_render_bind2d(obj->renderer));
/*
* The object pools and the name registries. Every akgl_*_initialize ends in
* a registry write and fails AKERR_KEY without these, so anything drawn as
* an actor -- which is what a BASIC sprite is -- needs them. akgl_game_init()
* is where they would normally be done, and it is the function goal 3 keeps
* this host out of.
*
* Unconditional, and it has to be. akgl_registry_init() overwrites the
* property-set ids without destroying the old sets, so repeating it would
* normally leak -- but this frontend owns SDL_Init and SDL_Quit, and
* SDL_Quit destroys every property set while leaving libakgl's ids pointing
* at them. So the previous registries are already gone, and skipping the
* call on the strength of a non-zero id is what actually breaks: the second
* frontend of a process gets ids that name nothing, and the first
* akgl_sprite_initialize fails AKERR_KEY.
*
* A game that embeds the interpreter does not link this file. It has already
* called akgl_game_init(), which does both of these itself.
*/
PASS(errctx, akgl_heap_init());
PASS(errctx, akgl_registry_init());
/*
* And the camera. akgl_actor_render() dereferences this global to translate
* world coordinates into screen ones and does not check it, so an unset
* camera is a crash the first time a sprite is drawn rather than an error
* anybody could act on. One screen's worth at the origin: BASIC has no verb
* that scrolls a view, so the world and the screen are the same thing here.
*/
camera = &_akgl_camera;
camera->x = 0.0f;
camera->y = 0.0f;
camera->w = (float)w;
camera->h = (float)h;
obj->font = TTF_OpenFont(fontpath, (float)fontsize);
FAIL_ZERO_RETURN(errctx, (obj->font != NULL), AKGL_ERR_SDL,
"Couldn't open the font %s: %s", fontpath, SDL_GetError());
@@ -131,6 +168,13 @@ akerr_ErrorContext *akbasic_frontend_akgl_init(akbasic_AkglFrontend *obj, const
PASS(errctx, akbasic_graphics_init_akgl(&obj->graphics, &obj->graphicsstate,
obj->renderer));
PASS(errctx, akbasic_input_init_akgl(&obj->input));
/*
* The graphics state goes with it so SPRSAV can turn an SSHAPE handle into a
* sprite. The two devices stay separate records -- a host may lend one and
* withhold the other -- and this is the one place they meet.
*/
PASS(errctx, akbasic_sprite_init_akgl(&obj->sprites, &obj->spritesstate,
obj->renderer, &obj->graphicsstate));
/*
* Audio last, in its own subsystem, and allowed to fail. The reference asks
@@ -170,7 +214,7 @@ akerr_ErrorContext *akbasic_frontend_akgl_attach(akbasic_AkglFrontend *obj, akba
PASS(errctx, akbasic_runtime_init(rt, &obj->sink));
PASS(errctx, akbasic_runtime_set_devices(rt, &obj->graphics,
(obj->audioready ? &obj->audio : NULL),
&obj->input));
&obj->input, &obj->sprites));
SUCCEED_RETURN(errctx);
}
@@ -224,6 +268,13 @@ akerr_ErrorContext *akbasic_frontend_akgl_pump(void *self, bool *running)
* bitmap plane.
*/
PASS(errctx, akbasic_sink_akgl_render(&obj->akglsink));
/*
* Sprites last, so they are over the text as well as over the drawing. That
* is what a C128 does with a high-priority sprite, and the low-priority case
* -- behind the bitmap plane -- has nowhere to go here: see the note in
* spr_configure().
*/
PASS(errctx, akbasic_sprite_akgl_render(&obj->sprites));
FAIL_ZERO_RETURN(errctx, SDL_RenderPresent(obj->renderer->sdl_renderer),
AKGL_ERR_SDL, "Couldn't present the frame: %s", SDL_GetError());
SUCCEED_RETURN(errctx);
@@ -266,6 +317,8 @@ void akbasic_frontend_akgl_shutdown(akbasic_AkglFrontend *obj)
if ( obj == NULL ) {
return;
}
/* Before the renderer goes: these are textures it created. */
akbasic_sprite_akgl_shutdown(&obj->sprites);
if ( obj->font != NULL ) {
TTF_CloseFont(obj->font);
obj->font = NULL;

18
src/grammar.c
View File

@@ -143,6 +143,24 @@ bool akbasic_leaf_is_identifier(akbasic_ASTLeaf *self)
self->leaftype == AKBASIC_LEAF_IDENTIFIER_STRING));
}
akbasic_Type akbasic_leaf_identifier_type(akbasic_ASTLeaf *self)
{
if ( self == NULL ) {
return AKBASIC_TYPE_UNDEFINED;
}
switch ( self->leaftype ) {
case AKBASIC_LEAF_IDENTIFIER_INT:
return AKBASIC_TYPE_INTEGER;
case AKBASIC_LEAF_IDENTIFIER_FLOAT:
return AKBASIC_TYPE_FLOAT;
case AKBASIC_LEAF_IDENTIFIER_STRING:
return AKBASIC_TYPE_STRING;
default:
/* A bare identifier is a label, and a label has no storage to fill. */
return AKBASIC_TYPE_UNDEFINED;
}
}
bool akbasic_leaf_is_literal(akbasic_ASTLeaf *self)
{
return (self != NULL &&

1
src/graphics_tables.c
View File

@@ -82,6 +82,7 @@ akerr_ErrorContext *akbasic_graphics_state_init(akbasic_GraphicsState *obj)
obj->x = 0.0;
obj->y = 0.0;
obj->scaling = false;
obj->linewidth = 1;
obj->xmax = (double)AKBASIC_GRAPHICS_WIDTH;
obj->ymax = (double)AKBASIC_GRAPHICS_HEIGHT;
for ( source = 0; source < AKBASIC_COLOR_SOURCES; source++ ) {

20
src/main.c
View File

@@ -100,8 +100,10 @@ static akerr_ErrorContext AKERR_NOIGNORE *drive(akbasic_Runtime *obj)
* @brief The terminal driver: no window, no SDL, output on stdout.
*
* @param program The already-opened program file, or NULL for an interactive REPL.
* @param path That file's path, so a relative asset path a program writes can be resolved
* against the program's own directory. NULL for an interactive REPL.
*/
static akerr_ErrorContext AKERR_NOIGNORE *run_stdio(FILE *program)
static akerr_ErrorContext AKERR_NOIGNORE *run_stdio(FILE *program, const char *path)
{
PREPARE_ERROR(errctx);
@@ -112,6 +114,13 @@ static akerr_ErrorContext AKERR_NOIGNORE *run_stdio(FILE *program)
*/
PASS(errctx, akbasic_sink_init_stdio(&SINK, &SINKSTATE, stdout, program));
PASS(errctx, akbasic_runtime_init(&RUNTIME, &SINK));
/*
* So an asset path a program writes -- `SPRSAV "ship.png", 1` -- can be
* tried against the program's own directory as well as against the
* working one. Without it a `.bas` stored beside its art only works when
* it is launched from its own directory.
*/
PASS(errctx, akbasic_runtime_set_source_path(&RUNTIME, path));
PASS(errctx, akbasic_runtime_start(&RUNTIME, AKBASIC_MODE_RUNSTREAM));
} else {
PASS(errctx, akbasic_sink_init_stdio(&SINK, &SINKSTATE, stdout, stdin));
@@ -140,8 +149,9 @@ static akerr_ErrorContext AKERR_NOIGNORE *run_stdio(FILE *program)
* @brief The SDL driver: an 800x600 window, and stdout still gets everything.
*
* @param program The already-opened program file, or NULL to type at the window.
* @param path That file's path; see run_stdio(). NULL when there is no program file.
*/
static akerr_ErrorContext AKERR_NOIGNORE *run_akgl(FILE *program)
static akerr_ErrorContext AKERR_NOIGNORE *run_akgl(FILE *program, const char *path)
{
PREPARE_ERROR(errctx);
const char *fontpath = getenv("AKBASIC_FONT");
@@ -169,6 +179,8 @@ static akerr_ErrorContext AKERR_NOIGNORE *run_akgl(FILE *program)
fontpath, AKBASIC_FRONTEND_FONT_SIZE,
stdout, input));
PASS(errctx, akbasic_frontend_akgl_attach(&FRONTEND, &RUNTIME));
/* See the note in run_stdio(): this is what makes a relative asset path work. */
PASS(errctx, akbasic_runtime_set_source_path(&RUNTIME, path));
PASS(errctx, akbasic_runtime_start(&RUNTIME, mode));
PASS(errctx, akbasic_frontend_akgl_drive(&FRONTEND, &RUNTIME));
SUCCEED_RETURN(errctx);
@@ -186,9 +198,9 @@ int main(int argc, char **argv)
CATCH(errctx, aksl_fopen(argv[1], "r", &program));
}
#ifdef AKBASIC_HAVE_AKGL
CATCH(errctx, run_akgl(program));
CATCH(errctx, run_akgl(program, (argc > 1 ? argv[1] : NULL)));
#else
CATCH(errctx, run_stdio(program));
CATCH(errctx, run_stdio(program, (argc > 1 ? argv[1] : NULL)));
#endif
} CLEANUP {
if ( program != NULL ) {

26
src/parser.c
View File

@@ -25,6 +25,7 @@ akerr_ErrorContext *akbasic_parser_init(akbasic_Parser *obj, akbasic_Runtime *ru
FAIL_ZERO_RETURN(errctx, (obj != NULL), AKERR_NULLPOINTER, "NULL parser in init");
FAIL_ZERO_RETURN(errctx, (runtime != NULL), AKERR_NULLPOINTER, "nil runtime argument");
obj->runtime = runtime;
obj->comparing = false;
SUCCEED_RETURN(errctx);
}
@@ -362,21 +363,40 @@ static akerr_ErrorContext *logicalnot(akbasic_Parser *obj, akbasic_ASTLeaf **des
akerr_ErrorContext *akbasic_parser_relation(akbasic_Parser *obj, akbasic_ASTLeaf **dest)
{
PREPARE_ERROR(errctx);
/*
* A lone `=` is an equality test here when the caller has said a condition
* is what it is parsing. `==` keeps working either way, which is what the Go
* reference used and what the whole checked-in corpus is written in. See
* akbasic_Parser::comparing and TODO.md section 5.
*/
static const akbasic_TokenType OPS[] = {
AKBASIC_TOK_LESS_THAN, AKBASIC_TOK_LESS_THAN_EQUAL, AKBASIC_TOK_EQUAL,
AKBASIC_TOK_NOT_EQUAL, AKBASIC_TOK_GREATER_THAN, AKBASIC_TOK_GREATER_THAN_EQUAL
AKBASIC_TOK_NOT_EQUAL, AKBASIC_TOK_GREATER_THAN, AKBASIC_TOK_GREATER_THAN_EQUAL,
AKBASIC_TOK_ASSIGNMENT
};
akbasic_ASTLeaf *left = NULL;
akbasic_ASTLeaf *right = NULL;
akbasic_ASTLeaf *expr = NULL;
akbasic_Token *operator_ = NULL;
akbasic_TokenType op = AKBASIC_TOK_UNDEFINED;
/*
* ASSIGNMENT is the last entry, and it is only offered while `comparing` --
* see akbasic_Parser. Outside a condition `=` has to stay an assignment, or
* `A# = 2` stops storing anything and `FOR I# = 1 TO 5` never initializes
* its counter.
*/
int opcount = (obj->comparing ? 7 : 6);
PASS(errctx, subtraction(obj, &left));
if ( akbasic_parser_match(obj, OPS, 6) ) {
if ( akbasic_parser_match(obj, OPS, opcount) ) {
PASS(errctx, akbasic_parser_previous(obj, &operator_));
op = operator_->tokentype;
if ( op == AKBASIC_TOK_ASSIGNMENT ) {
op = AKBASIC_TOK_EQUAL;
}
PASS(errctx, subtraction(obj, &right));
PASS(errctx, akbasic_parser_new_leaf(obj, &expr));
PASS(errctx, akbasic_leaf_new_binary(expr, left, operator_->tokentype, right));
PASS(errctx, akbasic_leaf_new_binary(expr, left, op, right));
*dest = expr;
SUCCEED_RETURN(errctx);
}

460
src/parser_commands.c
View File

@@ -38,6 +38,15 @@ akerr_ErrorContext *akbasic_parse_arglist(akbasic_Parser *parser, akbasic_ASTLea
* column to carry one.
*/
PASS(errctx, akbasic_parser_previous(parser, &operator_));
/*
* Checked before parsing rather than after. Handing an empty token stream to
* the expression parser fails deep inside it with "peek() returned nil
* token!", which tells a program author nothing at all -- and this path is
* reached by every verb that takes a list, so the bad message was the one
* most people saw.
*/
FAIL_ZERO_RETURN(errctx, (akbasic_parser_peek(parser) != NULL), AKBASIC_ERR_SYNTAX,
"%s expected at least one argument", operator_->lexeme);
PASS(errctx, akbasic_parser_argument_list(parser, AKBASIC_TOK_FUNCTION_ARGUMENT, false, &arglist));
FAIL_ZERO_RETURN(errctx, (arglist != NULL), AKBASIC_ERR_SYNTAX,
"%s expected at least one argument", operator_->lexeme);
@@ -100,6 +109,413 @@ akerr_ErrorContext *akbasic_parse_draw(akbasic_Parser *parser, akbasic_ASTLeaf *
SUCCEED_RETURN(errctx);
}
akerr_ErrorContext *akbasic_parse_movspr(akbasic_Parser *parser, akbasic_ASTLeaf **dest)
{
PREPARE_ERROR(errctx);
akbasic_ASTLeaf *arglist = NULL;
akbasic_ASTLeaf *form = NULL;
akbasic_ASTLeaf *expr = NULL;
akbasic_ASTLeaf *tail = NULL;
akbasic_Token *operator_ = NULL;
akbasic_Token *peeked = NULL;
const char *formlexeme = "0";
/*
* MOVSPR is the one verb in the language whose arguments are not simply
* comma-separated. It has four forms and the separators are what tell them
* apart:
*
* MOVSPR n, x, y absolute
* MOVSPR n, +x, -y relative -- a signed coordinate, not a negative one
* MOVSPR n, d ; a polar: distance, then angle
* MOVSPR n, a # s continuous: angle, then speed
*
* So the form has to be decided here, where the tokens still exist, and
* carried to the exec handler somehow. It is carried as a synthetic integer
* literal prepended to the argument list, which flattens the whole statement
* to `form, n, a, b` -- the same trick akbasic_parse_draw uses to make a
* polyline look like a plain argument chain.
*/
PASS(errctx, akbasic_parser_previous(parser, &operator_));
PASS(errctx, akbasic_parser_new_leaf(parser, &arglist));
arglist->leaftype = AKBASIC_LEAF_ARGUMENTLIST;
arglist->operator_ = AKBASIC_TOK_FUNCTION_ARGUMENT;
PASS(errctx, akbasic_parser_new_leaf(parser, &form));
PASS(errctx, akbasic_parser_expression(parser, &arglist->right));
FAIL_ZERO_RETURN(errctx, (arglist->right != NULL), AKBASIC_ERR_SYNTAX,
"MOVSPR expected a sprite number");
tail = arglist->right;
FAIL_ZERO_RETURN(errctx, akbasic_parser_match1(parser, AKBASIC_TOK_COMMA),
AKBASIC_ERR_SYNTAX, "MOVSPR expected a comma after the sprite number");
/*
* A leading sign makes it relative. `+` has to be consumed here because the
* expression parser has no unary plus; `-` is left where it is, because
* unary minus is a real operator and re-parsing it would drop the sign.
*/
peeked = akbasic_parser_peek(parser);
if ( peeked != NULL &&
(peeked->tokentype == AKBASIC_TOK_PLUS || peeked->tokentype == AKBASIC_TOK_MINUS) ) {
formlexeme = "1";
if ( peeked->tokentype == AKBASIC_TOK_PLUS ) {
(void)akbasic_parser_match1(parser, AKBASIC_TOK_PLUS);
}
}
PASS(errctx, akbasic_parser_expression(parser, &tail->next));
FAIL_ZERO_RETURN(errctx, (tail->next != NULL), AKBASIC_ERR_SYNTAX,
"MOVSPR expected a coordinate, a distance or an angle");
tail = tail->next;
if ( akbasic_parser_match1(parser, AKBASIC_TOK_SEMICOLON) ) {
formlexeme = "2";
} else if ( akbasic_parser_match1(parser, AKBASIC_TOK_HASHMARK) ) {
formlexeme = "3";
} else {
FAIL_ZERO_RETURN(errctx, akbasic_parser_match1(parser, AKBASIC_TOK_COMMA),
AKBASIC_ERR_SYNTAX,
"MOVSPR expected `, y', `; angle' or `# speed'");
if ( formlexeme[0] == '0' ) {
peeked = akbasic_parser_peek(parser);
if ( peeked != NULL && peeked->tokentype == AKBASIC_TOK_PLUS ) {
formlexeme = "1";
(void)akbasic_parser_match1(parser, AKBASIC_TOK_PLUS);
} else if ( peeked != NULL && peeked->tokentype == AKBASIC_TOK_MINUS ) {
formlexeme = "1";
}
} else if ( akbasic_parser_peek(parser) != NULL &&
akbasic_parser_peek(parser)->tokentype == AKBASIC_TOK_PLUS ) {
(void)akbasic_parser_match1(parser, AKBASIC_TOK_PLUS);
}
}
PASS(errctx, akbasic_parser_expression(parser, &tail->next));
FAIL_ZERO_RETURN(errctx, (tail->next != NULL), AKBASIC_ERR_SYNTAX,
"MOVSPR expected a second value");
PASS(errctx, akbasic_leaf_new_literal_int(form, formlexeme));
form->next = arglist->right;
arglist->right = form;
PASS(errctx, akbasic_parser_new_leaf(parser, &expr));
PASS(errctx, akbasic_leaf_new_command(expr, operator_->lexeme, arglist));
*dest = expr;
SUCCEED_RETURN(errctx);
}
/**
* @brief Read an optional `WHILE`/`UNTIL` condition off a DO or a LOOP.
*
* Both ends of a DO/LOOP take the same optional clause, so both parse it the
* same way. @p kind comes back as one of the AKBASIC_LOOPCOND_* values and
* @p condition is NULL when there was no clause.
*/
static akerr_ErrorContext *parse_loop_condition(akbasic_Parser *parser, akbasic_ASTLeaf **condition, int *kind)
{
PREPARE_ERROR(errctx);
akbasic_Token *peeked = NULL;
*condition = NULL;
*kind = AKBASIC_LOOPCOND_NONE;
peeked = akbasic_parser_peek(parser);
if ( peeked == NULL || peeked->tokentype != AKBASIC_TOK_COMMAND ) {
SUCCEED_RETURN(errctx);
}
if ( strcmp(peeked->lexeme, "WHILE") == 0 ) {
*kind = AKBASIC_LOOPCOND_WHILE;
} else if ( strcmp(peeked->lexeme, "UNTIL") == 0 ) {
*kind = AKBASIC_LOOPCOND_UNTIL;
} else {
SUCCEED_RETURN(errctx);
}
(void)akbasic_parser_match1(parser, AKBASIC_TOK_COMMAND);
/* A loop condition is a condition, so a lone `=` in it is an equality test. */
parser->comparing = true;
PASS(errctx, akbasic_parser_expression(parser, condition));
parser->comparing = false;
FAIL_ZERO_RETURN(errctx, (*condition != NULL), AKBASIC_ERR_SYNTAX,
"Expected a condition after WHILE or UNTIL");
SUCCEED_RETURN(errctx);
}
/*
* DO [WHILE|UNTIL (condition)]
*
* Pushes the loop's scope at parse time, exactly as FOR does and for the same
* reason: the condition leaf has to outlive the line it was written on, and an
* environment's leaf pool is what gives it somewhere to live.
*/
akerr_ErrorContext *akbasic_parse_do(akbasic_Parser *parser, akbasic_ASTLeaf **dest)
{
PREPARE_ERROR(errctx);
akbasic_Runtime *runtime = parser->runtime;
akbasic_Environment *parent = runtime->environment;
akbasic_Environment *newenv = NULL;
akbasic_ASTLeaf *expr = NULL;
akbasic_ASTLeaf *condition = NULL;
int kind = AKBASIC_LOOPCOND_NONE;
int64_t firstline = parent->lineno + 1;
PASS(errctx, akbasic_runtime_new_environment(runtime));
newenv = runtime->environment;
runtime->environment = parent;
/*
* Parsed against the parent's token stream but stored in the new scope --
* the body is scanned line by line afterwards, and the new scope must not be
* active until parsing is done.
*/
PASS(errctx, parse_loop_condition(parser, &condition, &kind));
newenv->isDoLoop = true;
newenv->loopFirstLine = firstline;
newenv->doConditionKind = kind;
if ( condition != NULL ) {
PASS(errctx, akbasic_leaf_clone(condition, &newenv->doLeafPool, &newenv->doConditionLeaf));
}
PASS(errctx, akbasic_parser_new_leaf(parser, &expr));
PASS(errctx, akbasic_leaf_new_command(expr, "DO", NULL));
runtime->environment = newenv;
*dest = expr;
SUCCEED_RETURN(errctx);
}
/*
* LOOP [WHILE|UNTIL (condition)]
*
* The condition hangs off the command leaf's `.right`, with the WHILE/UNTIL
* choice in that leaf's integer literal and the expression on its `.left`. No
* cloning: this line is still scanned when the verb runs.
*/
akerr_ErrorContext *akbasic_parse_loop(akbasic_Parser *parser, akbasic_ASTLeaf **dest)
{
PREPARE_ERROR(errctx);
akbasic_ASTLeaf *expr = NULL;
akbasic_ASTLeaf *holder = NULL;
akbasic_ASTLeaf *condition = NULL;
int kind = AKBASIC_LOOPCOND_NONE;
PASS(errctx, parse_loop_condition(parser, &condition, &kind));
PASS(errctx, akbasic_parser_new_leaf(parser, &expr));
if ( condition != NULL ) {
PASS(errctx, akbasic_parser_new_leaf(parser, &holder));
PASS(errctx, akbasic_leaf_init(holder, AKBASIC_LEAF_LITERAL_INT));
holder->literal_int = kind;
holder->left = condition;
}
PASS(errctx, akbasic_leaf_new_command(expr, "LOOP", holder));
*dest = expr;
SUCCEED_RETURN(errctx);
}
/*
* ON (expression) GOTO|GOSUB (target) [, ...]
*
* Flattened to one argument chain: a marker carrying the GOSUB flag, the
* selector expression, then the targets. Same trick akbasic_parse_draw and
* akbasic_parse_movspr use, so the exec handler walks a plain list.
*/
akerr_ErrorContext *akbasic_parse_on(akbasic_Parser *parser, akbasic_ASTLeaf **dest)
{
PREPARE_ERROR(errctx);
akbasic_ASTLeaf *arglist = NULL;
akbasic_ASTLeaf *marker = NULL;
akbasic_ASTLeaf *expr = NULL;
akbasic_ASTLeaf *tail = NULL;
akbasic_Token *operator_ = NULL;
bool gosub = false;
PASS(errctx, akbasic_parser_new_leaf(parser, &arglist));
arglist->leaftype = AKBASIC_LEAF_ARGUMENTLIST;
arglist->operator_ = AKBASIC_TOK_FUNCTION_ARGUMENT;
PASS(errctx, akbasic_parser_new_leaf(parser, &marker));
PASS(errctx, akbasic_leaf_init(marker, AKBASIC_LEAF_LITERAL_INT));
PASS(errctx, akbasic_parser_expression(parser, &marker->next));
FAIL_ZERO_RETURN(errctx, (marker->next != NULL), AKBASIC_ERR_SYNTAX,
"Expected ON (expression) GOTO|GOSUB (line) [, ...]");
tail = marker->next;
FAIL_ZERO_RETURN(errctx, akbasic_parser_match1(parser, AKBASIC_TOK_COMMAND),
AKBASIC_ERR_SYNTAX, "Expected GOTO or GOSUB after ON (expression)");
PASS(errctx, akbasic_parser_previous(parser, &operator_));
if ( strcmp(operator_->lexeme, "GOSUB") == 0 ) {
gosub = true;
} else {
FAIL_NONZERO_RETURN(errctx, strcmp(operator_->lexeme, "GOTO"), AKBASIC_ERR_SYNTAX,
"Expected GOTO or GOSUB after ON (expression)");
}
marker->literal_int = (gosub ? 1 : 0);
for ( ;; ) {
PASS(errctx, akbasic_parser_expression(parser, &tail->next));
FAIL_ZERO_RETURN(errctx, (tail->next != NULL), AKBASIC_ERR_SYNTAX,
"Expected a line number or label after ON ... %s",
(gosub ? "GOSUB" : "GOTO"));
tail = tail->next;
if ( !akbasic_parser_match1(parser, AKBASIC_TOK_COMMA) ) {
break;
}
}
arglist->right = marker;
PASS(errctx, akbasic_parser_new_leaf(parser, &expr));
PASS(errctx, akbasic_leaf_new_command(expr, "ON", arglist));
*dest = expr;
SUCCEED_RETURN(errctx);
}
/*
* RESUME [NEXT | (line)]
*
* `NEXT` is a COMMAND token, so the default command path -- which parses the
* rval as an expression -- cannot read it: `RESUME NEXT` came back as "Expected
* expression or literal". The word is kept as the command leaf's rval so the
* exec handler can tell the three forms apart by looking at it.
*/
akerr_ErrorContext *akbasic_parse_resume(akbasic_Parser *parser, akbasic_ASTLeaf **dest)
{
PREPARE_ERROR(errctx);
akbasic_ASTLeaf *expr = NULL;
akbasic_ASTLeaf *target = NULL;
akbasic_Token *peeked = NULL;
peeked = akbasic_parser_peek(parser);
if ( peeked != NULL && peeked->tokentype == AKBASIC_TOK_COMMAND &&
strcmp(peeked->lexeme, "NEXT") == 0 ) {
(void)akbasic_parser_match1(parser, AKBASIC_TOK_COMMAND);
PASS(errctx, akbasic_parser_new_leaf(parser, &target));
PASS(errctx, akbasic_leaf_new_command(target, "NEXT", NULL));
} else if ( peeked != NULL && peeked->tokentype != AKBASIC_TOK_COLON ) {
PASS(errctx, akbasic_parser_expression(parser, &target));
}
PASS(errctx, akbasic_parser_new_leaf(parser, &expr));
PASS(errctx, akbasic_leaf_new_command(expr, "RESUME", target));
*dest = expr;
SUCCEED_RETURN(errctx);
}
/*
* PRINT [USING (format);] (expression)
*
* Only the USING form needs a parse handler; without it PRINT keeps the default
* path, which parses one expression. `USING` is a COMMAND token, so the default
* path could not read it -- the same reason RESUME needed one for `NEXT`.
*
* The result is a command leaf whose rval is an argument list of exactly two:
* the format and the value. A plain PRINT keeps its single-expression rval, so
* the exec handler tells them apart by looking for the list.
*/
akerr_ErrorContext *akbasic_parse_print(akbasic_Parser *parser, akbasic_ASTLeaf **dest)
{
PREPARE_ERROR(errctx);
akbasic_ASTLeaf *expr = NULL;
akbasic_ASTLeaf *arglist = NULL;
akbasic_ASTLeaf *right = NULL;
akbasic_Token *peeked = NULL;
peeked = akbasic_parser_peek(parser);
/*
* `PRINT #1, expr` writes to a file channel. A C128 spells it `PRINT#1` with
* no space, which this scanner cannot produce: `PRINT#` reads as an
* identifier with an integer suffix, and a verb name carrying a suffix is
* refused (deviation 30). So the `#` is its own token and the space before
* it is required. Recorded in TODO.md section 5.
*
* The channel form is marked by a leaf named "PRINT#" holding an argument
* list of two: the channel and the value.
*/
if ( peeked != NULL && peeked->tokentype == AKBASIC_TOK_HASHMARK ) {
akbasic_ASTLeaf *arglist = NULL;
(void)akbasic_parser_match1(parser, AKBASIC_TOK_HASHMARK);
PASS(errctx, akbasic_parser_new_leaf(parser, &arglist));
arglist->leaftype = AKBASIC_LEAF_ARGUMENTLIST;
arglist->operator_ = AKBASIC_TOK_FUNCTION_ARGUMENT;
PASS(errctx, akbasic_parser_expression(parser, &arglist->right));
FAIL_ZERO_RETURN(errctx, (arglist->right != NULL), AKBASIC_ERR_SYNTAX,
"Expected PRINT #(channel), (expression)");
FAIL_ZERO_RETURN(errctx, akbasic_parser_match1(parser, AKBASIC_TOK_COMMA),
AKBASIC_ERR_SYNTAX,
"Expected a comma after PRINT #(channel)");
PASS(errctx, akbasic_parser_expression(parser, &arglist->right->next));
FAIL_ZERO_RETURN(errctx, (arglist->right->next != NULL), AKBASIC_ERR_SYNTAX,
"Expected PRINT #(channel), (expression)");
PASS(errctx, akbasic_parser_new_leaf(parser, &expr));
PASS(errctx, akbasic_leaf_new_command(expr, "PRINT#", arglist));
*dest = expr;
SUCCEED_RETURN(errctx);
}
if ( peeked == NULL || peeked->tokentype != AKBASIC_TOK_COMMAND ||
strcmp(peeked->lexeme, "USING") != 0 ) {
/* The ordinary PRINT: one expression, or none at all. */
if ( peeked != NULL && peeked->tokentype != AKBASIC_TOK_COLON ) {
PASS(errctx, akbasic_parser_expression(parser, &right));
}
PASS(errctx, akbasic_parser_new_leaf(parser, &expr));
PASS(errctx, akbasic_leaf_new_command(expr, "PRINT", right));
*dest = expr;
SUCCEED_RETURN(errctx);
}
(void)akbasic_parser_match1(parser, AKBASIC_TOK_COMMAND);
PASS(errctx, akbasic_parser_new_leaf(parser, &arglist));
arglist->leaftype = AKBASIC_LEAF_ARGUMENTLIST;
arglist->operator_ = AKBASIC_TOK_FUNCTION_ARGUMENT;
PASS(errctx, akbasic_parser_expression(parser, &arglist->right));
FAIL_ZERO_RETURN(errctx, (arglist->right != NULL), AKBASIC_ERR_SYNTAX,
"Expected PRINT USING (format); (expression)");
FAIL_ZERO_RETURN(errctx, akbasic_parser_match1(parser, AKBASIC_TOK_SEMICOLON),
AKBASIC_ERR_SYNTAX,
"Expected a semicolon between PRINT USING's format and its value");
PASS(errctx, akbasic_parser_expression(parser, &arglist->right->next));
FAIL_ZERO_RETURN(errctx, (arglist->right->next != NULL), AKBASIC_ERR_SYNTAX,
"Expected PRINT USING (format); (expression)");
PASS(errctx, akbasic_parser_new_leaf(parser, &expr));
PASS(errctx, akbasic_leaf_new_command(expr, "PRINT", arglist));
*dest = expr;
SUCCEED_RETURN(errctx);
}
/*
* The argument list, for verbs that may be written with no arguments at all --
* bare `KEY` lists the macros, bare `RENUMBER` renumbers with its defaults.
* `akbasic_parse_arglist` insists on at least one argument, which is right for
* every other verb that uses it.
*/
akerr_ErrorContext *akbasic_parse_optional_arglist(akbasic_Parser *parser, akbasic_ASTLeaf **dest)
{
PREPARE_ERROR(errctx);
akbasic_ASTLeaf *expr = NULL;
akbasic_Token *operator_ = NULL;
akbasic_Token *peeked = NULL;
peeked = akbasic_parser_peek(parser);
if ( peeked != NULL && peeked->tokentype != AKBASIC_TOK_COLON ) {
PASS(errctx, akbasic_parse_arglist(parser, dest));
SUCCEED_RETURN(errctx);
}
PASS(errctx, akbasic_parser_previous(parser, &operator_));
PASS(errctx, akbasic_parser_new_leaf(parser, &expr));
PASS(errctx, akbasic_leaf_new_command(expr, operator_->lexeme, NULL));
*dest = expr;
SUCCEED_RETURN(errctx);
}
akerr_ErrorContext *akbasic_parse_let(akbasic_Parser *parser, akbasic_ASTLeaf **dest)
{
PREPARE_ERROR(errctx);
@@ -388,7 +804,21 @@ akerr_ErrorContext *akbasic_parse_if(akbasic_Parser *parser, akbasic_ASTLeaf **d
akbasic_ASTLeaf *branch = NULL;
akbasic_Token *operator_ = NULL;
PASS(errctx, akbasic_parser_relation(parser, &relation));
/*
* Everything from here to the THEN is a condition, so a lone `=` in it is an
* equality test. Cleared immediately afterwards: the statement the THEN arm
* holds may well be an assignment.
*/
/*
* The whole expression, not just a relation. The reference parses one
* relation here, which is below AND and OR in the grammar chain -- so
* `IF A# = 5 AND B# = 3 THEN` stopped after the first comparison, left the
* AND unconsumed, and reported "Incomplete IF statement" against a line that
* is ordinary BASIC. A condition is an expression.
*/
parser->comparing = true;
PASS(errctx, akbasic_parser_expression(parser, &relation));
parser->comparing = false;
FAIL_ZERO_RETURN(errctx, akbasic_parser_match1(parser, AKBASIC_TOK_COMMAND),
AKBASIC_ERR_SYNTAX, "Incomplete IF statement");
PASS(errctx, akbasic_parser_previous(parser, &operator_));
@@ -423,6 +853,34 @@ akerr_ErrorContext *akbasic_parse_input(akbasic_Parser *parser, akbasic_ASTLeaf
akbasic_ASTLeaf *promptexpr = NULL;
akbasic_ASTLeaf *identifier = NULL;
akbasic_ASTLeaf *command = NULL;
akbasic_Token *peeked = NULL;
/*
* `INPUT #1, VAR` reads a line from a file channel rather than from the
* sink. Same spelling note as PRINT: the `#` is its own token and the space
* before it is required.
*/
peeked = akbasic_parser_peek(parser);
if ( peeked != NULL && peeked->tokentype == AKBASIC_TOK_HASHMARK ) {
akbasic_ASTLeaf *arglist = NULL;
(void)akbasic_parser_match1(parser, AKBASIC_TOK_HASHMARK);
PASS(errctx, akbasic_parser_new_leaf(parser, &arglist));
arglist->leaftype = AKBASIC_LEAF_ARGUMENTLIST;
arglist->operator_ = AKBASIC_TOK_FUNCTION_ARGUMENT;
PASS(errctx, akbasic_parser_expression(parser, &arglist->right));
FAIL_ZERO_RETURN(errctx, (arglist->right != NULL), AKBASIC_ERR_SYNTAX,
"Expected INPUT #(channel), (variable)");
FAIL_ZERO_RETURN(errctx, akbasic_parser_match1(parser, AKBASIC_TOK_COMMA),
AKBASIC_ERR_SYNTAX, "Expected a comma after INPUT #(channel)");
PASS(errctx, akbasic_parser_primary(parser, &arglist->right->next));
FAIL_ZERO_RETURN(errctx, akbasic_leaf_is_identifier(arglist->right->next),
AKBASIC_ERR_SYNTAX, "Expected INPUT #(channel), (variable)");
PASS(errctx, akbasic_parser_new_leaf(parser, &command));
PASS(errctx, akbasic_leaf_new_command(command, "INPUT#", arglist));
*dest = command;
SUCCEED_RETURN(errctx);
}
PASS(errctx, akbasic_parser_expression(parser, &promptexpr));
PASS(errctx, akbasic_parser_primary(parser, &identifier));

315
src/renumber.c Normal file
View File

@@ -0,0 +1,315 @@
/**
* @file renumber.c
* @brief RENUMBER: move every line, and rewrite every reference to one.
*
* Moving the lines is easy -- source is filed under its line number in
* `source[]`, so it is a permutation. Rewriting every `GOTO`, `GOSUB`, `RUN`,
* `RESTORE`, `TRAP` and `COLLISION` target to match is the job, and it is why
* this was deferred rather than written early: a `RENUMBER` that moved lines
* without fixing their references would silently break every branch in the
* program, which is worse than not having the verb at all.
*
* The rewrite is textual, and the only thing it has to understand about the rest
* of the language is where a string literal starts and stops -- `PRINT "GOTO 10"`
* must come through untouched. That is the same statement-walking the label and
* DATA prescans do.
*/
#include <ctype.h>
#include <inttypes.h>
#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#include <strings.h>
#include <akerror.h>
#include <akbasic/error.h>
#include <akbasic/runtime.h>
/**
* @brief Verbs whose numeric arguments name a line.
*
* `THEN` and `ELSE` are deliberately absent. Commodore BASIC lets `IF X THEN 100`
* stand for `THEN GOTO 100`; this dialect does not -- the corpus writes
* `THEN GOTO 100` -- so a number after `THEN` here is an expression, not a target.
*
* `LIST` and `DELETE` are absent too, and for a different reason: their
* arguments are ranges typed at a prompt, not references stored in a program.
* Renumbering a `DELETE` inside a listing would be rewriting something nobody
* meant as a branch.
*/
static const char *BRANCH_VERBS[] = { "GOTO", "GOSUB", "RUN", "RESTORE", "TRAP" };
/** @brief How many entries #BRANCH_VERBS has. */
#define BRANCH_VERB_COUNT ((int)(sizeof(BRANCH_VERBS) / sizeof(BRANCH_VERBS[0])))
/**
* @brief Where a line moved to, or the line itself when it did not move.
*
* A target naming a line that does not exist is left alone rather than
* rewritten: `GOTO 9999` in a program with no line 9999 is already broken, and
* inventing a destination for it would hide that.
*/
static int64_t mapped(const int64_t *map, int64_t line)
{
if ( line < 0 || line >= AKBASIC_MAX_SOURCE_LINES ) {
return line;
}
return (map[line] >= 0 ? map[line] : line);
}
/**
* @brief Copy a run of comma-separated line numbers, rewriting each.
*
* `ON X GOTO 100, 200, 300` is why this takes a list rather than one number: the
* targets follow the `GOTO`, so handling `GOTO` handles `ON` for free.
*
* @param map Old line to new line.
* @param src Reads from here; advanced past what was consumed.
* @param dest Writes to here; advanced past what was written.
* @param limit One past the last byte @p dest may write.
* @return `NULL` on success, otherwise an error context owned by the caller.
* @throws AKBASIC_ERR_BOUNDS When the rewritten line does not fit.
*/
static akerr_ErrorContext *rewrite_targets(const int64_t *map, const char **src, char **dest, const char *limit)
{
PREPARE_ERROR(errctx);
const char *p = *src;
char *out = *dest;
for ( ;; ) {
int64_t line = 0;
int written = 0;
while ( *p == ' ' || *p == '\t' ) {
FAIL_ZERO_RETURN(errctx, (out < limit), AKBASIC_ERR_BOUNDS,
"RENUMBER: a rewritten line does not fit");
*out = *p;
out += 1;
p += 1;
}
if ( !isdigit((unsigned char)*p) ) {
/*
* Not a number: a label, an expression, or nothing at all. Labels are
* the reason RENUMBER is survivable in the first place -- a program
* written with `GOTO DONE` needs no rewriting and cannot be broken by
* one.
*/
break;
}
while ( isdigit((unsigned char)*p) ) {
line = (line * 10) + (*p - '0');
p += 1;
}
written = snprintf(out, (size_t)(limit - out), "%" PRId64, mapped(map, line));
FAIL_ZERO_RETURN(errctx, (written > 0 && out + written < limit), AKBASIC_ERR_BOUNDS,
"RENUMBER: a rewritten line does not fit");
out += written;
/*
* A comma continues the list; anything else ends it. The spaces are
* skipped to find out which, and put back if the answer is "ends" --
* without that, `THEN GOTO 9 ELSE ...` came back as `THEN GOTO 30ELSE`.
*/
{
const char *afterdigits = p;
while ( *p == ' ' || *p == '\t' ) {
p += 1;
}
if ( *p != ',' ) {
p = afterdigits;
break;
}
}
FAIL_ZERO_RETURN(errctx, (out < limit), AKBASIC_ERR_BOUNDS,
"RENUMBER: a rewritten line does not fit");
*out = ',';
out += 1;
p += 1;
}
*src = p;
*dest = out;
SUCCEED_RETURN(errctx);
}
/**
* @brief Rewrite every branch target in one line of source.
*
* @param map Old line to new line.
* @param code The line to read.
* @param dest Where the rewritten line goes.
* @param len Capacity of @p dest.
* @return `NULL` on success, otherwise an error context owned by the caller.
* @throws AKBASIC_ERR_BOUNDS When the rewritten line does not fit.
*/
static akerr_ErrorContext *rewrite_line(const int64_t *map, const char *code, char *dest, size_t len)
{
PREPARE_ERROR(errctx);
const char *p = code;
char *out = dest;
const char *limit = dest + len - 1;
bool statementstart = true;
bool instring = false;
int i = 0;
while ( *p != '\0' ) {
size_t verblen = 0;
bool matched = false;
FAIL_ZERO_RETURN(errctx, (out < limit), AKBASIC_ERR_BOUNDS,
"RENUMBER: a rewritten line does not fit");
if ( instring ) {
instring = (*p != '"');
*out = *p;
out += 1;
p += 1;
continue;
}
if ( *p == '"' ) {
/* A string literal is copied through untouched: `PRINT "GOTO 10"`. */
instring = true;
statementstart = false;
*out = *p;
out += 1;
p += 1;
continue;
}
if ( *p == ':' ) {
statementstart = true;
*out = *p;
out += 1;
p += 1;
continue;
}
if ( *p == ' ' || *p == '\t' ) {
*out = *p;
out += 1;
p += 1;
continue;
}
for ( i = 0; i < BRANCH_VERB_COUNT; i++ ) {
verblen = strlen(BRANCH_VERBS[i]);
if ( strncasecmp(p, BRANCH_VERBS[i], verblen) == 0 &&
!isalnum((unsigned char)p[verblen]) ) {
matched = true;
break;
}
}
/*
* A branch verb may appear anywhere a statement may, and `GOTO` also
* follows `THEN`, `ELSE` and `ON X` -- none of which is a statement
* start. So the match is not gated on statementstart; what protects
* `A$ = "GOTO"` is the string check above, and what protects a variable
* called `GOTOX#` is the alphanumeric check here.
*/
if ( matched ) {
FAIL_ZERO_RETURN(errctx, (out + verblen < (size_t)(limit - dest) + dest),
AKBASIC_ERR_BOUNDS, "RENUMBER: a rewritten line does not fit");
memcpy(out, p, verblen);
out += verblen;
p += verblen;
PASS(errctx, rewrite_targets(map, &p, &out, limit));
statementstart = false;
continue;
}
/*
* COLLISION's handler is its *second* argument, so the list rewrite
* cannot be pointed at it directly. Copy the type and the comma, then
* rewrite what follows.
*/
if ( strncasecmp(p, "COLLISION", 9) == 0 && !isalnum((unsigned char)p[9]) ) {
memcpy(out, p, 9);
out += 9;
p += 9;
while ( *p != '\0' && *p != ',' && *p != ':' ) {
FAIL_ZERO_RETURN(errctx, (out < limit), AKBASIC_ERR_BOUNDS,
"RENUMBER: a rewritten line does not fit");
*out = *p;
out += 1;
p += 1;
}
if ( *p == ',' ) {
*out = ',';
out += 1;
p += 1;
PASS(errctx, rewrite_targets(map, &p, &out, limit));
}
statementstart = false;
continue;
}
statementstart = false;
*out = *p;
out += 1;
p += 1;
}
*out = '\0';
(void)statementstart;
SUCCEED_RETURN(errctx);
}
akerr_ErrorContext *akbasic_renumber(akbasic_Runtime *obj, int64_t newstart, int64_t increment, int64_t oldstart)
{
PREPARE_ERROR(errctx);
static int64_t map[AKBASIC_MAX_SOURCE_LINES];
static akbasic_SourceLine rewritten[AKBASIC_MAX_SOURCE_LINES];
int64_t next = newstart;
int64_t i = 0;
FAIL_ZERO_RETURN(errctx, (obj != NULL), AKERR_NULLPOINTER, "NULL runtime in renumber");
FAIL_ZERO_RETURN(errctx, (increment > 0), AKBASIC_ERR_VALUE,
"RENUMBER's increment must be positive, not %" PRId64, increment);
FAIL_ZERO_RETURN(errctx, (newstart > 0), AKBASIC_ERR_VALUE,
"RENUMBER cannot start at line %" PRId64, newstart);
for ( i = 0; i < AKBASIC_MAX_SOURCE_LINES; i++ ) {
map[i] = -1;
}
/*
* Build the whole map before touching anything. A rewrite needs to know
* where *every* line ended up, including ones it has not reached yet --
* a backward `GOTO` is as common as a forward one.
*/
for ( i = 0; i < AKBASIC_MAX_SOURCE_LINES; i++ ) {
if ( obj->source[i].code[0] == '\0' || i < oldstart ) {
continue;
}
FAIL_ZERO_RETURN(errctx, (next < AKBASIC_MAX_SOURCE_LINES), AKBASIC_ERR_BOUNDS,
"RENUMBER: line %" PRId64 " would become %" PRId64 ", past the %d line limit",
i, next, AKBASIC_MAX_SOURCE_LINES - 1);
/*
* A renumbered line must not land on a kept one. Refused rather than
* overwritten: losing a line to a renumbering is not recoverable.
*/
FAIL_ZERO_RETURN(errctx, (next >= oldstart || obj->source[next].code[0] == '\0'),
AKBASIC_ERR_VALUE,
"RENUMBER: line %" PRId64 " would become %" PRId64 ", which already exists",
i, next);
map[i] = next;
next += increment;
}
memset(rewritten, 0, sizeof(rewritten));
for ( i = 0; i < AKBASIC_MAX_SOURCE_LINES; i++ ) {
int64_t target = 0;
if ( obj->source[i].code[0] == '\0' ) {
continue;
}
/*
* Every line is rewritten, not just the moved ones: a line before
* `oldstart` can branch into the region that moved.
*/
target = mapped(map, i);
PASS(errctx, rewrite_line(map, obj->source[i].code,
rewritten[target].code, sizeof(rewritten[target].code)));
rewritten[target].lineno = target;
}
memcpy(obj->source, rewritten, sizeof(obj->source));
SUCCEED_RETURN(errctx);
}

402
src/runtime.c
View File

@@ -3,9 +3,11 @@
* @brief Implements the interpreter core: pools, evaluation and the step loop.
*/
#include <ctype.h>
#include <inttypes.h>
#include <stdio.h>
#include <string.h>
#include <strings.h>
#include <akerror.h>
@@ -164,6 +166,11 @@ akerr_ErrorContext *akbasic_runtime_init(akbasic_Runtime *obj, akbasic_TextSink
obj->inputEof = false;
PASS(errctx, akbasic_graphics_state_init(&obj->gfx));
PASS(errctx, akbasic_sprite_state_init(&obj->sprite_state));
PASS(errctx, akbasic_format_state_init(&obj->format_state));
PASS(errctx, akbasic_console_state_init(&obj->console_state));
PASS(errctx, akbasic_data_state_init(&obj->data_state));
PASS(errctx, akbasic_disk_state_init(&obj->disk_state));
PASS(errctx, akbasic_audio_state_init(&obj->audio_state));
PASS(errctx, akbasic_valuepool_init(&obj->valuepool));
PASS(errctx, akbasic_value_zero(&obj->staticTrueValue));
@@ -177,7 +184,7 @@ akerr_ErrorContext *akbasic_runtime_init(akbasic_Runtime *obj, akbasic_TextSink
SUCCEED_RETURN(errctx);
}
akerr_ErrorContext *akbasic_runtime_set_devices(akbasic_Runtime *obj, akbasic_GraphicsBackend *graphics, akbasic_AudioBackend *audio, akbasic_InputBackend *input)
akerr_ErrorContext *akbasic_runtime_set_devices(akbasic_Runtime *obj, akbasic_GraphicsBackend *graphics, akbasic_AudioBackend *audio, akbasic_InputBackend *input, akbasic_SpriteBackend *sprites)
{
PREPARE_ERROR(errctx);
@@ -193,6 +200,39 @@ akerr_ErrorContext *akbasic_runtime_set_devices(akbasic_Runtime *obj, akbasic_Gr
obj->graphics = graphics;
obj->audio = audio;
obj->input = input;
obj->sprites = sprites;
SUCCEED_RETURN(errctx);
}
akerr_ErrorContext *akbasic_runtime_set_source_path(akbasic_Runtime *obj, const char *path)
{
PREPARE_ERROR(errctx);
const char *slash = NULL;
size_t length = 0;
FAIL_ZERO_RETURN(errctx, (obj != NULL), AKERR_NULLPOINTER, "NULL runtime in set_source_path");
obj->sourcepath[0] = '\0';
if ( path == NULL || path[0] == '\0' ) {
SUCCEED_RETURN(errctx);
}
/*
* The directory, taken here rather than at the point of use. dirname(3)
* would do it but it is allowed to modify its argument and two of the three
* libcs this has to build on disagree about which one they implement.
*/
slash = strrchr(path, '/');
length = (slash == NULL ? 0 : (size_t)(slash - path));
if ( length == 0 ) {
/* Either no directory at all, or the root. */
strncpy(obj->sourcepath, (slash == NULL ? "." : "/"), sizeof(obj->sourcepath) - 1);
obj->sourcepath[sizeof(obj->sourcepath) - 1] = '\0';
SUCCEED_RETURN(errctx);
}
FAIL_ZERO_RETURN(errctx, (length < sizeof(obj->sourcepath)), AKBASIC_ERR_BOUNDS,
"Program path of %zu characters exceeds the %d character limit",
length, AKBASIC_MAX_LINE_LENGTH - 1);
memcpy(obj->sourcepath, path, length);
obj->sourcepath[length] = '\0';
SUCCEED_RETURN(errctx);
}
@@ -252,6 +292,27 @@ akerr_ErrorContext *akbasic_runtime_error(akbasic_Runtime *obj, akbasic_ErrorCla
FAIL_ZERO_RETURN(errctx, (obj != NULL && message != NULL), AKERR_NULLPOINTER,
"NULL argument in runtime error");
/*
* TRAP intercepts here, because this is the one place a BASIC-visible error
* is reported and the one place the run is stopped. An armed trap turns both
* off: nothing is printed, `errclass` stays clear so the step loop keeps
* going, and the handler is entered at the next line boundary by the same
* machinery COLLISION uses.
*
* Not while a handler is already running. An error inside an error handler
* is reported and stops the program, which is the only way out of a handler
* that is itself broken -- a C128 does the same.
*/
if ( obj->interrupts[AKBASIC_INTERRUPT_ERROR].armed && obj->handlerenv == NULL ) {
PASS(errctx, akbasic_trap_set_error_variables(obj, obj->lasterrorstatus,
obj->environment->lineno));
PASS(errctx, akbasic_runtime_raise_interrupt(obj, AKBASIC_INTERRUPT_ERROR));
/* The rest of the failing line does not run; the handler does. */
obj->skiprestofline = true;
SUCCEED_RETURN(errctx);
}
obj->errclass = errclass;
/* Where HELP will look. Recorded before the message is built, so a report
* that itself fails still leaves the line behind. */
@@ -276,6 +337,23 @@ akerr_ErrorContext *akbasic_runtime_set_mode(akbasic_Runtime *obj, int mode)
if ( obj->mode == AKBASIC_MODE_REPL ) {
PASS(errctx, akbasic_runtime_println(obj, "READY"));
}
/*
* File the program's labels here rather than in any one of the several
* places that start a run. Every one of them -- akbasic_runtime_start(),
* RUN, CONT, and the end of a RUNSTREAM load -- arrives through this
* function, and the last of those is the one a driver reading a file from
* argv takes, where the program does not exist yet when start() is called.
*/
if ( obj->mode == AKBASIC_MODE_RUN && obj->environment != NULL ) {
PASS(errctx, akbasic_runtime_scan_labels(obj));
/*
* And the DATA items, for the same reason and at the same moment: READ
* walks a cursor along a list built before the program runs, so a DATA
* line *before* its READ is found -- which it was not when READ skipped
* forward looking for one.
*/
PASS(errctx, akbasic_data_scan(obj));
}
SUCCEED_RETURN(errctx);
}
@@ -293,6 +371,8 @@ static akerr_ErrorContext *report_and_reraise(akbasic_Runtime *obj, akerr_ErrorC
int status = cause->status;
snprintf(message, sizeof(message), "%s", cause->message);
/* What ER# reports, if a TRAP is armed. Recorded before the context goes. */
obj->lasterrorstatus = status;
cause->handled = true;
IGNORE(akerr_release_error(cause));
PASS(errctx, akbasic_runtime_error(obj, AKBASIC_ERRCLASS_RUNTIME, message));
@@ -458,16 +538,30 @@ akerr_ErrorContext *akbasic_runtime_evaluate(akbasic_Runtime *obj, akbasic_ASTLe
* is the one *not* taken. With an ELSE present the last arm is ELSE;
* without one it is THEN.
*/
obj->skiprestofline = ((expr->right != NULL) == (rval->boolvalue == AKBASIC_TRUE));
{
bool taken = akbasic_value_is_truthy(rval);
akbasic_ASTLeaf *notaken = (taken ? expr->right : expr->left);
if ( rval->boolvalue == AKBASIC_TRUE ) {
PASS(errctx, akbasic_runtime_evaluate(obj, expr->left, dest));
SUCCEED_RETURN(errctx);
}
if ( expr->right != NULL ) {
/* A false branch is optional for some branching operations. */
PASS(errctx, akbasic_runtime_evaluate(obj, expr->right, dest));
SUCCEED_RETURN(errctx);
obj->skiprestofline = ((expr->right != NULL) == taken);
/*
* `IF c THEN BEGIN ... BEND` is a block, and the arm not taken has to
* skip the *lines* between here and its BEND -- skiprestofline only
* reaches the end of this line. Arming the wait is what makes a
* multi-line IF possible at all; BEND clears it.
*/
if ( notaken != NULL && notaken->leaftype == AKBASIC_LEAF_COMMAND &&
strcmp(notaken->identifier, "BEGIN") == 0 ) {
PASS(errctx, akbasic_environment_wait_for_command(obj->environment, "BEND"));
}
if ( taken ) {
PASS(errctx, akbasic_runtime_evaluate(obj, expr->left, dest));
SUCCEED_RETURN(errctx);
}
if ( expr->right != NULL ) {
/* A false branch is optional for some branching operations. */
PASS(errctx, akbasic_runtime_evaluate(obj, expr->right, dest));
SUCCEED_RETURN(errctx);
}
}
SUCCEED_RETURN(errctx);
@@ -727,6 +821,7 @@ akerr_ErrorContext *akbasic_runtime_process_line_repl(akbasic_Runtime *obj)
}
obj->environment->lineno += obj->autoLineNumber;
obj->hadlinenumber = false;
PASS(errctx, akbasic_scanner_scan(obj, obj->userline, scanned, sizeof(scanned)));
PASS(errctx, akbasic_parser_init(&parser, obj));
obj->skiprestofline = false;
@@ -750,6 +845,23 @@ akerr_ErrorContext *akbasic_runtime_process_line_repl(akbasic_Runtime *obj)
continue;
}
/*
* A line typed with a number is program text; a line typed without one is
* a statement to run now. That is direct mode, and it is what makes
* `PRINT 2 + 2` at the prompt answer `4` instead of quietly becoming
* line 0 of a program.
*
* The reference only ever ran the verbs it marked immediate -- RUN, LIST,
* NEW and the rest -- and filed everything else, so most of the language
* was unreachable from a prompt.
*/
if ( !obj->hadlinenumber ) {
PASS(errctx, akbasic_runtime_interpret(obj, leaf, &value));
if ( obj->errclass != AKBASIC_ERRCLASS_NONE ) {
SUCCEED_RETURN(errctx);
}
continue;
}
PASS(errctx, akbasic_runtime_interpret_immediate(obj, leaf, &value));
if ( value == NULL ) {
/* Not an immediate command, so it is program text: file it. */
@@ -835,6 +947,233 @@ akerr_ErrorContext *akbasic_runtime_process_line_run(akbasic_Runtime *obj)
SUCCEED_RETURN(errctx);
}
/* --------------------------------------------------------- label prescan -- */
/**
* @brief File any `LABEL <name>` this one source line declares.
*
* Walks the line a statement at a time, which is all that is needed: `LABEL` is
* a verb, a verb starts a statement, and statements are separated by `:`. The
* only thing that can hide a colon is a string literal, so that is the only
* thing this has to understand about the rest of the language.
*
* @param root The root environment, whose label table this writes.
* @param code One source line, with or without its line number still on it.
* @param lineno The number to file any label under.
* @return `NULL` on success, otherwise an error context owned by the caller.
* @throws AKBASIC_ERR_BOUNDS When the label table is full.
*/
static akerr_ErrorContext *scan_line_labels(akbasic_Environment *root, const char *code, int64_t lineno)
{
PREPARE_ERROR(errctx);
const char *cursor = code;
bool statementstart = true;
bool instring = false;
while ( *cursor != '\0' ) {
if ( instring ) {
instring = (*cursor != '"');
cursor += 1;
continue;
}
if ( *cursor == '"' ) {
instring = true;
statementstart = false;
cursor += 1;
continue;
}
if ( *cursor == ':' ) {
statementstart = true;
cursor += 1;
continue;
}
if ( isspace((unsigned char)*cursor) ) {
cursor += 1;
continue;
}
/*
* A stored line may still carry its own line number. RUNSTREAM files the
* raw text and lets the scanner strip the number again on the way to
* execution, where akbasic_runtime_load() files what the scanner already
* stripped -- so "30 LABEL X" and "LABEL X" are both real spellings of
* source[30], depending on how the program arrived. Step over the number
* without ending the statement.
*/
if ( statementstart && isdigit((unsigned char)*cursor) ) {
while ( isdigit((unsigned char)*cursor) ) {
cursor += 1;
}
continue;
}
if ( statementstart && strncasecmp(cursor, "LABEL", 5) == 0
&& !isalnum((unsigned char)cursor[5]) ) {
char name[AKBASIC_SYMTAB_MAX_KEY];
size_t used = 0;
cursor += 5;
while ( isspace((unsigned char)*cursor) ) {
cursor += 1;
}
/*
* Copied as written. Verbs are case-insensitive in this dialect and
* identifiers are not, so folding the name here would file a label
* under a spelling `LABEL` itself never uses.
*/
while ( isalnum((unsigned char)*cursor) && used < sizeof(name) - 1 ) {
name[used] = *cursor;
used += 1;
cursor += 1;
}
name[used] = '\0';
if ( used > 0 ) {
PASS(errctx, akbasic_symtab_set(&root->labels, name, NULL, lineno));
}
statementstart = false;
continue;
}
statementstart = false;
cursor += 1;
}
SUCCEED_RETURN(errctx);
}
akerr_ErrorContext *akbasic_runtime_scan_labels(akbasic_Runtime *obj)
{
PREPARE_ERROR(errctx);
akbasic_Environment *root = NULL;
int64_t i = 0;
FAIL_ZERO_RETURN(errctx, (obj != NULL), AKERR_NULLPOINTER, "NULL runtime in scan_labels");
FAIL_ZERO_RETURN(errctx, (obj->environment != NULL), AKERR_NULLPOINTER,
"Runtime has no environment; call akbasic_runtime_init() first");
for ( root = obj->environment; root->parent != NULL; root = root->parent ) {
}
for ( i = 0; i < AKBASIC_MAX_SOURCE_LINES; i++ ) {
if ( obj->source[i].code[0] != '\0' ) {
PASS(errctx, scan_line_labels(root, obj->source[i].code, i));
}
}
SUCCEED_RETURN(errctx);
}
/* ------------------------------------------------------------ interrupts -- */
akerr_ErrorContext *akbasic_runtime_arm_interrupt(akbasic_Runtime *obj, akbasic_InterruptSource source, int64_t line, const char *label)
{
PREPARE_ERROR(errctx);
akbasic_Interrupt *slot = NULL;
FAIL_ZERO_RETURN(errctx, (obj != NULL), AKERR_NULLPOINTER, "NULL runtime in arm_interrupt");
FAIL_ZERO_RETURN(errctx, (source >= 0 && source < AKBASIC_MAX_INTERRUPTS),
AKBASIC_ERR_BOUNDS, "Interrupt source %d is outside 0..%d",
(int)source, AKBASIC_MAX_INTERRUPTS - 1);
FAIL_ZERO_RETURN(errctx, ((line > 0) != (label != NULL && label[0] != '\0')),
AKBASIC_ERR_VALUE,
"An interrupt handler is named by a line number or by a label, not both and not neither");
slot = &obj->interrupts[source];
slot->armed = true;
slot->line = line;
slot->label[0] = '\0';
if ( label != NULL && label[0] != '\0' ) {
FAIL_ZERO_RETURN(errctx, (strlen(label) < sizeof(slot->label)), AKBASIC_ERR_BOUNDS,
"Handler label \"%s\" exceeds the %zu character limit",
label, sizeof(slot->label) - 1);
strncpy(slot->label, label, sizeof(slot->label) - 1);
slot->label[sizeof(slot->label) - 1] = '\0';
}
SUCCEED_RETURN(errctx);
}
akerr_ErrorContext *akbasic_runtime_disarm_interrupt(akbasic_Runtime *obj, akbasic_InterruptSource source)
{
PREPARE_ERROR(errctx);
FAIL_ZERO_RETURN(errctx, (obj != NULL), AKERR_NULLPOINTER, "NULL runtime in disarm_interrupt");
FAIL_ZERO_RETURN(errctx, (source >= 0 && source < AKBASIC_MAX_INTERRUPTS),
AKBASIC_ERR_BOUNDS, "Interrupt source %d is outside 0..%d",
(int)source, AKBASIC_MAX_INTERRUPTS - 1);
memset(&obj->interrupts[source], 0, sizeof(obj->interrupts[source]));
SUCCEED_RETURN(errctx);
}
akerr_ErrorContext *akbasic_runtime_raise_interrupt(akbasic_Runtime *obj, akbasic_InterruptSource source)
{
PREPARE_ERROR(errctx);
FAIL_ZERO_RETURN(errctx, (obj != NULL), AKERR_NULLPOINTER, "NULL runtime in raise_interrupt");
FAIL_ZERO_RETURN(errctx, (source >= 0 && source < AKBASIC_MAX_INTERRUPTS),
AKBASIC_ERR_BOUNDS, "Interrupt source %d is outside 0..%d",
(int)source, AKBASIC_MAX_INTERRUPTS - 1);
/*
* An unarmed source records nothing. That is what lets a backend raise
* unconditionally every frame without first asking what the script has
* subscribed to -- and it means a program that arms a handler later does not
* immediately inherit a collision from before it was interested.
*/
if ( obj->interrupts[source].armed ) {
obj->interrupts[source].pending = true;
}
SUCCEED_RETURN(errctx);
}
akerr_ErrorContext *akbasic_runtime_service_interrupts(akbasic_Runtime *obj, bool *entered)
{
PREPARE_ERROR(errctx);
akbasic_Interrupt *slot = NULL;
int64_t target = 0;
int64_t returnline = 0;
int i = 0;
FAIL_ZERO_RETURN(errctx, (obj != NULL), AKERR_NULLPOINTER, "NULL runtime in service_interrupts");
if ( entered != NULL ) {
*entered = false;
}
/* An interrupt does not interrupt an interrupt. */
if ( obj->handlerenv != NULL || obj->environment == NULL ) {
SUCCEED_RETURN(errctx);
}
for ( i = 0; i < AKBASIC_MAX_INTERRUPTS; i++ ) {
if ( obj->interrupts[i].armed && obj->interrupts[i].pending ) {
break;
}
}
if ( i == AKBASIC_MAX_INTERRUPTS ) {
SUCCEED_RETURN(errctx);
}
slot = &obj->interrupts[i];
/*
* Resolve now rather than at arm time, so a LABEL that re-files itself as the
* program runs moves the handler with it.
*/
target = slot->line;
if ( slot->label[0] != '\0' ) {
PASS(errctx, akbasic_environment_get_label(obj->environment, slot->label, &target));
}
FAIL_ZERO_RETURN(errctx, (target > 0 && target < AKBASIC_MAX_SOURCE_LINES),
AKBASIC_ERR_BOUNDS,
"Interrupt handler line %" PRId64 " is outside 1..%d",
target, AKBASIC_MAX_SOURCE_LINES - 1);
/*
* A GOSUB the program did not write. The return line is the one that was
* about to run -- nextline, not lineno, because the line counter has already
* moved on past whatever last executed.
*/
slot->pending = false;
returnline = obj->environment->nextline;
PASS(errctx, akbasic_runtime_new_environment(obj));
obj->environment->gosubReturnLine = returnline;
obj->environment->nextline = target;
obj->handlerenv = obj->environment;
if ( entered != NULL ) {
*entered = true;
}
SUCCEED_RETURN(errctx);
}
/* ------------------------------------------------------------- step loop -- */
akerr_ErrorContext *akbasic_runtime_start(akbasic_Runtime *obj, int mode)
@@ -905,6 +1244,16 @@ akerr_ErrorContext *akbasic_runtime_step(akbasic_Runtime *obj)
*/
PASS(errctx, akbasic_play_service(obj));
/*
* Sprite motion is serviced beside the note queue and for the same reason:
* MOVSPR's continuous form is a duration, not a statement, and a program
* sitting in a GETKEY should still see its sprites move. Collisions are
* looked for immediately afterwards, so a collision is reported against
* where the sprites have just been moved to rather than where they were.
*/
PASS(errctx, akbasic_sprite_service(obj));
PASS(errctx, akbasic_collision_service(obj));
if ( obj->mode == AKBASIC_MODE_QUIT ) {
SUCCEED_RETURN(errctx);
}
@@ -921,6 +1270,17 @@ akerr_ErrorContext *akbasic_runtime_step(akbasic_Runtime *obj)
SUCCEED_RETURN(errctx);
}
/*
* SLEEP and WAIT hold the same way GETKEY does, and the clock is refreshed
* before they are asked -- a SLEEP that read a stale clock would wake a step
* late every time.
*/
PASS(errctx, akbasic_console_update_clock(obj));
PASS(errctx, akbasic_console_service(obj, &blocked));
if ( blocked ) {
SUCCEED_RETURN(errctx);
}
PASS(errctx, akbasic_runtime_zero(obj));
PASS(errctx, akbasic_scanner_zero(obj));
@@ -932,6 +1292,28 @@ akerr_ErrorContext *akbasic_runtime_step(akbasic_Runtime *obj)
PASS(errctx, akbasic_runtime_process_line_repl(obj));
break;
case AKBASIC_MODE_RUN:
/*
* Between lines is the only safe place to enter a handler: a GOSUB
* injected mid-statement would have to return into the middle of a line,
* and the parser keeps no state that could resume there.
*
* A failure here is the program's -- an undefined handler label, a
* handler line out of range -- so it is reported and it stops the run,
* the same treatment a parse error gets in process_line_run(). Letting it
* out of step() would tear down the host over a script's mistake.
*/
ATTEMPT {
CATCH(errctx, akbasic_runtime_service_interrupts(obj, NULL));
} CLEANUP {
} PROCESS(errctx) {
} HANDLE_DEFAULT(errctx) {
char message[AKERR_MAX_ERROR_CONTEXT_STRING_LENGTH];
snprintf(message, sizeof(message), "%s", errctx->message);
IGNORE(akbasic_runtime_error(obj, AKBASIC_ERRCLASS_RUNTIME, message));
} FINISH(errctx, false);
if ( obj->errclass != AKBASIC_ERRCLASS_NONE ) {
break;
}
PASS(errctx, akbasic_runtime_process_line_run(obj));
break;
default:

41
src/runtime_audio.c
View File

@@ -17,6 +17,7 @@
#include <akerror.h>
#include <akbasic/audio.h>
#include <akbasic/args.h>
#include <akbasic/error.h>
#include <akbasic/runtime.h>
@@ -40,38 +41,6 @@ static akerr_ErrorContext *require_audio(akbasic_Runtime *obj, const char *verb)
SUCCEED_RETURN(errctx);
}
/**
* @brief Collect a verb's numeric arguments, as the graphics verbs do.
*
* Duplicated rather than shared with src/runtime_graphics.c on purpose: sharing
* it would mean a third file existing only to hold one static helper, and the
* two copies answer to different verbs. If a third group wants it, that is the
* point at which it earns a home of its own.
*/
static akerr_ErrorContext *collect_numbers(akbasic_Runtime *obj, akbasic_ASTLeaf *expr, const char *verb, double *values, int max, int *count)
{
PREPARE_ERROR(errctx);
akbasic_ASTLeaf *arg = NULL;
akbasic_Value *value = NULL;
FAIL_ZERO_RETURN(errctx, (obj != NULL && expr != NULL && values != NULL && count != NULL),
AKERR_NULLPOINTER, "NULL argument in collect_numbers");
*count = 0;
arg = akbasic_leaf_first_argument(expr);
while ( arg != NULL ) {
FAIL_NONZERO_RETURN(errctx, (*count >= max), AKBASIC_ERR_SYNTAX,
"%s takes at most %d arguments", verb, max);
PASS(errctx, akbasic_runtime_evaluate(obj, arg, &value));
FAIL_NONZERO_RETURN(errctx, (value->valuetype == AKBASIC_TYPE_STRING),
AKBASIC_ERR_TYPE,
"%s expected a number in argument %d", verb, *count + 1);
values[*count] = (value->valuetype == AKBASIC_TYPE_FLOAT)
? value->floatval : (double)value->intval;
*count += 1;
arg = arg->next;
}
SUCCEED_RETURN(errctx);
}
/**
* @brief Issue SOUND's swept note, translating its arguments out of SID space.
@@ -142,7 +111,7 @@ akerr_ErrorContext *akbasic_cmd_sound(akbasic_Runtime *obj, akbasic_ASTLeaf *exp
(void)lval; (void)rval;
PASS(errctx, require_audio(obj, "SOUND"));
PASS(errctx, collect_numbers(obj, expr, "SOUND", args, 8, &count));
PASS(errctx, akbasic_args_numbers(obj, expr, "SOUND", args, 8, &count));
FAIL_ZERO_RETURN(errctx, (count >= 3), AKBASIC_ERR_SYNTAX,
"SOUND expected a voice, a frequency and a duration");
@@ -219,7 +188,7 @@ akerr_ErrorContext *akbasic_cmd_envelope(akbasic_Runtime *obj, akbasic_ASTLeaf *
* device and a program can set its instruments up before a host lends it one.
*/
FAIL_ZERO_RETURN(errctx, (obj != NULL), AKERR_NULLPOINTER, "NULL runtime in ENVELOPE");
PASS(errctx, collect_numbers(obj, expr, "ENVELOPE", args, 7, &count));
PASS(errctx, akbasic_args_numbers(obj, expr, "ENVELOPE", args, 7, &count));
FAIL_ZERO_RETURN(errctx, (count >= 1), AKBASIC_ERR_SYNTAX,
"ENVELOPE expected a preset number");
@@ -270,7 +239,7 @@ akerr_ErrorContext *akbasic_cmd_vol(akbasic_Runtime *obj, akbasic_ASTLeaf *expr,
(void)lval; (void)rval;
FAIL_ZERO_RETURN(errctx, (obj != NULL), AKERR_NULLPOINTER, "NULL runtime in VOL");
PASS(errctx, collect_numbers(obj, expr, "VOL", args, 1, &count));
PASS(errctx, akbasic_args_numbers(obj, expr, "VOL", args, 1, &count));
FAIL_ZERO_RETURN(errctx, (count == 1), AKBASIC_ERR_SYNTAX, "VOL expected a level");
level = (int)args[0];
@@ -302,7 +271,7 @@ akerr_ErrorContext *akbasic_cmd_tempo(akbasic_Runtime *obj, akbasic_ASTLeaf *exp
(void)lval; (void)rval;
FAIL_ZERO_RETURN(errctx, (obj != NULL), AKERR_NULLPOINTER, "NULL runtime in TEMPO");
PASS(errctx, collect_numbers(obj, expr, "TEMPO", args, 1, &count));
PASS(errctx, akbasic_args_numbers(obj, expr, "TEMPO", args, 1, &count));
FAIL_ZERO_RETURN(errctx, (count == 1), AKBASIC_ERR_SYNTAX, "TEMPO expected a value");
tempo = (int)args[0];

226
src/runtime_commands.c
View File

@@ -61,6 +61,32 @@ akerr_ErrorContext *akbasic_cmd_print(akbasic_Runtime *obj, akbasic_ASTLeaf *exp
SUCCEED_TRUE(obj, dest);
SUCCEED_RETURN(errctx);
}
/*
* PRINT USING: the parse handler leaves an argument list of exactly two --
* the format and the value -- where a plain PRINT leaves a single
* expression. The list is the only thing that tells them apart.
*/
{
akbasic_ASTLeaf *arg = akbasic_leaf_first_argument(expr);
if ( arg != NULL && arg->next != NULL ) {
akbasic_Value *format = NULL;
akbasic_Value *value = NULL;
char formatted[AKBASIC_MAX_STRING_LENGTH];
PASS(errctx, akbasic_runtime_evaluate(obj, arg, &format));
FAIL_NONZERO_RETURN(errctx, (format->valuetype != AKBASIC_TYPE_STRING),
AKBASIC_ERR_TYPE, "PRINT USING expected a format string");
PASS(errctx, akbasic_runtime_evaluate(obj, arg->next, &value));
PASS(errctx, akbasic_format_using(&obj->format_state, format->stringval, value,
formatted, sizeof(formatted)));
PASS(errctx, akbasic_runtime_println(obj, formatted));
SUCCEED_TRUE(obj, dest);
SUCCEED_RETURN(errctx);
}
}
PASS(errctx, akbasic_runtime_evaluate(obj, expr->right, dest));
PASS(errctx, akbasic_value_to_string(*dest, rendered, sizeof(rendered)));
PASS(errctx, akbasic_runtime_println(obj, rendered));
@@ -131,6 +157,14 @@ akerr_ErrorContext *akbasic_cmd_return(akbasic_Runtime *obj, akbasic_ASTLeaf *ex
"RETURN from an orphaned environment");
obj->environment->parent->nextline = obj->environment->gosubReturnLine;
PASS(errctx, akbasic_value_clone(result, &obj->environment->returnValue));
/*
* Leaving an interrupt handler re-arms interrupts. Compared by identity
* rather than by a depth counter so that a GOSUB the handler itself makes
* returns without re-arming: it is *this* environment that has to pop.
*/
if ( obj->environment == obj->handlerenv ) {
obj->handlerenv = NULL;
}
PASS(errctx, akbasic_runtime_prev_environment(obj));
*dest = result;
SUCCEED_RETURN(errctx);
@@ -677,6 +711,23 @@ akerr_ErrorContext *akbasic_cmd_next(akbasic_Runtime *obj, akbasic_ASTLeaf *expr
obj->environment->loopExitLine = obj->environment->lineno + 1;
/*
* An EXIT sent us here. The loop is over whatever the counter says, and it
* is over for *this* loop -- EXIT leaves the innermost one, and the wait it
* armed is on the innermost environment, so the first NEXT reached is the
* right one whether or not it names the same variable.
*/
if ( obj->environment->exiting ) {
obj->environment->exiting = false;
PASS(errctx, akbasic_environment_stop_waiting(obj->environment, "NEXT"));
FAIL_ZERO_RETURN(errctx, (obj->environment->parent != NULL), AKBASIC_ERR_ENVIRONMENT,
"NEXT in an orphaned environment");
obj->environment->parent->nextline = obj->environment->loopExitLine;
PASS(errctx, akbasic_runtime_prev_environment(obj));
*dest = &obj->staticFalseValue;
SUCCEED_RETURN(errctx);
}
/*
* A NEXT for someone else's loop variable: this environment is done, hand
* the line back to the parent and pop. That is how nested loops unwind.
@@ -707,12 +758,15 @@ akerr_ErrorContext *akbasic_cmd_next(akbasic_Runtime *obj, akbasic_ASTLeaf *expr
}
/*
* Advance the counter. The stored value is mutable, so math_plus updates it
* in place -- see TODO.md section 12 item 4. Changing that without changing
* this breaks every FOR loop.
* Advance the counter, then store it. math_plus clones like every other
* operator, so the sum lands in `scratch` and this is what puts it back in
* the variable. The reference relied on math_plus mutating the counter in
* place instead, which meant `A# + 1` anywhere in a program could modify
* `A#` -- TODO.md section 6 item 4.
*/
PASS(errctx, akbasic_value_math_plus(counter, &obj->environment->forStepValue,
&scratch, &updated));
PASS(errctx, akbasic_variable_set_subscript(nextvar, updated, zerosubscript, 1));
obj->environment->nextline = obj->environment->loopFirstLine;
SUCCEED_TRUE(obj, dest);
SUCCEED_RETURN(errctx);
@@ -723,20 +777,31 @@ akerr_ErrorContext *akbasic_cmd_exit(akbasic_Runtime *obj, akbasic_ASTLeaf *expr
PREPARE_ERROR(errctx);
(void)expr; (void)lval; (void)rval;
/*
* EXIT leaves whichever kind of loop it is standing in, so which verb it
* skips forward to depends on that: NEXT for a FOR, LOOP for a DO.
*/
FAIL_NONZERO_RETURN(errctx,
(obj->environment->forToValue.valuetype == AKBASIC_TYPE_UNDEFINED),
AKBASIC_ERR_STATE, "EXIT outside the context of FOR");
(obj->environment->forToValue.valuetype == AKBASIC_TYPE_UNDEFINED &&
!obj->environment->isDoLoop),
AKBASIC_ERR_STATE, "EXIT outside the context of FOR or DO");
FAIL_ZERO_RETURN(errctx, (obj->environment->parent != NULL), AKBASIC_ERR_ENVIRONMENT,
"EXIT in an orphaned environment");
obj->environment->parent->nextline = obj->environment->loopExitLine;
/*
* The reference pops without clearing the wait, which leaves the parent
* waiting for a NEXT that will never arrive (TODO.md section 12 item 8). The
* wait is cleared here first: leaving it set would hang the interpreter
* rather than merely misbehave, and no golden case depends on the hang.
* Skip forward to the loop's NEXT rather than jumping past it. The reference
* jumps to loopExitLine, which is only ever written by NEXT itself -- so an
* EXIT on the first pass through the loop, which is the ordinary case, jumps
* to line 0 and restarts the program. Each restart enters FOR again and
* takes another environment and another variable, so what a reader sees is
* "Maximum runtime variables reached" reported against the FOR.
*
* The wait does the work instead: nothing between here and the NEXT
* executes, the NEXT sees `exiting` and pops rather than looping, and
* neither this verb nor that one has to know where the loop ends.
*/
PASS(errctx, akbasic_environment_stop_waiting(obj->environment, "NEXT"));
PASS(errctx, akbasic_runtime_prev_environment(obj));
obj->environment->exiting = true;
PASS(errctx, akbasic_environment_wait_for_command(obj->environment,
(obj->environment->isDoLoop ? "LOOP" : "NEXT")));
SUCCEED_TRUE(obj, dest);
SUCCEED_RETURN(errctx);
}
@@ -744,14 +809,93 @@ akerr_ErrorContext *akbasic_cmd_exit(akbasic_Runtime *obj, akbasic_ASTLeaf *expr
akerr_ErrorContext *akbasic_cmd_read(akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest)
{
PREPARE_ERROR(errctx);
akbasic_Environment *env = obj->environment;
akbasic_ASTLeaf *identifier = NULL;
akbasic_ASTLeaf assign;
akbasic_ASTLeaf literal;
akbasic_Value value;
akbasic_Value *unused = NULL;
int i = 0;
(void)expr; (void)lval; (void)rval;
/*
* READ does not read: it declares that the next DATA line should fill these
* identifiers, and skips forward until one appears.
* READ now reads. The reference records its identifiers, sets the scope
* waiting for a DATA verb and lets execution skip forward until one turns up
* -- which never finds a DATA line written *above* the READ, and leaves
* nothing for RESTORE to reset. Every DATA item is pre-scanned into one list
* before the program runs (see akbasic_data_scan), and this walks a cursor
* along it. TODO.md section 6.
*/
PASS(errctx, akbasic_environment_wait_for_command(obj->environment, "DATA"));
obj->environment->readIdentifierIdx = 0;
for ( i = 0; i < AKBASIC_MAX_LEAVES; i++ ) {
identifier = env->readIdentifierLeaves[i];
if ( identifier == NULL ) {
break;
}
PASS(errctx, akbasic_data_next(obj, akbasic_leaf_identifier_type(identifier), &value));
/*
* Build the assignment by hand rather than through the parser: the
* identifier leaf is a stored copy and the value came from the item
* list, so there is no source text to re-parse.
*/
PASS(errctx, akbasic_leaf_init(&literal, AKBASIC_LEAF_LITERAL_INT));
if ( value.valuetype == AKBASIC_TYPE_STRING ) {
literal.leaftype = AKBASIC_LEAF_LITERAL_STRING;
snprintf(literal.literal_string, sizeof(literal.literal_string), "%s", value.stringval);
} else if ( value.valuetype == AKBASIC_TYPE_FLOAT ) {
literal.leaftype = AKBASIC_LEAF_LITERAL_FLOAT;
literal.literal_float = value.floatval;
} else {
literal.literal_int = value.intval;
}
PASS(errctx, akbasic_leaf_init(&assign, AKBASIC_LEAF_BINARY));
assign.left = identifier;
assign.right = &literal;
assign.operator_ = AKBASIC_TOK_ASSIGNMENT;
PASS(errctx, akbasic_runtime_evaluate(obj, &assign, &unused));
}
env->readIdentifierIdx = 0;
SUCCEED_TRUE(obj, dest);
SUCCEED_RETURN(errctx);
}
akerr_ErrorContext *akbasic_cmd_restore(akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest)
{
PREPARE_ERROR(errctx);
akbasic_Value *target = NULL;
int64_t line = 0;
int i = 0;
(void)lval; (void)rval;
FAIL_ZERO_RETURN(errctx, (obj != NULL && dest != NULL), AKERR_NULLPOINTER,
"NULL argument in RESTORE");
if ( expr == NULL || expr->right == NULL ) {
/* Bare RESTORE goes back to the first item, which is what a C128 does. */
obj->data_state.cursor = 0;
SUCCEED_TRUE(obj, dest);
SUCCEED_RETURN(errctx);
}
PASS(errctx, akbasic_runtime_evaluate(obj, expr->right, &target));
FAIL_NONZERO_RETURN(errctx, (target->valuetype != AKBASIC_TYPE_INTEGER), AKBASIC_ERR_TYPE,
"RESTORE expected a line number or a label");
line = target->intval;
/*
* The first item at or after that line. "At or after" rather than "on",
* because RESTORE 100 in a program whose DATA is on line 110 should find it
* -- a program names the line it wants to start reading *from*.
*/
for ( i = 0; i < obj->data_state.count; i++ ) {
if ( obj->data_state.items[i].lineno >= line ) {
obj->data_state.cursor = i;
SUCCEED_TRUE(obj, dest);
SUCCEED_RETURN(errctx);
}
}
/* Nothing at or after it: the next READ is out of data, which is honest. */
obj->data_state.cursor = obj->data_state.count;
SUCCEED_TRUE(obj, dest);
SUCCEED_RETURN(errctx);
}
@@ -759,48 +903,16 @@ akerr_ErrorContext *akbasic_cmd_read(akbasic_Runtime *obj, akbasic_ASTLeaf *expr
akerr_ErrorContext *akbasic_cmd_data(akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest)
{
PREPARE_ERROR(errctx);
akbasic_Environment *env = obj->environment;
akbasic_ASTLeaf *literal = NULL;
akbasic_ASTLeaf *identifier = NULL;
akbasic_ASTLeaf assign;
akbasic_Value *unused = NULL;
(void)lval; (void)rval;
FAIL_ZERO_RETURN(errctx, (expr != NULL && expr->right != NULL), AKERR_NULLPOINTER,
"NIL expression or argument list");
for ( literal = expr->right->right; literal != NULL; literal = literal->next ) {
if ( env->readIdentifierIdx >= AKBASIC_MAX_LEAVES ) {
break;
}
identifier = env->readIdentifierLeaves[env->readIdentifierIdx];
if ( identifier == NULL ) {
break;
}
/*
* Build the assignment by hand rather than through the parser: the
* identifier leaf is a stored copy and the literal belongs to this
* line's pool, so there is no source text to re-parse.
*/
PASS(errctx, akbasic_leaf_init(&assign, AKBASIC_LEAF_BINARY));
assign.left = identifier;
assign.right = literal;
assign.operator_ = AKBASIC_TOK_ASSIGNMENT;
PASS(errctx, akbasic_runtime_evaluate(obj, &assign, &unused));
env->readIdentifierIdx += 1;
}
if ( literal == NULL &&
env->readIdentifierIdx < AKBASIC_MAX_LEAVES &&
env->readIdentifierLeaves[env->readIdentifierIdx] != NULL ) {
/* Out of DATA with READ items outstanding: stay in waiting mode. */
SUCCEED_TRUE(obj, dest);
SUCCEED_RETURN(errctx);
}
PASS(errctx, akbasic_environment_stop_waiting(env, "DATA"));
env->lineno = env->readReturnLine;
env->readIdentifierIdx = 0;
(void)expr; (void)lval; (void)rval;
FAIL_ZERO_RETURN(errctx, (obj != NULL && dest != NULL), AKERR_NULLPOINTER,
"NULL argument in DATA");
/*
* Nothing to do. DATA is declaration, not execution: every item was
* collected into the item list before the program started, so reaching the
* statement means walking past it. The reference did the assigning here,
* which is why READ had to skip forward to find one.
*/
SUCCEED_TRUE(obj, dest);
SUCCEED_RETURN(errctx);
}

273
src/runtime_console.c Normal file
View File

@@ -0,0 +1,273 @@
/**
* @file runtime_console.c
* @brief The group E verbs: SLEEP, WAIT, KEY, WINDOW, and the TI clock.
*
* Everything here that waits does so by *holding the step loop*, the way GETKEY
* already does (see akbasic_input_service). Section 1.6 forbids the library
* blocking: a host calls akbasic_runtime_step() once a frame and it must always
* come back, so "wait" means "do not advance this step" rather than "do not
* return". A bounded akbasic_runtime_run() still returns on time, and a host
* that wants to abandon the wait can change the mode.
*/
#include <inttypes.h>
#include <stdio.h>
#include <string.h>
#include <akerror.h>
#include <akbasic/args.h>
#include <akbasic/error.h>
#include <akbasic/runtime.h>
#include "verbs.h"
/* Most verbs answer "did something happen"; this is that answer. */
#define SUCCEED_TRUE(__obj, __dest) \
do { \
*(__dest) = &(__obj)->staticTrueValue; \
} while ( 0 )
/** @brief Jiffies per second. A Commodore counts time in sixtieths. */
#define JIFFIES_PER_SECOND 60
/* ------------------------------------------------------------------ SLEEP -- */
akerr_ErrorContext *akbasic_cmd_sleep(akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest)
{
PREPARE_ERROR(errctx);
double args[1];
int count = 0;
(void)lval; (void)rval;
FAIL_ZERO_RETURN(errctx, (obj != NULL && dest != NULL), AKERR_NULLPOINTER,
"NULL argument in SLEEP");
PASS(errctx, akbasic_args_numbers(obj, expr, "SLEEP", args, 1, &count));
FAIL_ZERO_RETURN(errctx, (count == 1), AKBASIC_ERR_SYNTAX, "Expected SLEEP (seconds)");
FAIL_ZERO_RETURN(errctx, (args[0] >= 0.0), AKBASIC_ERR_VALUE,
"SLEEP cannot wait a negative number of seconds");
/*
* Records when to stop and returns. akbasic_console_service() holds the step
* loop until then -- so a program that sleeps still lets its host draw
* frames, and a sleeping program in an embedded game does not freeze the
* game.
*
* A host that never calls akbasic_runtime_settime() leaves the clock at
* zero, and a deadline computed from a clock that never advances is never
* reached. So no clock means no sleep: the verb does nothing rather than
* hanging the program, which is the same trade the audio durations make
* (§5 deviation 20) and the same direction -- fail fast, not silently
* forever.
*/
if ( obj->timems <= 0 ) {
SUCCEED_TRUE(obj, dest);
SUCCEED_RETURN(errctx);
}
obj->console_state.sleepuntilms = obj->timems + (int64_t)(args[0] * 1000.0);
obj->console_state.sleeping = true;
SUCCEED_TRUE(obj, dest);
SUCCEED_RETURN(errctx);
}
/* ------------------------------------------------------------------- WAIT -- */
akerr_ErrorContext *akbasic_cmd_wait(akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest)
{
PREPARE_ERROR(errctx);
double args[3];
int count = 0;
(void)lval; (void)rval;
FAIL_ZERO_RETURN(errctx, (obj != NULL && dest != NULL), AKERR_NULLPOINTER,
"NULL argument in WAIT");
PASS(errctx, akbasic_args_numbers(obj, expr, "WAIT", args, 3, &count));
FAIL_ZERO_RETURN(errctx, (count >= 2), AKBASIC_ERR_SYNTAX,
"Expected WAIT (address), (mask) [, (xor)]");
/*
* WAIT polls a byte until `(PEEK(addr) XOR xor) AND mask` is non-zero. On a
* C128 that byte is a hardware register an interrupt is changing; here it is
* ordinary process memory, and the only thing that can change it is the host
* -- or another thread, or a POKE from a TRAP handler.
*
* So this is honest but rarely useful: a program that waits on memory
* nothing writes waits forever, which is exactly what the same program does
* on a C128 with the wrong address. It holds the step loop rather than
* blocking, so the host keeps its frame rate and can stop the program.
*/
obj->console_state.waitaddress = (uintptr_t)args[0];
obj->console_state.waitmask = (uint8_t)args[1];
obj->console_state.waitxor = (count >= 3 ? (uint8_t)args[2] : 0);
obj->console_state.waiting = true;
SUCCEED_TRUE(obj, dest);
SUCCEED_RETURN(errctx);
}
/* -------------------------------------------------------------------- KEY -- */
akerr_ErrorContext *akbasic_cmd_key(akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest)
{
PREPARE_ERROR(errctx);
akbasic_ASTLeaf *arg = NULL;
akbasic_Value *value = NULL;
/* Room for the longest macro plus `KEY n, ""` around it. */
char line[AKBASIC_MAX_STRING_LENGTH + 32];
int64_t number = 0;
int i = 0;
(void)lval; (void)rval;
FAIL_ZERO_RETURN(errctx, (obj != NULL && dest != NULL), AKERR_NULLPOINTER,
"NULL argument in KEY");
arg = akbasic_leaf_first_argument(expr);
if ( arg == NULL ) {
/* Bare KEY lists the definitions, which is what a C128 does. */
for ( i = 0; i < AKBASIC_MAX_FUNCTION_KEYS; i++ ) {
snprintf(line, sizeof(line), "KEY %d, \"%s\"",
i + 1, obj->console_state.keys[i]);
PASS(errctx, akbasic_runtime_println(obj, line));
}
SUCCEED_TRUE(obj, dest);
SUCCEED_RETURN(errctx);
}
PASS(errctx, akbasic_runtime_evaluate(obj, arg, &value));
FAIL_NONZERO_RETURN(errctx, (value->valuetype == AKBASIC_TYPE_STRING), AKBASIC_ERR_TYPE,
"KEY expected a key number");
number = value->intval;
FAIL_ZERO_RETURN(errctx, (number >= 1 && number <= AKBASIC_MAX_FUNCTION_KEYS),
AKBASIC_ERR_BOUNDS, "KEY %" PRId64 " is outside 1..%d",
number, AKBASIC_MAX_FUNCTION_KEYS);
arg = arg->next;
FAIL_ZERO_RETURN(errctx, (arg != NULL), AKBASIC_ERR_SYNTAX,
"Expected KEY (number), (string)");
PASS(errctx, akbasic_runtime_evaluate(obj, arg, &value));
FAIL_NONZERO_RETURN(errctx, (value->valuetype != AKBASIC_TYPE_STRING), AKBASIC_ERR_TYPE,
"KEY expected a string");
snprintf(obj->console_state.keys[number - 1],
sizeof(obj->console_state.keys[0]), "%s", value->stringval);
SUCCEED_TRUE(obj, dest);
SUCCEED_RETURN(errctx);
}
/* ----------------------------------------------------------------- WINDOW -- */
akerr_ErrorContext *akbasic_cmd_window(akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest)
{
PREPARE_ERROR(errctx);
double args[5];
int count = 0;
(void)lval; (void)rval;
FAIL_ZERO_RETURN(errctx, (obj != NULL && dest != NULL), AKERR_NULLPOINTER,
"NULL argument in WINDOW");
PASS(errctx, akbasic_args_numbers(obj, expr, "WINDOW", args, 5, &count));
FAIL_ZERO_RETURN(errctx, (count >= 4), AKBASIC_ERR_SYNTAX,
"Expected WINDOW (left), (top), (right), (bottom) [, (clear)]");
/*
* The geometry first, and deliberately: an inside-out rectangle is a mistake
* in the program whether or not a device is attached, and reporting "no
* device" for it would send the author looking in the wrong place.
*/
FAIL_ZERO_RETURN(errctx, (args[0] <= args[2] && args[1] <= args[3]), AKBASIC_ERR_VALUE,
"WINDOW's bottom right must not be above or left of its top left");
FAIL_ZERO_RETURN(errctx, (obj->sink != NULL), AKBASIC_ERR_DEVICE,
"WINDOW needs a text device and this runtime has none");
FAIL_ZERO_RETURN(errctx, (obj->sink->window != NULL), AKBASIC_ERR_DEVICE,
"WINDOW needs a text device with a character grid, and this one has none");
PASS(errctx, obj->sink->window(obj->sink, (int)args[0], (int)args[1],
(int)args[2], (int)args[3]));
if ( count >= 5 && args[4] != 0.0 ) {
PASS(errctx, obj->sink->clear(obj->sink));
}
SUCCEED_TRUE(obj, dest);
SUCCEED_RETURN(errctx);
}
/* ---------------------------------------------------------------- service -- */
akerr_ErrorContext *akbasic_console_state_init(akbasic_ConsoleState *obj)
{
PREPARE_ERROR(errctx);
FAIL_ZERO_RETURN(errctx, (obj != NULL), AKERR_NULLPOINTER, "NULL console state in init");
memset(obj, 0, sizeof(*obj));
SUCCEED_RETURN(errctx);
}
akerr_ErrorContext *akbasic_console_service(akbasic_Runtime *obj, bool *blocked)
{
PREPARE_ERROR(errctx);
FAIL_ZERO_RETURN(errctx, (obj != NULL && blocked != NULL), AKERR_NULLPOINTER,
"NULL argument in console_service");
*blocked = false;
if ( obj->console_state.sleeping ) {
if ( obj->timems >= obj->console_state.sleepuntilms ) {
obj->console_state.sleeping = false;
} else {
*blocked = true;
SUCCEED_RETURN(errctx);
}
}
if ( obj->console_state.waiting ) {
const volatile uint8_t *address = (const volatile uint8_t *)obj->console_state.waitaddress;
uint8_t byte = 0;
/*
* `volatile`, because the whole point is that something outside this
* program changes it. Without it the compiler is entitled to read the
* byte once and spin on the register.
*/
byte = *address;
if ( ((byte ^ obj->console_state.waitxor) & obj->console_state.waitmask) != 0 ) {
obj->console_state.waiting = false;
} else {
*blocked = true;
SUCCEED_RETURN(errctx);
}
}
SUCCEED_RETURN(errctx);
}
akerr_ErrorContext *akbasic_console_update_clock(akbasic_Runtime *obj)
{
PREPARE_ERROR(errctx);
akbasic_Variable *variable = NULL;
int64_t zerosubscript[1] = { 0 };
int64_t jiffies = 0;
int64_t seconds = 0;
char text[16];
FAIL_ZERO_RETURN(errctx, (obj != NULL), AKERR_NULLPOINTER, "NULL runtime in update_clock");
if ( obj->environment == NULL ) {
SUCCEED_RETURN(errctx);
}
/*
* `TI` and `TI$` are `TI#` and `TI$` here, and they are written rather than
* computed on read: this dialect has no bare variable names and no
* pseudo-variable mechanism, so they are ordinary globals refreshed once per
* step. Same decision as `ER#` and `EL#`, for the same reason.
*
* Counted in jiffies -- sixtieths of a second -- from the host's clock,
* which is what `TI` means on a Commodore. A host that never calls
* akbasic_runtime_settime() leaves both at zero, which is a stopped clock
* rather than a wrong one.
*/
jiffies = (obj->timems * JIFFIES_PER_SECOND) / 1000;
PASS(errctx, akbasic_runtime_global(obj, "TI#", &variable));
PASS(errctx, akbasic_variable_set_integer(variable, jiffies, zerosubscript, 1));
seconds = obj->timems / 1000;
snprintf(text, sizeof(text), "%02" PRId64 "%02" PRId64 "%02" PRId64,
(seconds / 3600) % 24, (seconds / 60) % 60, seconds % 60);
PASS(errctx, akbasic_runtime_global(obj, "TI$", &variable));
PASS(errctx, akbasic_variable_set_string(variable, text, zerosubscript, 1));
SUCCEED_RETURN(errctx);
}

755
src/runtime_disk.c Normal file
View File

@@ -0,0 +1,755 @@
/**
* @file runtime_disk.c
* @brief The group F verbs: files, channels, and the ones that need a 1541.
*
* Split three ways, and the split is the whole design.
*
* - **Verbs that mean something on a filesystem** are implemented against
* `aksl_f*`: DOPEN, DCLOSE, APPEND, RECORD, SCRATCH, RENAME, COPY, CONCAT,
* DIRECTORY and the binary pair BSAVE/BLOAD.
* - **Verbs that are spellings of ones already here** are aliases: SAVE and
* LOAD are DSAVE and DLOAD, CATALOG is DIRECTORY, DVERIFY is VERIFY.
* - **Verbs that need the hardware** are refused by name, with the reason:
* HEADER, COLLECT, BACKUP, BOOT and DCLEAR. Formatting a disk, validating
* one, duplicating one and resetting a drive have no filesystem meaning that
* is not a lie.
*
* Channel numbers are the program's, written after `#`. A leading `#` is
* optional everywhere -- `DOPEN #1, "F"` and `DOPEN 1, "F"` are the same
* statement -- because the scanner reads `#` as its own token and a verb name
* cannot carry one.
*/
#include <inttypes.h>
#include <stdio.h>
#include <string.h>
#include <akerror.h>
#include <akstdlib.h>
#include <akbasic/args.h>
#include <akbasic/error.h>
#include <akbasic/runtime.h>
#include "verbs.h"
/* Most verbs answer "did something happen"; this is that answer. */
#define SUCCEED_TRUE(__obj, __dest) \
do { \
*(__dest) = &(__obj)->staticTrueValue; \
} while ( 0 )
akerr_ErrorContext *akbasic_disk_state_init(akbasic_DiskState *obj)
{
PREPARE_ERROR(errctx);
FAIL_ZERO_RETURN(errctx, (obj != NULL), AKERR_NULLPOINTER, "NULL disk state in init");
memset(obj, 0, sizeof(*obj));
SUCCEED_RETURN(errctx);
}
akerr_ErrorContext *akbasic_disk_close_all(akbasic_DiskState *obj)
{
PREPARE_ERROR(errctx);
int i = 0;
FAIL_ZERO_RETURN(errctx, (obj != NULL), AKERR_NULLPOINTER, "NULL disk state in close_all");
/*
* A loop, so CATCH and the _BREAK macros are banned in here. A close that
* fails is reported, but the rest are still closed: leaking the others
* because one of them was already gone would be a poor trade.
*/
for ( i = 0; i < AKBASIC_MAX_CHANNELS; i++ ) {
if ( obj->channels[i].fp != NULL ) {
IGNORE(aksl_fclose(obj->channels[i].fp));
obj->channels[i].fp = NULL;
obj->channels[i].name[0] = '\0';
obj->channels[i].writing = false;
}
}
SUCCEED_RETURN(errctx);
}
/** @brief Check a channel number and hand back its slot. */
static akerr_ErrorContext *channel_slot(akbasic_Runtime *obj, int64_t number, akbasic_Channel **dest)
{
PREPARE_ERROR(errctx);
FAIL_ZERO_RETURN(errctx, (number >= 0 && number < AKBASIC_MAX_CHANNELS),
AKBASIC_ERR_BOUNDS, "Channel %" PRId64 " is outside 0..%d",
number, AKBASIC_MAX_CHANNELS - 1);
*dest = &obj->disk_state.channels[number];
SUCCEED_RETURN(errctx);
}
/** @brief The slot for an already-open channel, or an error naming the number. */
static akerr_ErrorContext *open_channel(akbasic_Runtime *obj, int64_t number, akbasic_Channel **dest)
{
PREPARE_ERROR(errctx);
PASS(errctx, channel_slot(obj, number, dest));
FAIL_ZERO_RETURN(errctx, ((*dest)->fp != NULL), AKBASIC_ERR_STATE,
"Channel %" PRId64 " is not open", number);
SUCCEED_RETURN(errctx);
}
/** @brief Evaluate one argument as a string. */
static akerr_ErrorContext *string_arg(akbasic_Runtime *obj, akbasic_ASTLeaf *arg, const char *verb, char *dest, size_t len)
{
PREPARE_ERROR(errctx);
akbasic_Value *value = NULL;
FAIL_ZERO_RETURN(errctx, (arg != NULL), AKBASIC_ERR_SYNTAX, "%s expected a file name", verb);
PASS(errctx, akbasic_runtime_evaluate(obj, arg, &value));
FAIL_NONZERO_RETURN(errctx, (value->valuetype != AKBASIC_TYPE_STRING), AKBASIC_ERR_TYPE,
"%s expected a file name", verb);
snprintf(dest, len, "%s", value->stringval);
SUCCEED_RETURN(errctx);
}
/** @brief Evaluate one argument as an integer. */
static akerr_ErrorContext *int_arg(akbasic_Runtime *obj, akbasic_ASTLeaf *arg, const char *verb, int64_t *dest)
{
PREPARE_ERROR(errctx);
akbasic_Value *value = NULL;
FAIL_ZERO_RETURN(errctx, (arg != NULL), AKBASIC_ERR_SYNTAX, "%s expected a number", verb);
PASS(errctx, akbasic_runtime_evaluate(obj, arg, &value));
FAIL_NONZERO_RETURN(errctx, (value->valuetype == AKBASIC_TYPE_STRING), AKBASIC_ERR_TYPE,
"%s expected a number", verb);
*dest = (value->valuetype == AKBASIC_TYPE_FLOAT)
? (int64_t)value->floatval : value->intval;
SUCCEED_RETURN(errctx);
}
/* --------------------------------------------------------- DOPEN / APPEND -- */
/** @brief Shared by DOPEN and APPEND, which differ only in the mode. */
static akerr_ErrorContext *open_file(akbasic_Runtime *obj, akbasic_ASTLeaf *expr, const char *verb, const char *mode)
{
PREPARE_ERROR(errctx);
akbasic_ASTLeaf *arg = NULL;
akbasic_Channel *channel = NULL;
char name[AKBASIC_MAX_STRING_LENGTH];
int64_t number = 0;
bool writing = (mode[0] != 'r');
arg = akbasic_leaf_first_argument(expr);
PASS(errctx, int_arg(obj, arg, verb, &number));
PASS(errctx, channel_slot(obj, number, &channel));
FAIL_NONZERO_RETURN(errctx, (channel->fp != NULL), AKBASIC_ERR_STATE,
"Channel %" PRId64 " is already open on \"%s\"", number, channel->name);
PASS(errctx, string_arg(obj, (arg != NULL ? arg->next : NULL), verb, name, sizeof(name)));
/*
* DOPEN's third argument is the C128's `W` for write. It arrives as a bare
* identifier, which is a label to this dialect and so cannot be evaluated --
* so what is read is the *leaf*, not its value.
*/
if ( arg != NULL && arg->next != NULL && arg->next->next != NULL ) {
akbasic_ASTLeaf *modeleaf = arg->next->next;
if ( modeleaf->leaftype == AKBASIC_LEAF_IDENTIFIER &&
(modeleaf->identifier[0] == 'W' || modeleaf->identifier[0] == 'w') ) {
mode = "w";
writing = true;
}
}
PASS(errctx, aksl_fopen(name, mode, &channel->fp));
snprintf(channel->name, sizeof(channel->name), "%s", name);
channel->writing = writing;
SUCCEED_RETURN(errctx);
}
akerr_ErrorContext *akbasic_cmd_dopen(akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest)
{
PREPARE_ERROR(errctx);
(void)lval; (void)rval;
FAIL_ZERO_RETURN(errctx, (obj != NULL && dest != NULL), AKERR_NULLPOINTER, "NULL argument in DOPEN");
PASS(errctx, open_file(obj, expr, "DOPEN", "r"));
SUCCEED_TRUE(obj, dest);
SUCCEED_RETURN(errctx);
}
akerr_ErrorContext *akbasic_cmd_append(akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest)
{
PREPARE_ERROR(errctx);
(void)lval; (void)rval;
FAIL_ZERO_RETURN(errctx, (obj != NULL && dest != NULL), AKERR_NULLPOINTER, "NULL argument in APPEND");
PASS(errctx, open_file(obj, expr, "APPEND", "a"));
SUCCEED_TRUE(obj, dest);
SUCCEED_RETURN(errctx);
}
akerr_ErrorContext *akbasic_cmd_dclose(akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest)
{
PREPARE_ERROR(errctx);
akbasic_ASTLeaf *arg = NULL;
akbasic_Channel *channel = NULL;
int64_t number = 0;
(void)lval; (void)rval;
FAIL_ZERO_RETURN(errctx, (obj != NULL && dest != NULL), AKERR_NULLPOINTER, "NULL argument in DCLOSE");
arg = akbasic_leaf_first_argument(expr);
if ( arg == NULL ) {
/* Bare DCLOSE closes everything, which is what a C128 does. */
PASS(errctx, akbasic_disk_close_all(&obj->disk_state));
SUCCEED_TRUE(obj, dest);
SUCCEED_RETURN(errctx);
}
PASS(errctx, int_arg(obj, arg, "DCLOSE", &number));
PASS(errctx, open_channel(obj, number, &channel));
PASS(errctx, aksl_fclose(channel->fp));
channel->fp = NULL;
channel->name[0] = '\0';
channel->writing = false;
SUCCEED_TRUE(obj, dest);
SUCCEED_RETURN(errctx);
}
/* ----------------------------------------------------------------- RECORD -- */
akerr_ErrorContext *akbasic_cmd_record(akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest)
{
PREPARE_ERROR(errctx);
akbasic_ASTLeaf *arg = NULL;
akbasic_Channel *channel = NULL;
int64_t number = 0;
int64_t record = 0;
int64_t offset = 1;
int64_t size = 0;
(void)lval; (void)rval;
FAIL_ZERO_RETURN(errctx, (obj != NULL && dest != NULL), AKERR_NULLPOINTER, "NULL argument in RECORD");
arg = akbasic_leaf_first_argument(expr);
PASS(errctx, int_arg(obj, arg, "RECORD", &number));
PASS(errctx, open_channel(obj, number, &channel));
PASS(errctx, int_arg(obj, (arg != NULL ? arg->next : NULL), "RECORD", &record));
if ( arg != NULL && arg->next != NULL && arg->next->next != NULL ) {
PASS(errctx, int_arg(obj, arg->next->next, "RECORD", &offset));
}
/*
* A C128's RECORD positions within a *relative* file, whose record length was
* fixed when the file was created. There is no such thing on a filesystem, so
* a record is taken to be a line: the file is rewound and read forward. That
* is slower than a seek and it is the only definition that does not require
* inventing a record length the file does not have. TODO.md section 5.
*/
FAIL_ZERO_RETURN(errctx, (record >= 1), AKBASIC_ERR_VALUE,
"RECORD numbers records from 1, not %" PRId64, record);
PASS(errctx, aksl_fseek(channel->fp, 0, SEEK_SET));
for ( size = 1; size < record; size++ ) {
char line[AKBASIC_MAX_STRING_LENGTH];
size_t length = 0;
akerr_ErrorContext *got = aksl_fgets(line, sizeof(line), channel->fp, &length);
if ( got != NULL ) {
got->handled = true;
IGNORE(akerr_release_error(got));
break;
}
}
if ( offset > 1 ) {
PASS(errctx, aksl_fseek(channel->fp, (long)(offset - 1), SEEK_CUR));
}
SUCCEED_TRUE(obj, dest);
SUCCEED_RETURN(errctx);
}
/* -------------------------------------------------------- file management -- */
akerr_ErrorContext *akbasic_cmd_scratch(akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest)
{
PREPARE_ERROR(errctx);
char name[AKBASIC_MAX_STRING_LENGTH];
(void)lval; (void)rval;
FAIL_ZERO_RETURN(errctx, (obj != NULL && dest != NULL), AKERR_NULLPOINTER, "NULL argument in SCRATCH");
PASS(errctx, string_arg(obj, akbasic_leaf_first_argument(expr), "SCRATCH", name, sizeof(name)));
FAIL_ZERO_RETURN(errctx, (remove(name) == 0), AKERR_IO,
"SCRATCH could not delete \"%s\"", name);
SUCCEED_TRUE(obj, dest);
SUCCEED_RETURN(errctx);
}
akerr_ErrorContext *akbasic_cmd_rename(akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest)
{
PREPARE_ERROR(errctx);
akbasic_ASTLeaf *arg = NULL;
char from[AKBASIC_MAX_STRING_LENGTH];
char to[AKBASIC_MAX_STRING_LENGTH];
(void)lval; (void)rval;
FAIL_ZERO_RETURN(errctx, (obj != NULL && dest != NULL), AKERR_NULLPOINTER, "NULL argument in RENAME");
arg = akbasic_leaf_first_argument(expr);
PASS(errctx, string_arg(obj, arg, "RENAME", from, sizeof(from)));
PASS(errctx, string_arg(obj, (arg != NULL ? arg->next : NULL), "RENAME", to, sizeof(to)));
FAIL_ZERO_RETURN(errctx, (rename(from, to) == 0), AKERR_IO,
"RENAME could not rename \"%s\" to \"%s\"", from, to);
SUCCEED_TRUE(obj, dest);
SUCCEED_RETURN(errctx);
}
/** @brief Shared by COPY and CONCAT, which differ only in the destination mode. */
static akerr_ErrorContext *copy_file(akbasic_Runtime *obj, akbasic_ASTLeaf *expr, const char *verb, const char *mode)
{
PREPARE_ERROR(errctx);
akbasic_ASTLeaf *arg = NULL;
FILE *in = NULL;
FILE *out = NULL;
char from[AKBASIC_MAX_STRING_LENGTH];
char to[AKBASIC_MAX_STRING_LENGTH];
char buffer[4096];
arg = akbasic_leaf_first_argument(expr);
PASS(errctx, string_arg(obj, arg, verb, from, sizeof(from)));
PASS(errctx, string_arg(obj, (arg != NULL ? arg->next : NULL), verb, to, sizeof(to)));
PASS(errctx, aksl_fopen(from, "rb", &in));
ATTEMPT {
CATCH(errctx, aksl_fopen(to, mode, &out));
for ( ;; ) {
size_t got = 0;
size_t put = 0;
bool done = false;
akerr_ErrorContext *read = aksl_fread(buffer, 1, sizeof(buffer), in, &got);
if ( read != NULL ) {
/*
* A short read is how a file *ends*: aksl_fread reports fewer
* items than asked for as an error, and `got` still holds what
* it managed. Writing that out before stopping is the whole
* copy for any file smaller than the buffer -- the first
* version broke here and produced an empty destination every
* time.
*/
read->handled = true;
IGNORE(akerr_release_error(read));
done = true;
}
if ( got > 0 ) {
/*
* PASS rather than CATCH: this is a loop, and CATCH expands to
* a break that would leave the rest of the ATTEMPT running with
* an error pending.
*/
PASS(errctx, aksl_fwrite(buffer, 1, got, out, &put));
}
if ( done || got == 0 ) {
break;
}
}
} CLEANUP {
IGNORE(aksl_fclose(in));
if ( out != NULL ) {
IGNORE(aksl_fclose(out));
}
} PROCESS(errctx) {
} FINISH(errctx, true);
SUCCEED_RETURN(errctx);
}
akerr_ErrorContext *akbasic_cmd_copy(akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest)
{
PREPARE_ERROR(errctx);
(void)lval; (void)rval;
FAIL_ZERO_RETURN(errctx, (obj != NULL && dest != NULL), AKERR_NULLPOINTER, "NULL argument in COPY");
PASS(errctx, copy_file(obj, expr, "COPY", "wb"));
SUCCEED_TRUE(obj, dest);
SUCCEED_RETURN(errctx);
}
akerr_ErrorContext *akbasic_cmd_concat(akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest)
{
PREPARE_ERROR(errctx);
(void)lval; (void)rval;
FAIL_ZERO_RETURN(errctx, (obj != NULL && dest != NULL), AKERR_NULLPOINTER, "NULL argument in CONCAT");
/* Appends rather than replaces, which is the whole difference from COPY. */
PASS(errctx, copy_file(obj, expr, "CONCAT", "ab"));
SUCCEED_TRUE(obj, dest);
SUCCEED_RETURN(errctx);
}
/* -------------------------------------------------------------- DIRECTORY -- */
akerr_ErrorContext *akbasic_cmd_directory(akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest)
{
PREPARE_ERROR(errctx);
(void)expr; (void)lval; (void)rval;
FAIL_ZERO_RETURN(errctx, (obj != NULL && dest != NULL), AKERR_NULLPOINTER,
"NULL argument in DIRECTORY");
/*
* Refused rather than half-built. Listing a directory needs opendir/readdir,
* which `libakstdlib` does not wrap -- and this project's rule is that a
* missing capability gets filed upstream rather than worked around here
* (CLAUDE.md). Filed in deps/libakstdlib/TODO.md.
*
* The alternative was shelling out to `ls`, which a library has no business
* doing, or calling readdir directly and stepping outside the error
* convention every other call in this file follows.
*/
FAIL_RETURN(errctx, AKBASIC_ERR_DEVICE,
"DIRECTORY is not implemented: libakstdlib has no directory-reading wrapper yet");
}
/* ------------------------------------------------------------ BSAVE/BLOAD -- */
akerr_ErrorContext *akbasic_cmd_bsave(akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest)
{
PREPARE_ERROR(errctx);
akbasic_ASTLeaf *arg = NULL;
FILE *fp = NULL;
char name[AKBASIC_MAX_STRING_LENGTH];
int64_t from = 0;
int64_t to = 0;
size_t put = 0;
(void)lval; (void)rval;
FAIL_ZERO_RETURN(errctx, (obj != NULL && dest != NULL), AKERR_NULLPOINTER, "NULL argument in BSAVE");
arg = akbasic_leaf_first_argument(expr);
PASS(errctx, string_arg(obj, arg, "BSAVE", name, sizeof(name)));
PASS(errctx, int_arg(obj, (arg != NULL ? arg->next : NULL), "BSAVE", &from));
PASS(errctx, int_arg(obj, (arg != NULL && arg->next != NULL ? arg->next->next : NULL),
"BSAVE", &to));
FAIL_ZERO_RETURN(errctx, (from != 0 && to > from), AKBASIC_ERR_VALUE,
"BSAVE needs a start address and a higher end address");
PASS(errctx, aksl_fopen(name, "wb", &fp));
ATTEMPT {
CATCH(errctx, aksl_fwrite((const void *)(uintptr_t)from, 1, (size_t)(to - from), fp, &put));
} CLEANUP {
IGNORE(aksl_fclose(fp));
} PROCESS(errctx) {
} FINISH(errctx, true);
SUCCEED_TRUE(obj, dest);
SUCCEED_RETURN(errctx);
}
akerr_ErrorContext *akbasic_cmd_bload(akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest)
{
PREPARE_ERROR(errctx);
akbasic_ASTLeaf *arg = NULL;
FILE *fp = NULL;
char name[AKBASIC_MAX_STRING_LENGTH];
int64_t at = 0;
int64_t limit = 0;
size_t got = 0;
(void)lval; (void)rval;
FAIL_ZERO_RETURN(errctx, (obj != NULL && dest != NULL), AKERR_NULLPOINTER, "NULL argument in BLOAD");
arg = akbasic_leaf_first_argument(expr);
PASS(errctx, string_arg(obj, arg, "BLOAD", name, sizeof(name)));
PASS(errctx, int_arg(obj, (arg != NULL ? arg->next : NULL), "BLOAD", &at));
/*
* The length is required, unlike a C128's BLOAD which reads until the file
* ends. A file longer than the caller expected would otherwise write past
* whatever it was pointed at, and there is no way to notice: a BASIC integer
* here is a real address. Refusing to guess is the only safe answer -- and
* checked before it is read, so a missing one says *that* rather than
* "expected a number".
*/
FAIL_ZERO_RETURN(errctx,
(arg != NULL && arg->next != NULL && arg->next->next != NULL),
AKBASIC_ERR_SYNTAX,
"BLOAD needs an address and a maximum length");
PASS(errctx, int_arg(obj, arg->next->next, "BLOAD", &limit));
FAIL_ZERO_RETURN(errctx, (at != 0 && limit > 0), AKBASIC_ERR_VALUE,
"BLOAD needs an address and a maximum length");
PASS(errctx, aksl_fopen(name, "rb", &fp));
ATTEMPT {
akerr_ErrorContext *read = aksl_fread((void *)(uintptr_t)at, 1, (size_t)limit, fp, &got);
if ( read != NULL ) {
/* A short read is the ordinary case: the file was smaller than the cap. */
read->handled = true;
IGNORE(akerr_release_error(read));
}
} CLEANUP {
IGNORE(aksl_fclose(fp));
} PROCESS(errctx) {
} FINISH(errctx, true);
SUCCEED_TRUE(obj, dest);
SUCCEED_RETURN(errctx);
}
/* ------------------------------------------------------------ channel I/O -- */
akerr_ErrorContext *akbasic_disk_write(akbasic_Runtime *obj, int64_t number, const char *text)
{
PREPARE_ERROR(errctx);
akbasic_Channel *channel = NULL;
size_t put = 0;
FAIL_ZERO_RETURN(errctx, (obj != NULL && text != NULL), AKERR_NULLPOINTER,
"NULL argument in disk_write");
PASS(errctx, open_channel(obj, number, &channel));
FAIL_ZERO_RETURN(errctx, channel->writing, AKBASIC_ERR_STATE,
"Channel %" PRId64 " was opened for reading", number);
PASS(errctx, aksl_fwrite(text, 1, strlen(text), channel->fp, &put));
PASS(errctx, aksl_fwrite("\n", 1, 1, channel->fp, &put));
SUCCEED_RETURN(errctx);
}
akerr_ErrorContext *akbasic_disk_readline(akbasic_Runtime *obj, int64_t number, char *dest, size_t len, bool *eof)
{
PREPARE_ERROR(errctx);
akbasic_Channel *channel = NULL;
akerr_ErrorContext *got = NULL;
char *newline = NULL;
size_t length = 0;
FAIL_ZERO_RETURN(errctx, (obj != NULL && dest != NULL && eof != NULL), AKERR_NULLPOINTER,
"NULL argument in disk_readline");
PASS(errctx, open_channel(obj, number, &channel));
FAIL_NONZERO_RETURN(errctx, channel->writing, AKBASIC_ERR_STATE,
"Channel %" PRId64 " was opened for writing", number);
*eof = false;
dest[0] = '\0';
got = aksl_fgets(dest, len, channel->fp, &length);
if ( got != NULL ) {
/*
* End of file is not an error here, the same way it is not one for the
* sink's readline: running out of input is a state a program handles.
*/
got->handled = true;
IGNORE(akerr_release_error(got));
*eof = true;
SUCCEED_RETURN(errctx);
}
newline = strchr(dest, '\n');
if ( newline != NULL ) {
*newline = '\0';
}
SUCCEED_RETURN(errctx);
}
akerr_ErrorContext *akbasic_cmd_print_channel(akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest)
{
PREPARE_ERROR(errctx);
akbasic_ASTLeaf *arg = NULL;
akbasic_Value *value = NULL;
char text[AKBASIC_MAX_STRING_LENGTH];
int64_t number = 0;
(void)lval; (void)rval;
FAIL_ZERO_RETURN(errctx, (obj != NULL && dest != NULL), AKERR_NULLPOINTER,
"NULL argument in PRINT#");
arg = akbasic_leaf_first_argument(expr);
PASS(errctx, int_arg(obj, arg, "PRINT#", &number));
FAIL_ZERO_RETURN(errctx, (arg != NULL && arg->next != NULL), AKBASIC_ERR_SYNTAX,
"Expected PRINT #(channel), (expression)");
PASS(errctx, akbasic_runtime_evaluate(obj, arg->next, &value));
PASS(errctx, akbasic_value_to_string(value, text, sizeof(text)));
PASS(errctx, akbasic_disk_write(obj, number, text));
SUCCEED_TRUE(obj, dest);
SUCCEED_RETURN(errctx);
}
akerr_ErrorContext *akbasic_cmd_input_channel(akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest)
{
PREPARE_ERROR(errctx);
akbasic_ASTLeaf *arg = NULL;
akbasic_ASTLeaf *identifier = NULL;
akbasic_ASTLeaf literal;
akbasic_ASTLeaf assign;
akbasic_Value *unused = NULL;
char text[AKBASIC_MAX_STRING_LENGTH];
int64_t number = 0;
bool eof = false;
(void)lval; (void)rval;
FAIL_ZERO_RETURN(errctx, (obj != NULL && dest != NULL), AKERR_NULLPOINTER,
"NULL argument in INPUT#");
arg = akbasic_leaf_first_argument(expr);
PASS(errctx, int_arg(obj, arg, "INPUT#", &number));
identifier = (arg != NULL ? arg->next : NULL);
FAIL_ZERO_RETURN(errctx, akbasic_leaf_is_identifier(identifier), AKBASIC_ERR_SYNTAX,
"Expected INPUT #(channel), (variable)");
PASS(errctx, akbasic_disk_readline(obj, number, text, sizeof(text), &eof));
/*
* End of file leaves the variable empty rather than raising. A program reads
* until it gets nothing back, which is what it can check -- and a numeric
* variable reading an empty line gets zero, the same as a C128.
*/
PASS(errctx, akbasic_leaf_init(&literal, AKBASIC_LEAF_LITERAL_STRING));
snprintf(literal.literal_string, sizeof(literal.literal_string), "%s", text);
if ( akbasic_leaf_identifier_type(identifier) == AKBASIC_TYPE_INTEGER ) {
long long converted = 0;
literal.leaftype = AKBASIC_LEAF_LITERAL_INT;
literal.literal_int = 0;
if ( !eof && text[0] != '\0' ) {
PASS(errctx, aksl_atoll(text, &converted));
literal.literal_int = (int64_t)converted;
}
} else if ( akbasic_leaf_identifier_type(identifier) == AKBASIC_TYPE_FLOAT ) {
literal.leaftype = AKBASIC_LEAF_LITERAL_FLOAT;
literal.literal_float = 0.0;
if ( !eof && text[0] != '\0' ) {
PASS(errctx, aksl_atof(text, &literal.literal_float));
}
}
PASS(errctx, akbasic_leaf_init(&assign, AKBASIC_LEAF_BINARY));
assign.left = identifier;
assign.right = &literal;
assign.operator_ = AKBASIC_TOK_ASSIGNMENT;
PASS(errctx, akbasic_runtime_evaluate(obj, &assign, &unused));
SUCCEED_TRUE(obj, dest);
SUCCEED_RETURN(errctx);
}
/* ---------------------------------------------------------------- VERIFY -- */
akerr_ErrorContext *akbasic_cmd_dverify(akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest)
{
PREPARE_ERROR(errctx);
FILE *fp = NULL;
char name[AKBASIC_MAX_STRING_LENGTH];
char line[AKBASIC_MAX_LINE_LENGTH];
int64_t lineno = 0;
int64_t mismatch = 0;
(void)lval; (void)rval;
FAIL_ZERO_RETURN(errctx, (obj != NULL && dest != NULL), AKERR_NULLPOINTER,
"NULL argument in VERIFY");
PASS(errctx, string_arg(obj, akbasic_leaf_first_argument(expr), "VERIFY", name, sizeof(name)));
/*
* A C128 verifies the program in memory against the one on disk byte for
* byte, because a 1541 write could fail silently. Here the comparison is
* line by line against the file's text, which is the same question asked of
* a filesystem: is what I would save what is already there?
*/
PASS(errctx, aksl_fopen(name, "r", &fp));
ATTEMPT {
for ( lineno = 0; lineno < AKBASIC_MAX_SOURCE_LINES; lineno++ ) {
size_t length = 0;
akerr_ErrorContext *got = NULL;
char *newline = NULL;
if ( obj->source[lineno].code[0] == '\0' ) {
continue;
}
got = aksl_fgets(line, sizeof(line), fp, &length);
if ( got != NULL ) {
got->handled = true;
IGNORE(akerr_release_error(got));
mismatch += 1;
break;
}
newline = strchr(line, '\n');
if ( newline != NULL ) {
*newline = '\0';
}
/*
* The stored line has had its number stripped, so the file's copy is
* compared from past its own number. PASS rather than CATCH: this is
* a loop.
*/
{
const char *filetext = line;
while ( *filetext == ' ' ) {
filetext += 1;
}
while ( *filetext >= '0' && *filetext <= '9' ) {
filetext += 1;
}
while ( *filetext == ' ' ) {
filetext += 1;
}
if ( strcmp(filetext, obj->source[lineno].code) != 0 ) {
mismatch += 1;
}
}
}
} CLEANUP {
IGNORE(aksl_fclose(fp));
} PROCESS(errctx) {
} FINISH(errctx, true);
FAIL_NONZERO_RETURN(errctx, (mismatch != 0), AKBASIC_ERR_VALUE,
"VERIFY: \"%s\" does not match the program in memory (%" PRId64 " lines differ)",
name, mismatch);
PASS(errctx, akbasic_runtime_println(obj, "OK"));
SUCCEED_TRUE(obj, dest);
SUCCEED_RETURN(errctx);
}
/* --------------------------------------------------- needs a real 1541 --- */
/**
* @brief Refuse a verb that has no meaning without the drive, and say why.
*
* Five of them, and the reasoning is the same each time: formatting a disk,
* validating one, duplicating one, resetting a drive and booting from one are
* operations on a physical device. A filesystem has no equivalent that is not a
* lie -- `HEADER` would have to mean "delete everything in this directory",
* which is a spectacularly bad thing to do to somebody who typed a C128 verb.
*/
static akerr_ErrorContext *no_drive(const char *verb, const char *what)
{
PREPARE_ERROR(errctx);
FAIL_RETURN(errctx, AKBASIC_ERR_DEVICE,
"%s %s, and there is no disk drive here -- only a filesystem", verb, what);
}
akerr_ErrorContext *akbasic_cmd_header(akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest)
{
PREPARE_ERROR(errctx);
(void)obj; (void)expr; (void)lval; (void)rval; (void)dest;
PASS(errctx, no_drive("HEADER", "formats a disk"));
SUCCEED_RETURN(errctx);
}
akerr_ErrorContext *akbasic_cmd_collect(akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest)
{
PREPARE_ERROR(errctx);
(void)obj; (void)expr; (void)lval; (void)rval; (void)dest;
PASS(errctx, no_drive("COLLECT", "validates a disk's block allocation map"));
SUCCEED_RETURN(errctx);
}
akerr_ErrorContext *akbasic_cmd_backup(akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest)
{
PREPARE_ERROR(errctx);
(void)obj; (void)expr; (void)lval; (void)rval; (void)dest;
PASS(errctx, no_drive("BACKUP", "duplicates one disk onto another"));
SUCCEED_RETURN(errctx);
}
akerr_ErrorContext *akbasic_cmd_boot(akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest)
{
PREPARE_ERROR(errctx);
(void)obj; (void)expr; (void)lval; (void)rval; (void)dest;
PASS(errctx, no_drive("BOOT", "loads and runs a boot sector"));
SUCCEED_RETURN(errctx);
}
akerr_ErrorContext *akbasic_cmd_dclear(akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest)
{
PREPARE_ERROR(errctx);
(void)expr; (void)lval; (void)rval;
FAIL_ZERO_RETURN(errctx, (obj != NULL && dest != NULL), AKERR_NULLPOINTER, "NULL argument in DCLEAR");
/*
* The one of the five with a defensible meaning. DCLEAR resets the drive and
* closes every channel it had open; the second half is exactly
* akbasic_disk_close_all(), so that is what it does. The first half has
* nothing to reset.
*/
PASS(errctx, akbasic_disk_close_all(&obj->disk_state));
SUCCEED_TRUE(obj, dest);
SUCCEED_RETURN(errctx);
}

121
src/runtime_format.c Normal file
View File

@@ -0,0 +1,121 @@
/**
* @file runtime_format.c
* @brief The group D verbs: PRINT USING, PUDEF, WIDTH and CHAR.
*
* Formatting and text placement. The field rendering itself lives in
* src/format.c, which is a pure function of a format string and a value and is
* tested as one; what is here is the verbs that reach it.
*/
#include <inttypes.h>
#include <stdio.h>
#include <string.h>
#include <akerror.h>
#include <akbasic/args.h>
#include <akbasic/error.h>
#include <akbasic/runtime.h>
#include "verbs.h"
/* Most verbs answer "did something happen"; this is that answer. */
#define SUCCEED_TRUE(__obj, __dest) \
do { \
*(__dest) = &(__obj)->staticTrueValue; \
} while ( 0 )
/* ------------------------------------------------------------------ PUDEF -- */
akerr_ErrorContext *akbasic_cmd_pudef(akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest)
{
PREPARE_ERROR(errctx);
akbasic_Value *value = NULL;
(void)lval; (void)rval;
FAIL_ZERO_RETURN(errctx, (obj != NULL && dest != NULL), AKERR_NULLPOINTER,
"NULL argument in PUDEF");
FAIL_ZERO_RETURN(errctx, (expr != NULL && expr->right != NULL), AKBASIC_ERR_SYNTAX,
"Expected PUDEF \"characters\"");
PASS(errctx, akbasic_runtime_evaluate(obj, expr->right, &value));
FAIL_NONZERO_RETURN(errctx, (value->valuetype != AKBASIC_TYPE_STRING), AKBASIC_ERR_TYPE,
"PUDEF expected a string");
/*
* No device needed. The fill characters are the program's state, the same
* way COLOR's source bindings are, and a runtime with no output device is
* still entitled to remember what it was told.
*/
PASS(errctx, akbasic_format_pudef(&obj->format_state, value->stringval));
SUCCEED_TRUE(obj, dest);
SUCCEED_RETURN(errctx);
}
/* ------------------------------------------------------------------ WIDTH -- */
akerr_ErrorContext *akbasic_cmd_width(akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest)
{
PREPARE_ERROR(errctx);
double args[1];
int count = 0;
(void)lval; (void)rval;
FAIL_ZERO_RETURN(errctx, (obj != NULL && dest != NULL), AKERR_NULLPOINTER,
"NULL argument in WIDTH");
PASS(errctx, akbasic_args_numbers(obj, expr, "WIDTH", args, 1, &count));
FAIL_ZERO_RETURN(errctx, (count == 1), AKBASIC_ERR_SYNTAX, "Expected WIDTH (1 or 2)");
/*
* BASIC 7.0's WIDTH sets the thickness of the lines the *graphics* verbs
* draw, not a text column count -- a common confusion, and the reason this
* verb lives with the drawing state rather than with PRINT.
*/
FAIL_ZERO_RETURN(errctx, (args[0] == 1.0 || args[0] == 2.0), AKBASIC_ERR_BOUNDS,
"WIDTH is 1 or 2, not %d", (int)args[0]);
obj->gfx.linewidth = (int)args[0];
SUCCEED_TRUE(obj, dest);
SUCCEED_RETURN(errctx);
}
/* ------------------------------------------------------------------- CHAR -- */
akerr_ErrorContext *akbasic_cmd_char(akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest)
{
PREPARE_ERROR(errctx);
akbasic_ASTLeaf *arg = NULL;
akbasic_Value *value = NULL;
char text[AKBASIC_MAX_STRING_LENGTH];
double coords[3];
int count = 0;
(void)lval; (void)rval;
FAIL_ZERO_RETURN(errctx, (obj != NULL && dest != NULL), AKERR_NULLPOINTER,
"NULL argument in CHAR");
FAIL_ZERO_RETURN(errctx, (obj->sink != NULL), AKBASIC_ERR_DEVICE,
"CHAR needs a text device and this runtime has none");
FAIL_ZERO_RETURN(errctx, (obj->sink->moveto != NULL), AKBASIC_ERR_DEVICE,
"CHAR needs a text device that can position its cursor, and this one cannot");
/*
* CHAR colour, column, row, "text". The colour argument is accepted and
* ignored: this interpreter's text sink draws in one colour, chosen by the
* host when it built the sink, and a per-call colour would have to become
* part of the sink interface. Recorded in TODO.md section 5.
*/
arg = akbasic_leaf_first_argument(expr);
for ( count = 0; count < 3 && arg != NULL; count++, arg = arg->next ) {
PASS(errctx, akbasic_runtime_evaluate(obj, arg, &value));
FAIL_NONZERO_RETURN(errctx, (value->valuetype == AKBASIC_TYPE_STRING), AKBASIC_ERR_TYPE,
"CHAR expected a number in argument %d", count + 1);
coords[count] = (value->valuetype == AKBASIC_TYPE_FLOAT)
? value->floatval : (double)value->intval;
}
FAIL_ZERO_RETURN(errctx, (count == 3 && arg != NULL), AKBASIC_ERR_SYNTAX,
"Expected CHAR (colour), (column), (row), (string)");
PASS(errctx, akbasic_runtime_evaluate(obj, arg, &value));
PASS(errctx, akbasic_value_to_string(value, text, sizeof(text)));
PASS(errctx, obj->sink->moveto(obj->sink, (int)coords[1], (int)coords[2]));
PASS(errctx, obj->sink->write(obj->sink, text));
SUCCEED_TRUE(obj, dest);
SUCCEED_RETURN(errctx);
}

118
src/runtime_graphics.c
View File

@@ -20,6 +20,7 @@
#include <akerror.h>
#include <akstdlib.h>
#include <akbasic/args.h>
#include <akbasic/error.h>
#include <akbasic/runtime.h>
@@ -56,54 +57,6 @@ static akerr_ErrorContext *require_graphics(akbasic_Runtime *obj, const char *ve
SUCCEED_RETURN(errctx);
}
/**
* @brief Collect a verb's arguments into an array, evaluating each one.
*
* The graphics verbs all take a short positional list with optional trailing
* members, so every handler wants the same thing: how many arguments arrived,
* and their numeric values. Strings are refused here rather than in each verb --
* SSHAPE and GSHAPE, which do take one, read their leaf directly instead.
*
* @param obj Runtime to evaluate against.
* @param expr The command leaf.
* @param verb Name to use in a diagnostic.
* @param values Where to put the evaluated arguments.
* @param max Capacity of `values`.
* @param count Output destination populated by the function.
*/
static akerr_ErrorContext *collect_numbers(akbasic_Runtime *obj, akbasic_ASTLeaf *expr, const char *verb, double *values, int max, int *count)
{
PREPARE_ERROR(errctx);
akbasic_ASTLeaf *arg = NULL;
akbasic_Value *value = NULL;
FAIL_ZERO_RETURN(errctx, (obj != NULL && expr != NULL && values != NULL && count != NULL),
AKERR_NULLPOINTER, "NULL argument in collect_numbers");
*count = 0;
arg = akbasic_leaf_first_argument(expr);
/*
* A loop, so CATCH and the _BREAK macros are banned in here -- they expand to
* a C break and would leave the loop with an error still pending. PASS and
* the _RETURN forms only.
*/
while ( arg != NULL ) {
FAIL_NONZERO_RETURN(errctx, (*count >= max), AKBASIC_ERR_SYNTAX,
"%s takes at most %d arguments", verb, max);
PASS(errctx, akbasic_runtime_evaluate(obj, arg, &value));
FAIL_NONZERO_RETURN(errctx, (value->valuetype == AKBASIC_TYPE_STRING),
AKBASIC_ERR_TYPE,
"%s expected a number in argument %d", verb, *count + 1);
if ( value->valuetype == AKBASIC_TYPE_FLOAT ) {
values[*count] = value->floatval;
} else {
values[*count] = (double)value->intval;
}
*count += 1;
arg = arg->next;
}
SUCCEED_RETURN(errctx);
}
/**
* @brief Map a user coordinate onto the 320x200 space the backend receives.
*
@@ -123,6 +76,47 @@ static void scale_point(akbasic_GraphicsState *gfx, double *x, double *y)
}
}
/**
* @brief Draw a line `WIDTH` pixels thick.
*
* BASIC 7.0's `WIDTH` sets the thickness of the lines the graphics verbs draw,
* and the backend record has no thickness argument -- neither does libakgl's
* akgl_draw_line, which is what it would have to reach. So a thick line is drawn
* as parallel passes, offset perpendicular to whichever axis the line runs along.
* That is what a C128 does in effect and it needs nothing new from the device.
*
* Approximate for a diagonal, where offsetting along one axis leaves the passes a
* fraction under a pixel apart. At WIDTH 2 -- the only other value the verb
* accepts -- that is not visible; a general thickness would want a real
* perpendicular offset and an API that takes one.
*/
static akerr_ErrorContext *draw_line(akbasic_Runtime *obj, double x1, double y1, double x2, double y2, akbasic_Color color)
{
PREPARE_ERROR(errctx);
double dx = (x2 > x1 ? x2 - x1 : x1 - x2);
double dy = (y2 > y1 ? y2 - y1 : y1 - y2);
bool steep = (dy > dx);
int pass = 0;
int width = (obj->gfx.linewidth > 0 ? obj->gfx.linewidth : 1);
/*
* A loop, so CATCH and the _BREAK macros are banned in here -- they expand
* to a C break and would leave the loop with an error still pending.
*/
for ( pass = 0; pass < width; pass++ ) {
double offset = (double)pass;
if ( steep ) {
PASS(errctx, obj->graphics->line(obj->graphics, x1 + offset, y1,
x2 + offset, y2, color));
} else {
PASS(errctx, obj->graphics->line(obj->graphics, x1, y1 + offset,
x2, y2 + offset, color));
}
}
SUCCEED_RETURN(errctx);
}
/* ------------------------------------------------------------- GRAPHIC --- */
akerr_ErrorContext *akbasic_cmd_graphic(akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest)
@@ -135,7 +129,7 @@ akerr_ErrorContext *akbasic_cmd_graphic(akbasic_Runtime *obj, akbasic_ASTLeaf *e
(void)lval; (void)rval;
PASS(errctx, require_graphics(obj, "GRAPHIC"));
PASS(errctx, collect_numbers(obj, expr, "GRAPHIC", args, 2, &count));
PASS(errctx, akbasic_args_numbers(obj, expr, "GRAPHIC", args, 2, &count));
FAIL_ZERO_RETURN(errctx, (count >= 1), AKBASIC_ERR_SYNTAX, "GRAPHIC expected a mode");
mode = (int)args[0];
@@ -186,7 +180,7 @@ akerr_ErrorContext *akbasic_cmd_color(akbasic_Runtime *obj, akbasic_ASTLeaf *exp
* colors up before the host has lent it a renderer.
*/
FAIL_ZERO_RETURN(errctx, (obj != NULL), AKERR_NULLPOINTER, "NULL runtime in COLOR");
PASS(errctx, collect_numbers(obj, expr, "COLOR", args, 2, &count));
PASS(errctx, akbasic_args_numbers(obj, expr, "COLOR", args, 2, &count));
FAIL_ZERO_RETURN(errctx, (count == 2), AKBASIC_ERR_SYNTAX,
"COLOR expected a source and a color");
@@ -212,7 +206,7 @@ akerr_ErrorContext *akbasic_cmd_locate(akbasic_Runtime *obj, akbasic_ASTLeaf *ex
(void)lval; (void)rval;
FAIL_ZERO_RETURN(errctx, (obj != NULL), AKERR_NULLPOINTER, "NULL runtime in LOCATE");
PASS(errctx, collect_numbers(obj, expr, "LOCATE", args, 2, &count));
PASS(errctx, akbasic_args_numbers(obj, expr, "LOCATE", args, 2, &count));
FAIL_ZERO_RETURN(errctx, (count == 2), AKBASIC_ERR_SYNTAX, "LOCATE expected X, Y");
/*
@@ -236,7 +230,7 @@ akerr_ErrorContext *akbasic_cmd_scale(akbasic_Runtime *obj, akbasic_ASTLeaf *exp
(void)lval; (void)rval;
FAIL_ZERO_RETURN(errctx, (obj != NULL), AKERR_NULLPOINTER, "NULL runtime in SCALE");
PASS(errctx, collect_numbers(obj, expr, "SCALE", args, 3, &count));
PASS(errctx, akbasic_args_numbers(obj, expr, "SCALE", args, 3, &count));
FAIL_ZERO_RETURN(errctx, (count >= 1), AKBASIC_ERR_SYNTAX, "SCALE expected 0 or 1");
/* Pure coordinate arithmetic -- nothing reaches the device. */
@@ -271,7 +265,7 @@ akerr_ErrorContext *akbasic_cmd_draw(akbasic_Runtime *obj, akbasic_ASTLeaf *expr
(void)lval; (void)rval;
PASS(errctx, require_graphics(obj, "DRAW"));
PASS(errctx, collect_numbers(obj, expr, "DRAW", args, 32, &count));
PASS(errctx, akbasic_args_numbers(obj, expr, "DRAW", args, 32, &count));
FAIL_ZERO_RETURN(errctx, (count >= 1), AKBASIC_ERR_SYNTAX,
"DRAW expected a color source");
FAIL_NONZERO_RETURN(errctx, (count > 1 && (count % 2) == 0), AKBASIC_ERR_SYNTAX,
@@ -308,7 +302,7 @@ akerr_ErrorContext *akbasic_cmd_draw(akbasic_Runtime *obj, akbasic_ASTLeaf *expr
y = args[i + 3];
scale_point(&obj->gfx, &px, &py);
scale_point(&obj->gfx, &x, &y);
PASS(errctx, obj->graphics->line(obj->graphics, px, py, x, y, color));
PASS(errctx, draw_line(obj, px, py, x, y, color));
}
obj->gfx.x = args[count - 2];
obj->gfx.y = args[count - 1];
@@ -340,7 +334,7 @@ akerr_ErrorContext *akbasic_cmd_box(akbasic_Runtime *obj, akbasic_ASTLeaf *expr,
(void)lval; (void)rval;
PASS(errctx, require_graphics(obj, "BOX"));
PASS(errctx, collect_numbers(obj, expr, "BOX", args, 6, &count));
PASS(errctx, akbasic_args_numbers(obj, expr, "BOX", args, 6, &count));
FAIL_ZERO_RETURN(errctx, (count >= 3), AKBASIC_ERR_SYNTAX,
"BOX expected a color source and at least one corner");
PASS(errctx, akbasic_graphics_source_color(&obj->gfx, (int)args[0], &color));
@@ -389,10 +383,8 @@ akerr_ErrorContext *akbasic_cmd_box(akbasic_Runtime *obj, akbasic_ASTLeaf *expr,
ys[corner] = cy + (ox * sin(radians)) + (oy * cos(radians));
}
for ( corner = 0; corner < 4; corner++ ) {
PASS(errctx, obj->graphics->line(obj->graphics,
xs[corner], ys[corner],
xs[(corner + 1) % 4], ys[(corner + 1) % 4],
color));
PASS(errctx, draw_line(obj, xs[corner], ys[corner],
xs[(corner + 1) % 4], ys[(corner + 1) % 4], color));
}
SUCCEED_TRUE(obj, dest);
SUCCEED_RETURN(errctx);
@@ -423,7 +415,7 @@ akerr_ErrorContext *akbasic_cmd_circle(akbasic_Runtime *obj, akbasic_ASTLeaf *ex
(void)lval; (void)rval;
PASS(errctx, require_graphics(obj, "CIRCLE"));
PASS(errctx, collect_numbers(obj, expr, "CIRCLE", args, 9, &count));
PASS(errctx, akbasic_args_numbers(obj, expr, "CIRCLE", args, 9, &count));
FAIL_ZERO_RETURN(errctx, (count >= 4), AKBASIC_ERR_SYNTAX,
"CIRCLE expected a color source, a center and a radius");
PASS(errctx, akbasic_graphics_source_color(&obj->gfx, (int)args[0], &color));
@@ -464,7 +456,7 @@ akerr_ErrorContext *akbasic_cmd_circle(akbasic_Runtime *obj, akbasic_ASTLeaf *ex
y = cy + (ox * sin(rot)) + (oy * cos(rot));
scale_point(&obj->gfx, &x, &y);
if ( !first ) {
PASS(errctx, obj->graphics->line(obj->graphics, px, py, x, y, color));
PASS(errctx, draw_line(obj, px, py, x, y, color));
}
first = false;
px = x;
@@ -493,7 +485,7 @@ akerr_ErrorContext *akbasic_cmd_paint(akbasic_Runtime *obj, akbasic_ASTLeaf *exp
(void)lval; (void)rval;
PASS(errctx, require_graphics(obj, "PAINT"));
PASS(errctx, collect_numbers(obj, expr, "PAINT", args, 4, &count));
PASS(errctx, akbasic_args_numbers(obj, expr, "PAINT", args, 4, &count));
FAIL_ZERO_RETURN(errctx, (count >= 3), AKBASIC_ERR_SYNTAX,
"PAINT expected a color source and a coordinate");
PASS(errctx, akbasic_graphics_source_color(&obj->gfx, (int)args[0], &color));
@@ -540,7 +532,7 @@ akerr_ErrorContext *akbasic_cmd_paint(akbasic_Runtime *obj, akbasic_ASTLeaf *exp
*
* 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
* of going through collect_numbers().
* of going through akbasic_args_numbers().
*/
static akerr_ErrorContext *shape_variable(akbasic_Runtime *obj, akbasic_ASTLeaf *expr, const char *verb, akbasic_Variable **dest, akbasic_ASTLeaf **rest)
{

75
src/runtime_housekeeping.c
View File

@@ -18,6 +18,7 @@
#include <akerror.h>
#include <akbasic/args.h>
#include <akbasic/error.h>
#include <akbasic/runtime.h>
@@ -61,6 +62,13 @@ static akerr_ErrorContext AKERR_NOIGNORE *clear_variables(akbasic_Runtime *obj)
while ( obj->environment != NULL && obj->environment->parent != NULL ) {
PASS(errctx, akbasic_runtime_prev_environment(obj));
}
/*
* That unwind may have released the environment an interrupt handler was
* running in. Leaving the pointer behind would wedge interrupts off for the
* rest of the session, since nothing would ever pop the environment it
* compares against again.
*/
obj->handlerenv = NULL;
root = obj->environment;
FAIL_ZERO_RETURN(errctx, (root != NULL), AKERR_NULLPOINTER, "Runtime has no root environment");
PASS(errctx, akbasic_symtab_init(&root->variables, AKBASIC_MAX_VARIABLES));
@@ -85,6 +93,31 @@ akerr_ErrorContext *akbasic_cmd_new(akbasic_Runtime *obj, akbasic_ASTLeaf *expr,
PASS(errctx, clear_variables(obj));
PASS(errctx, akbasic_symtab_init(&obj->environment->labels, AKBASIC_MAX_LABELS));
/* A new program does not inherit the old one's open files. */
PASS(errctx, akbasic_disk_close_all(&obj->disk_state));
/*
* Disarm everything. The handlers were lines of the program that has just
* been deleted, so an interrupt left armed would send the *next* program
* into whatever happens to be at that line number.
*/
for ( i = 0; i < AKBASIC_MAX_INTERRUPTS; i++ ) {
PASS(errctx, akbasic_runtime_disarm_interrupt(obj, (akbasic_InterruptSource)i));
}
/*
* And the sprites go back to undefined. The patterns belonged to the program
* that has just been deleted. The *device* still holds them -- there is no
* verb that undefines a sprite and so no entry point to say so -- but every
* one of them is hidden, which is the observable half.
*/
PASS(errctx, akbasic_sprite_state_init(&obj->sprite_state));
if ( obj->sprites != NULL && obj->sprites->show != NULL ) {
for ( i = 0; i < AKBASIC_MAX_SPRITES; i++ ) {
PASS(errctx, obj->sprites->show(obj->sprites, (int)i + 1, false));
}
}
/*
* The line counter goes home too. Without this a NEW typed at the REPL
* leaves the next entered line filed under wherever the last program
@@ -120,6 +153,48 @@ akerr_ErrorContext *akbasic_cmd_clr(akbasic_Runtime *obj, akbasic_ASTLeaf *expr,
SUCCEED_RETURN(errctx);
}
/* ------------------------------------------------------------ RENUMBER --- */
akerr_ErrorContext *akbasic_cmd_renumber(akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest)
{
PREPARE_ERROR(errctx);
double args[3];
int count = 0;
int64_t newstart = 10;
int64_t increment = 10;
int64_t oldstart = 0;
(void)lval; (void)rval;
FAIL_ZERO_RETURN(errctx, (obj != NULL && dest != NULL), AKERR_NULLPOINTER,
"NULL argument in RENUMBER");
if ( expr != NULL && akbasic_leaf_first_argument(expr) != NULL ) {
PASS(errctx, akbasic_args_numbers(obj, expr, "RENUMBER", args, 3, &count));
}
if ( count >= 1 ) {
newstart = (int64_t)args[0];
}
if ( count >= 2 ) {
increment = (int64_t)args[1];
}
if ( count >= 3 ) {
oldstart = (int64_t)args[2];
}
PASS(errctx, akbasic_renumber(obj, newstart, increment, oldstart));
/*
* The labels and the DATA items were filed against the old numbering, so
* both have to be built again. akbasic_runtime_set_mode() does it on the way
* into RUN, but a program renumbered and then CONTinued would otherwise
* branch on a stale map.
*/
PASS(errctx, akbasic_runtime_scan_labels(obj));
PASS(errctx, akbasic_data_scan(obj));
obj->stopped = false;
obj->stoppedline = 0;
SUCCEED_TRUE(obj, dest);
SUCCEED_RETURN(errctx);
}
/* ---------------------------------------------------------------- CONT --- */
akerr_ErrorContext *akbasic_cmd_cont(akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest)

132
src/runtime_machine.c Normal file
View File

@@ -0,0 +1,132 @@
/**
* @file runtime_machine.c
* @brief The group J verbs: FETCH, STASH and SYS.
*
* Machine-level verbs on a machine that is not a Commodore 128. `POKE`, `PEEK`
* and `POINTER` already treat a BASIC integer as a real address in this
* process's memory -- that decision was made when they were ported -- and these
* follow it, because a `FETCH` that meant something different from the `PEEK`
* beside it would be worse than either answer on its own.
*
* `SYS` does not follow it, and the difference is the point: reading and writing
* a byte is something this process can do, and jumping to one is not.
*/
#include <inttypes.h>
#include <stdio.h>
#include <string.h>
#include <akerror.h>
#include <akbasic/args.h>
#include <akbasic/error.h>
#include <akbasic/runtime.h>
#include "verbs.h"
/* Most verbs answer "did something happen"; this is that answer. */
#define SUCCEED_TRUE(__obj, __dest) \
do { \
*(__dest) = &(__obj)->staticTrueValue; \
} while ( 0 )
/**
* @brief The copy behind both FETCH and STASH.
*
* On a C128 the two differ by which side is expansion RAM: `STASH` writes out to
* the RAM Expansion Unit and `FETCH` reads back from it. There is no expansion
* unit here and no banks, so both are the same byte copy and the only honest
* thing to do is say so rather than invent a distinction.
*
* @param obj Runtime to evaluate against.
* @param expr The command leaf.
* @param verb Name to use in a diagnostic.
* @return `NULL` on success, otherwise an error context owned by the caller.
*/
static akerr_ErrorContext *copy_bytes(akbasic_Runtime *obj, akbasic_ASTLeaf *expr, const char *verb)
{
PREPARE_ERROR(errctx);
double args[4];
int count = 0;
int64_t length = 0;
PASS(errctx, akbasic_args_numbers(obj, expr, verb, args, 4, &count));
FAIL_ZERO_RETURN(errctx, (count >= 3), AKBASIC_ERR_SYNTAX,
"Expected %s (count), (source address), (destination address)", verb);
length = (int64_t)args[0];
FAIL_ZERO_RETURN(errctx, (length >= 0), AKBASIC_ERR_VALUE,
"%s cannot copy a negative number of bytes", verb);
FAIL_ZERO_RETURN(errctx, (args[1] != 0.0 && args[2] != 0.0), AKBASIC_ERR_VALUE,
"%s will not touch address zero", verb);
if ( length == 0 ) {
SUCCEED_RETURN(errctx);
}
/*
* memmove rather than memcpy: a program shifting a buffer along by a few
* bytes overlaps its own source, and that is a normal thing to ask for.
*
* There is no bounds check, and there cannot be one -- the same is true of
* POKE and PEEK. A BASIC integer here is a real address, so a wrong one is a
* segmentation fault rather than an error message. See TODO.md section 5.
*/
memmove((void *)(uintptr_t)args[2], (const void *)(uintptr_t)args[1], (size_t)length);
SUCCEED_RETURN(errctx);
}
akerr_ErrorContext *akbasic_cmd_fetch(akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest)
{
PREPARE_ERROR(errctx);
(void)lval; (void)rval;
FAIL_ZERO_RETURN(errctx, (obj != NULL && dest != NULL), AKERR_NULLPOINTER,
"NULL argument in FETCH");
PASS(errctx, copy_bytes(obj, expr, "FETCH"));
SUCCEED_TRUE(obj, dest);
SUCCEED_RETURN(errctx);
}
akerr_ErrorContext *akbasic_cmd_stash(akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest)
{
PREPARE_ERROR(errctx);
(void)lval; (void)rval;
FAIL_ZERO_RETURN(errctx, (obj != NULL && dest != NULL), AKERR_NULLPOINTER,
"NULL argument in STASH");
PASS(errctx, copy_bytes(obj, expr, "STASH"));
SUCCEED_TRUE(obj, dest);
SUCCEED_RETURN(errctx);
}
akerr_ErrorContext *akbasic_cmd_sys(akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest)
{
PREPARE_ERROR(errctx);
double args[4];
int count = 0;
(void)lval; (void)rval;
FAIL_ZERO_RETURN(errctx, (obj != NULL && dest != NULL), AKERR_NULLPOINTER,
"NULL argument in SYS");
/*
* Parsed, then refused. Parsing first is deliberate: a program is told that
* SYS is not implemented rather than that its arguments are wrong, and a
* listing containing SYS still LISTs and still RENUMBERs.
*/
PASS(errctx, akbasic_args_numbers(obj, expr, "SYS", args, 4, &count));
FAIL_ZERO_RETURN(errctx, (count >= 1), AKBASIC_ERR_SYNTAX, "Expected SYS (address)");
/*
* There is no 6502. SYS calls machine code at an address, and the machine
* code a C128 program would call is ROM that does not exist here -- so there
* is nothing to jump to and nothing sensible to emulate. Jumping to a real
* address in this process would be a way to crash it on purpose.
*
* Refused by name rather than ignored, because a program whose SYS silently
* did nothing would carry on as though it had worked. This is the same
* reasoning BANK, FAST and MONITOR are out of scope on, with one difference:
* those are refused at the table and this one has a handler, because SYS is
* common enough in published listings to be worth a specific message.
*/
FAIL_RETURN(errctx, AKBASIC_ERR_DEVICE,
"SYS %d: there is no 6502 here, and no ROM to call. Machine code cannot be run by this interpreter",
(int)args[0]);
}

755
src/runtime_sprite.c Normal file
View File

@@ -0,0 +1,755 @@
/**
* @file runtime_sprite.c
* @brief The group H verb implementations: SPRITE, MOVSPR, SPRCOLOR, SPRSAV,
* COLLISION, and the BUMP / RSPPOS / RSPRITE / RSPCOLOR readbacks.
*
* Nothing here includes an SDL or a libakgl header. Every device call goes
* through the akbasic_SpriteBackend record the host attached, which is what lets
* the whole group be tested in a build with no SDL on the machine.
*
* These verbs are not in the Go reference -- it lists all of them as
* unimplemented -- so the semantics come from Commodore BASIC 7.0 rather than
* from a port. Where 7.0 does something a modern renderer cannot, or where the
* manual leaves a unit undefined, the decision is recorded in TODO.md section 5
* rather than presented as fidelity.
*
* The verbs split three ways, and the split is what makes them testable:
*
* - SPRCOLOR and the four readbacks touch only interpreter state and work with
* no device at all.
* - SPRITE and MOVSPR update interpreter state *and* tell the device. With no
* device they still update the state and then refuse, so a program that
* positions a sprite and asks RSPPOS where it is gets the right answer
* either way.
* - SPRSAV and COLLISION need the device outright.
*/
#include <inttypes.h>
#include <math.h>
#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#include <akerror.h>
#include <akbasic/args.h>
#include <akbasic/error.h>
#include <akbasic/runtime.h>
#include "verbs.h"
/* Most verbs answer "did something happen"; this is that answer. */
#define SUCCEED_TRUE(__obj, __dest) \
do { \
*(__dest) = &(__obj)->staticTrueValue; \
} while ( 0 )
/** @brief What SSHAPE writes into a string variable, ahead of the slot number. */
#define SHAPE_PREFIX "SHAPE:"
/** @brief MOVSPR's four forms, as src/parser_commands.c encodes them. */
#define MOVSPR_ABSOLUTE 0
#define MOVSPR_RELATIVE 1
#define MOVSPR_POLAR 2
#define MOVSPR_CONTINUOUS 3
/**
* @brief Refuse politely when the host lent us no sprite device.
*
* Names the verb, because "no sprite device" on its own tells a program author
* nothing about which line to look at. The standalone stdio driver attaches no
* backend at all, so this is a common path rather than an edge case.
*/
static akerr_ErrorContext *require_sprites(akbasic_Runtime *obj, const char *verb)
{
PREPARE_ERROR(errctx);
FAIL_ZERO_RETURN(errctx, (obj != NULL && verb != NULL), AKERR_NULLPOINTER,
"NULL argument in require_sprites");
FAIL_ZERO_RETURN(errctx, (obj->sprites != NULL), AKBASIC_ERR_DEVICE,
"%s needs a sprite device and this runtime has none", verb);
SUCCEED_RETURN(errctx);
}
/** @brief Check a sprite number and turn it into a slot index. */
static akerr_ErrorContext *sprite_index(int n, const char *verb, int *dest)
{
PREPARE_ERROR(errctx);
FAIL_ZERO_RETURN(errctx, (n >= 1 && n <= AKBASIC_MAX_SPRITES), AKBASIC_ERR_BOUNDS,
"%s: sprite %d is outside 1..%d", verb, n, AKBASIC_MAX_SPRITES);
*dest = n - 1;
SUCCEED_RETURN(errctx);
}
/**
* @brief Push one sprite's colour, expansion and priority at the device.
*
* One call rather than four, matching the backend record: SPRITE sets them
* together and a backend that has to rebuild a texture to change a colour should
* not do it four times for one statement.
*/
static akerr_ErrorContext *push_configuration(akbasic_Runtime *obj, int index)
{
PREPARE_ERROR(errctx);
akbasic_Sprite *sprite = &obj->sprite_state.sprites[index];
akbasic_Color color;
if ( obj->sprites == NULL || obj->sprites->configure == NULL ) {
SUCCEED_RETURN(errctx);
}
PASS(errctx, akbasic_graphics_palette(sprite->colorindex, &color));
PASS(errctx, obj->sprites->configure(obj->sprites, index + 1, color,
sprite->xexpand, sprite->yexpand, sprite->behind));
SUCCEED_RETURN(errctx);
}
/* ---------------------------------------------------------------- SPRITE -- */
akerr_ErrorContext *akbasic_cmd_sprite(akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest)
{
PREPARE_ERROR(errctx);
akbasic_Sprite *sprite = NULL;
double args[7];
int count = 0;
int index = 0;
(void)lval; (void)rval;
FAIL_ZERO_RETURN(errctx, (obj != NULL && dest != NULL), AKERR_NULLPOINTER,
"NULL argument in SPRITE");
PASS(errctx, akbasic_args_numbers(obj, expr, "SPRITE", args, 7, &count));
FAIL_ZERO_RETURN(errctx, (count >= 1), AKBASIC_ERR_SYNTAX,
"SPRITE expected a sprite number");
PASS(errctx, sprite_index((int)args[0], "SPRITE", &index));
sprite = &obj->sprite_state.sprites[index];
/*
* Every argument after the number is optional and an omitted one leaves that
* attribute alone -- which is BASIC 7.0's rule and is what makes
* `SPRITE 1,1` and `SPRITE 1,,,,1` both useful.
*/
if ( count >= 2 ) {
sprite->enabled = (args[1] != 0.0);
}
if ( count >= 3 ) {
FAIL_ZERO_RETURN(errctx, (args[2] >= 1.0 && args[2] <= 16.0), AKBASIC_ERR_BOUNDS,
"SPRITE: colour %d is outside 1..16", (int)args[2]);
sprite->colorindex = (int)args[2];
}
if ( count >= 4 ) {
sprite->behind = (args[3] != 0.0);
}
if ( count >= 5 ) {
sprite->xexpand = (args[4] != 0.0);
}
if ( count >= 6 ) {
sprite->yexpand = (args[5] != 0.0);
}
if ( count >= 7 ) {
/*
* The multicolour bit is recorded and RSPRITE reads it back, but no
* pattern format here carries the second bit per pixel that multicolour
* selects with -- see TODO.md section 5. Recording it costs nothing and
* keeps the argument position honest for the day one does.
*/
sprite->multicolour = (args[6] != 0.0);
}
/*
* State first, device second, and the refusal last of all. A program with no
* sprite device still gets its state updated, so RSPRITE and RSPPOS answer
* correctly -- and it still gets told, by name, that SPRITE could not reach
* a device.
*/
PASS(errctx, require_sprites(obj, "SPRITE"));
PASS(errctx, push_configuration(obj, index));
if ( obj->sprites->show != NULL ) {
PASS(errctx, obj->sprites->show(obj->sprites, index + 1, sprite->enabled));
}
SUCCEED_TRUE(obj, dest);
SUCCEED_RETURN(errctx);
}
/* ---------------------------------------------------------------- MOVSPR -- */
/**
* @brief Put a sprite where the state says it is, if there is a device to tell.
*
* Shared by MOVSPR and by the continuous-motion service, which are the only two
* things that move a sprite.
*/
static akerr_ErrorContext *push_position(akbasic_Runtime *obj, int index)
{
PREPARE_ERROR(errctx);
akbasic_Sprite *sprite = &obj->sprite_state.sprites[index];
if ( obj->sprites == NULL || obj->sprites->move == NULL ) {
SUCCEED_RETURN(errctx);
}
PASS(errctx, obj->sprites->move(obj->sprites, index + 1, sprite->x, sprite->y));
SUCCEED_RETURN(errctx);
}
akerr_ErrorContext *akbasic_cmd_movspr(akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest)
{
PREPARE_ERROR(errctx);
akbasic_Sprite *sprite = NULL;
double args[4];
int count = 0;
int index = 0;
int form = 0;
(void)lval; (void)rval;
FAIL_ZERO_RETURN(errctx, (obj != NULL && dest != NULL), AKERR_NULLPOINTER,
"NULL argument in MOVSPR");
PASS(errctx, akbasic_args_numbers(obj, expr, "MOVSPR", args, 4, &count));
/* form, n, a, b -- the parse handler guarantees all four or it raised. */
FAIL_ZERO_RETURN(errctx, (count == 4), AKBASIC_ERR_SYNTAX,
"MOVSPR expected a sprite number and two values");
form = (int)args[0];
PASS(errctx, sprite_index((int)args[1], "MOVSPR", &index));
sprite = &obj->sprite_state.sprites[index];
switch ( form ) {
case MOVSPR_ABSOLUTE:
sprite->x = args[2];
sprite->y = args[3];
break;
case MOVSPR_RELATIVE:
sprite->x += args[2];
sprite->y += args[3];
break;
case MOVSPR_POLAR:
/*
* Distance first, then angle -- that order is BASIC 7.0's and it is the
* opposite of the continuous form's, which is a trap worth naming. The
* angle is degrees clockwise from vertical, so 0 is straight up and 90 is
* to the right; that is a compass bearing, not the mathematical
* convention, and it is why the sine and cosine look swapped.
*/
sprite->x += args[2] * sin(args[3] * M_PI / 180.0);
sprite->y -= args[2] * cos(args[3] * M_PI / 180.0);
break;
case MOVSPR_CONTINUOUS:
FAIL_ZERO_RETURN(errctx,
(args[3] >= 0.0 && args[3] <= (double)AKBASIC_SPRITE_MAX_SPEED),
AKBASIC_ERR_BOUNDS,
"MOVSPR: speed %d is outside 0..%d",
(int)args[3], AKBASIC_SPRITE_MAX_SPEED);
sprite->angle = args[2];
sprite->speed = (int)args[3];
/*
* Nothing moves here. The sprite starts moving on the next step, paced
* off the host's clock by akbasic_sprite_service() -- exactly the way the
* PLAY queue is, and for the same reason: this library owns no loop and
* must not block.
*/
SUCCEED_TRUE(obj, dest);
SUCCEED_RETURN(errctx);
default:
FAIL_RETURN(errctx, AKBASIC_ERR_SYNTAX, "MOVSPR: unknown argument form %d", form);
}
PASS(errctx, require_sprites(obj, "MOVSPR"));
PASS(errctx, push_position(obj, index));
SUCCEED_TRUE(obj, dest);
SUCCEED_RETURN(errctx);
}
akerr_ErrorContext *akbasic_sprite_service(akbasic_Runtime *obj)
{
PREPARE_ERROR(errctx);
double elapsed = 0.0;
int i = 0;
FAIL_ZERO_RETURN(errctx, (obj != NULL), AKERR_NULLPOINTER, "NULL runtime in sprite_service");
if ( obj->sprite_state.lastservicems == 0 ) {
obj->sprite_state.lastservicems = obj->timems;
SUCCEED_RETURN(errctx);
}
elapsed = (double)(obj->timems - obj->sprite_state.lastservicems) / 1000.0;
if ( elapsed <= 0.0 ) {
/*
* A host that never calls akbasic_runtime_settime() leaves the clock at
* zero, and a host that stepped twice inside one millisecond has not
* moved. Neither is an error and neither should move a sprite by a
* garbage amount; a clock that went backwards lands here too.
*/
SUCCEED_RETURN(errctx);
}
obj->sprite_state.lastservicems = obj->timems;
/*
* A loop, so CATCH and the _BREAK macros are banned in here -- they expand to
* a C break and would leave the loop with an error still pending.
*/
for ( i = 0; i < AKBASIC_MAX_SPRITES; i++ ) {
akbasic_Sprite *sprite = &obj->sprite_state.sprites[i];
double distance = 0.0;
if ( sprite->speed <= 0 ) {
continue;
}
distance = (double)sprite->speed * AKBASIC_SPRITE_SPEED_PIXELS_PER_SECOND * elapsed;
sprite->x += distance * sin(sprite->angle * M_PI / 180.0);
sprite->y -= distance * cos(sprite->angle * M_PI / 180.0);
PASS(errctx, push_position(obj, i));
}
SUCCEED_RETURN(errctx);
}
/* -------------------------------------------------------------- SPRCOLOR -- */
akerr_ErrorContext *akbasic_cmd_sprcolor(akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest)
{
PREPARE_ERROR(errctx);
akbasic_Color c1;
akbasic_Color c2;
double args[2];
int count = 0;
(void)lval; (void)rval;
FAIL_ZERO_RETURN(errctx, (obj != NULL && dest != NULL), AKERR_NULLPOINTER,
"NULL argument in SPRCOLOR");
PASS(errctx, akbasic_args_numbers(obj, expr, "SPRCOLOR", args, 2, &count));
FAIL_ZERO_RETURN(errctx, (count >= 1), AKBASIC_ERR_SYNTAX,
"SPRCOLOR expected at least one colour");
FAIL_ZERO_RETURN(errctx, (args[0] >= 1.0 && args[0] <= 16.0), AKBASIC_ERR_BOUNDS,
"SPRCOLOR: colour %d is outside 1..16", (int)args[0]);
obj->sprite_state.sharedcolor1 = (int)args[0];
if ( count >= 2 ) {
FAIL_ZERO_RETURN(errctx, (args[1] >= 1.0 && args[1] <= 16.0), AKBASIC_ERR_BOUNDS,
"SPRCOLOR: colour %d is outside 1..16", (int)args[1]);
obj->sprite_state.sharedcolor2 = (int)args[1];
}
/*
* No device required. The two registers are the program's state, RSPCOLOR
* reads them back, and a runtime with no sprite device is still entitled to
* remember what it was told -- the same rule GRAPHIC's mode follows.
*/
if ( obj->sprites != NULL && obj->sprites->shared_colors != NULL ) {
PASS(errctx, akbasic_graphics_palette(obj->sprite_state.sharedcolor1, &c1));
PASS(errctx, akbasic_graphics_palette(obj->sprite_state.sharedcolor2, &c2));
PASS(errctx, obj->sprites->shared_colors(obj->sprites, c1, c2));
}
SUCCEED_TRUE(obj, dest);
SUCCEED_RETURN(errctx);
}
/* ---------------------------------------------------------------- SPRSAV -- */
/**
* @brief Read a DIMmed integer array out into packed sprite pattern bytes.
*
* The array form is ours rather than BASIC 7.0's, and it exists because a value
* in this interpreter carries a NUL-terminated `char[256]`: a C128 puts the
* 63 raw bytes of a pattern in a string, and a string that cannot hold a zero
* byte cannot hold a sprite. An integer array can, and `DIM P#(63)` is exactly
* the right size -- see TODO.md section 5.
*/
static akerr_ErrorContext *pattern_from_array(akbasic_Runtime *obj, akbasic_ASTLeaf *arg, uint8_t *dest)
{
PREPARE_ERROR(errctx);
akbasic_Variable *variable = NULL;
int64_t subscript[1];
int64_t length = 0;
int i = 0;
PASS(errctx, akbasic_environment_get(obj->environment, arg->identifier, &variable));
FAIL_ZERO_RETURN(errctx, (variable != NULL), AKBASIC_ERR_UNDEFINED,
"SPRSAV could not reach the array %s", arg->identifier);
length = (int64_t)variable->valuecount;
FAIL_ZERO_RETURN(errctx, (length >= AKBASIC_SPRITE_PATTERN_BYTES), AKBASIC_ERR_BOUNDS,
"SPRSAV: %s holds %" PRId64 " elements and a sprite pattern is %d",
arg->identifier, length, AKBASIC_SPRITE_PATTERN_BYTES);
for ( i = 0; i < AKBASIC_SPRITE_PATTERN_BYTES; i++ ) {
akbasic_Value *element = NULL;
subscript[0] = (int64_t)i;
PASS(errctx, akbasic_variable_get_subscript(variable, subscript, 1, &element));
FAIL_NONZERO_RETURN(errctx, (element->valuetype == AKBASIC_TYPE_STRING),
AKBASIC_ERR_TYPE,
"SPRSAV: %s(%d) is a string, and a pattern is bytes",
arg->identifier, i);
/*
* Masked rather than refused. A pattern byte is eight pixels and there
* are only eight to set, so anything outside 0..255 is a program that
* has miscounted -- but a DATA statement full of 256s should draw
* something recognisable rather than stop the program dead.
*/
dest[i] = (uint8_t)(((element->valuetype == AKBASIC_TYPE_FLOAT)
? (int64_t)element->floatval : element->intval) & 0xff);
}
SUCCEED_RETURN(errctx);
}
/**
* @brief Install sprite @p index from whatever the first argument turned out to be.
*
* Three shapes of source, told apart by what the leaf *is* rather than by an
* argument position:
*
* - an unsubscripted integer-array identifier -- 63 pattern bytes
* - a string beginning "SHAPE:" -- a region SSHAPE saved
* - any other string -- a path to an image file
*/
static akerr_ErrorContext *define_from_leaf(akbasic_Runtime *obj, akbasic_ASTLeaf *arg, int index)
{
PREPARE_ERROR(errctx);
akbasic_Value *value = NULL;
akbasic_Color fg;
akbasic_Color bg;
uint8_t pattern[AKBASIC_SPRITE_PATTERN_BYTES];
if ( arg->leaftype == AKBASIC_LEAF_IDENTIFIER_INT &&
akbasic_leaf_first_subscript(arg) == NULL ) {
FAIL_ZERO_RETURN(errctx, (obj->sprites->define != NULL), AKBASIC_ERR_DEVICE,
"This sprite device cannot be given a pattern");
PASS(errctx, pattern_from_array(obj, arg, pattern));
PASS(errctx, akbasic_graphics_palette(obj->sprite_state.sprites[index].colorindex, &fg));
/*
* A clear bit is transparent, not black. On a C128 the background shows
* through a sprite's clear pixels; drawing them opaque would put a
* 24x21 black rectangle behind every sprite.
*/
bg.r = 0;
bg.g = 0;
bg.b = 0;
bg.a = 0;
PASS(errctx, obj->sprites->define(obj->sprites, index + 1, pattern,
AKBASIC_SPRITE_PATTERN_BYTES, fg, bg));
SUCCEED_RETURN(errctx);
}
PASS(errctx, akbasic_runtime_evaluate(obj, arg, &value));
FAIL_ZERO_RETURN(errctx, (value->valuetype == AKBASIC_TYPE_STRING), AKBASIC_ERR_TYPE,
"SPRSAV expected a sprite number, an image path, a saved shape or an integer array");
if ( strncmp(value->stringval, SHAPE_PREFIX, strlen(SHAPE_PREFIX)) == 0 ) {
int handle = atoi(value->stringval + strlen(SHAPE_PREFIX));
FAIL_ZERO_RETURN(errctx, (obj->sprites->define_shape != NULL), AKBASIC_ERR_DEVICE,
"This sprite device cannot take a saved shape");
PASS(errctx, obj->sprites->define_shape(obj->sprites, index + 1, handle));
SUCCEED_RETURN(errctx);
}
FAIL_ZERO_RETURN(errctx, (obj->sprites->define_file != NULL), AKBASIC_ERR_DEVICE,
"This sprite device cannot load an image file");
/*
* The running program's directory goes with the path. The backend tries the
* working directory first and this second, which is what makes a `.bas`
* stored beside its art work from anywhere -- and it is exactly how libakgl
* resolves a spritesheet named by a sprite document.
*/
PASS(errctx, obj->sprites->define_file(obj->sprites, index + 1, value->stringval,
(obj->sourcepath[0] != '\0'
? obj->sourcepath : NULL)));
SUCCEED_RETURN(errctx);
}
akerr_ErrorContext *akbasic_cmd_sprsav(akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest)
{
PREPARE_ERROR(errctx);
akbasic_ASTLeaf *source = NULL;
akbasic_ASTLeaf *target = NULL;
akbasic_Value *value = NULL;
int index = 0;
(void)lval; (void)rval;
FAIL_ZERO_RETURN(errctx, (obj != NULL && dest != NULL), AKERR_NULLPOINTER,
"NULL argument in SPRSAV");
PASS(errctx, require_sprites(obj, "SPRSAV"));
source = akbasic_leaf_first_argument(expr);
target = (source != NULL ? source->next : NULL);
FAIL_ZERO_RETURN(errctx, (source != NULL && target != NULL), AKBASIC_ERR_SYNTAX,
"SPRSAV expected a source and a destination");
FAIL_NONZERO_RETURN(errctx, (target->next != NULL), AKBASIC_ERR_SYNTAX,
"SPRSAV takes exactly two arguments");
/*
* Only one direction. A C128's SPRSAV also copies a sprite *out* into a
* string, which here would mean writing an image file -- a disk operation,
* and group F is unimplemented as a whole. Refused by name rather than
* half-built; see TODO.md section 5.
*/
PASS(errctx, akbasic_runtime_evaluate(obj, target, &value));
FAIL_NONZERO_RETURN(errctx, (value->valuetype == AKBASIC_TYPE_STRING), AKBASIC_ERR_DEVICE,
"SPRSAV cannot copy a sprite out to a string or a file; that is a disk operation and this interpreter has none");
PASS(errctx, sprite_index((int)value->intval, "SPRSAV", &index));
PASS(errctx, define_from_leaf(obj, source, index));
obj->sprite_state.sprites[index].defined = true;
PASS(errctx, push_configuration(obj, index));
SUCCEED_TRUE(obj, dest);
SUCCEED_RETURN(errctx);
}
/* ------------------------------------------------------------- COLLISION -- */
akerr_ErrorContext *akbasic_cmd_collision(akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest)
{
PREPARE_ERROR(errctx);
akbasic_ASTLeaf *arg = NULL;
akbasic_ASTLeaf *handler = NULL;
akbasic_Value *value = NULL;
int type = 0;
(void)lval; (void)rval;
FAIL_ZERO_RETURN(errctx, (obj != NULL && dest != NULL), AKERR_NULLPOINTER,
"NULL argument in COLLISION");
arg = akbasic_leaf_first_argument(expr);
FAIL_ZERO_RETURN(errctx, (arg != NULL), AKBASIC_ERR_SYNTAX,
"COLLISION expected a collision type");
PASS(errctx, akbasic_runtime_evaluate(obj, arg, &value));
FAIL_NONZERO_RETURN(errctx, (value->valuetype == AKBASIC_TYPE_STRING), AKBASIC_ERR_TYPE,
"COLLISION expected a number");
type = (int)value->intval;
FAIL_ZERO_RETURN(errctx, (type >= 1 && type <= 3), AKBASIC_ERR_BOUNDS,
"COLLISION: type %d is outside 1..3", type);
/*
* Type 1 only. Sprite-to-background would need the whole render target read
* back and compared against each sprite every frame, and a light pen has no
* meaning on a machine with no light pen; both are refused by name rather
* than silently accepted and never fired. TODO.md section 5.
*/
FAIL_ZERO_RETURN(errctx, (type == 1), AKBASIC_ERR_DEVICE,
"COLLISION type %d is not implemented: %s",
type,
(type == 2
? "sprite-to-background collision needs the screen read back every frame"
: "there is no light pen"));
handler = arg->next;
if ( handler == NULL ) {
/* No target disarms it, which is how a C128 turns a handler off. */
PASS(errctx, akbasic_runtime_disarm_interrupt(obj, AKBASIC_INTERRUPT_SPRITE));
SUCCEED_TRUE(obj, dest);
SUCCEED_RETURN(errctx);
}
FAIL_NONZERO_RETURN(errctx, (handler->next != NULL), AKBASIC_ERR_SYNTAX,
"COLLISION takes a type and at most one handler");
/*
* A label is taken by *name*, not by evaluating it. Evaluating would resolve
* it here and now, and a handler is normally written on a line the program
* has not reached yet -- so the name is what is stored and it is resolved
* when the interrupt fires. A line number is an ordinary expression and is
* evaluated, so `COLLISION 1, L#` works too.
*/
if ( handler->leaftype == AKBASIC_LEAF_IDENTIFIER &&
akbasic_leaf_first_subscript(handler) == NULL ) {
PASS(errctx, akbasic_runtime_arm_interrupt(obj, AKBASIC_INTERRUPT_SPRITE,
0, handler->identifier));
SUCCEED_TRUE(obj, dest);
SUCCEED_RETURN(errctx);
}
PASS(errctx, akbasic_runtime_evaluate(obj, handler, &value));
FAIL_NONZERO_RETURN(errctx, (value->valuetype == AKBASIC_TYPE_STRING), AKBASIC_ERR_TYPE,
"COLLISION expected a line number or a label");
PASS(errctx, akbasic_runtime_arm_interrupt(obj, AKBASIC_INTERRUPT_SPRITE,
value->intval, NULL));
SUCCEED_TRUE(obj, dest);
SUCCEED_RETURN(errctx);
}
akerr_ErrorContext *akbasic_collision_service(akbasic_Runtime *obj)
{
PREPARE_ERROR(errctx);
uint16_t mask = 0;
FAIL_ZERO_RETURN(errctx, (obj != NULL), AKERR_NULLPOINTER,
"NULL runtime in collision_service");
if ( obj->sprites == NULL || obj->sprites->collisions == NULL ) {
SUCCEED_RETURN(errctx);
}
PASS(errctx, obj->sprites->collisions(obj->sprites, &mask));
if ( mask == 0 ) {
SUCCEED_RETURN(errctx);
}
/*
* Accumulated, not replaced. BUMP() answers "has this sprite hit anything
* since I last looked", so a collision that starts and ends between two
* polls is still news; BUMP clears what it reports.
*/
obj->sprite_state.bumped |= mask;
/*
* Raised unconditionally. An unarmed source records nothing, so there is
* nothing to ask before raising -- see akbasic_runtime_raise_interrupt.
*/
PASS(errctx, akbasic_runtime_raise_interrupt(obj, AKBASIC_INTERRUPT_SPRITE));
SUCCEED_RETURN(errctx);
}
/* ------------------------------------------------------------- readbacks -- */
/**
* @brief Evaluate a function's nth argument.
*
* The dispatch table hands a function handler `lval` and `rval` as NULL and its
* whole argument list on the leaf, so every function in the interpreter digs its
* arguments out this way. src/runtime_functions.c has the same helper and keeps
* it static; a third copy would be the point at which it moved to args.h, and
* this is the second.
*/
static akerr_ErrorContext *nth_number(akbasic_Runtime *obj, akbasic_ASTLeaf *expr, const char *fname, int n, int64_t *dest)
{
PREPARE_ERROR(errctx);
akbasic_ASTLeaf *arg = NULL;
akbasic_Value *value = NULL;
int i = 0;
FAIL_ZERO_RETURN(errctx, (expr != NULL), AKERR_NULLPOINTER, "NIL leaf");
arg = akbasic_leaf_first_argument(expr);
for ( i = 0; i < n && arg != NULL; i++ ) {
arg = arg->next;
}
FAIL_ZERO_RETURN(errctx, (arg != NULL), AKBASIC_ERR_SYNTAX,
"%s is missing argument %d", fname, n + 1);
PASS(errctx, akbasic_runtime_evaluate(obj, arg, &value));
FAIL_NONZERO_RETURN(errctx, (value->valuetype == AKBASIC_TYPE_STRING), AKBASIC_ERR_TYPE,
"%s expected a number in argument %d", fname, n + 1);
*dest = (value->valuetype == AKBASIC_TYPE_FLOAT)
? (int64_t)value->floatval : value->intval;
SUCCEED_RETURN(errctx);
}
/** @brief Take a scratch integer value from the per-line pool for a function result. */
static akerr_ErrorContext *integer_result(akbasic_Runtime *obj, int64_t value, akbasic_Value **dest)
{
PREPARE_ERROR(errctx);
akbasic_Value *out = NULL;
PASS(errctx, akbasic_environment_new_value(obj->environment, &out));
PASS(errctx, akbasic_value_zero(out));
out->valuetype = AKBASIC_TYPE_INTEGER;
out->intval = value;
*dest = out;
SUCCEED_RETURN(errctx);
}
akerr_ErrorContext *akbasic_fn_bump(akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest)
{
PREPARE_ERROR(errctx);
uint16_t reported = 0;
int64_t type = 0;
(void)lval; (void)rval;
FAIL_ZERO_RETURN(errctx, (obj != NULL && dest != NULL), AKERR_NULLPOINTER,
"NULL argument in BUMP");
PASS(errctx, nth_number(obj, expr, "BUMP", 0, &type));
FAIL_ZERO_RETURN(errctx, (type == 1), AKBASIC_ERR_DEVICE,
"BUMP type %" PRId64 " is not implemented; only sprite-to-sprite collision is",
type);
/*
* Reading clears, which is what a C128 does and what makes the question
* answerable at all: without it a program that polls in a loop would see the
* same collision forever.
*/
reported = obj->sprite_state.bumped;
obj->sprite_state.bumped = 0;
PASS(errctx, integer_result(obj, (int64_t)reported, dest));
SUCCEED_RETURN(errctx);
}
akerr_ErrorContext *akbasic_fn_rsppos(akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest)
{
akbasic_Sprite *sprite = NULL;
PREPARE_ERROR(errctx);
int64_t n = 0;
int64_t field = 0;
int index = 0;
(void)lval; (void)rval;
FAIL_ZERO_RETURN(errctx, (obj != NULL && dest != NULL), AKERR_NULLPOINTER,
"NULL argument in RSPPOS");
PASS(errctx, nth_number(obj, expr, "RSPPOS", 0, &n));
PASS(errctx, nth_number(obj, expr, "RSPPOS", 1, &field));
PASS(errctx, sprite_index((int)n, "RSPPOS", &index));
sprite = &obj->sprite_state.sprites[index];
switch ( field ) {
case 0:
PASS(errctx, integer_result(obj, (int64_t)sprite->x, dest));
break;
case 1:
PASS(errctx, integer_result(obj, (int64_t)sprite->y, dest));
break;
case 2:
PASS(errctx, integer_result(obj, (int64_t)sprite->speed, dest));
break;
default:
FAIL_RETURN(errctx, AKBASIC_ERR_BOUNDS,
"RSPPOS: field %" PRId64 " is outside 0..2 (x, y, speed)", field);
}
SUCCEED_RETURN(errctx);
}
akerr_ErrorContext *akbasic_fn_rsprite(akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest)
{
akbasic_Sprite *sprite = NULL;
PREPARE_ERROR(errctx);
int64_t n = 0;
int64_t field = 0;
int index = 0;
(void)lval; (void)rval;
FAIL_ZERO_RETURN(errctx, (obj != NULL && dest != NULL), AKERR_NULLPOINTER,
"NULL argument in RSPRITE");
PASS(errctx, nth_number(obj, expr, "RSPRITE", 0, &n));
PASS(errctx, nth_number(obj, expr, "RSPRITE", 1, &field));
PASS(errctx, sprite_index((int)n, "RSPRITE", &index));
sprite = &obj->sprite_state.sprites[index];
/* The five fields are SPRITE's own arguments, in SPRITE's own order. */
switch ( field ) {
case 0:
PASS(errctx, integer_result(obj, (sprite->enabled ? 1 : 0), dest));
break;
case 1:
PASS(errctx, integer_result(obj, (int64_t)sprite->colorindex, dest));
break;
case 2:
PASS(errctx, integer_result(obj, (sprite->behind ? 1 : 0), dest));
break;
case 3:
PASS(errctx, integer_result(obj, (sprite->xexpand ? 1 : 0), dest));
break;
case 4:
PASS(errctx, integer_result(obj, (sprite->yexpand ? 1 : 0), dest));
break;
case 5:
PASS(errctx, integer_result(obj, (sprite->multicolour ? 1 : 0), dest));
break;
default:
FAIL_RETURN(errctx, AKBASIC_ERR_BOUNDS,
"RSPRITE: field %" PRId64 " is outside 0..5", field);
}
SUCCEED_RETURN(errctx);
}
akerr_ErrorContext *akbasic_fn_rspcolor(akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest)
{
PREPARE_ERROR(errctx);
int64_t field = 0;
(void)lval; (void)rval;
FAIL_ZERO_RETURN(errctx, (obj != NULL && dest != NULL), AKERR_NULLPOINTER,
"NULL argument in RSPCOLOR");
PASS(errctx, nth_number(obj, expr, "RSPCOLOR", 0, &field));
FAIL_ZERO_RETURN(errctx, (field == 1 || field == 2), AKBASIC_ERR_BOUNDS,
"RSPCOLOR: register %" PRId64 " is 1 or 2", field);
PASS(errctx, integer_result(obj,
(field == 1
? (int64_t)obj->sprite_state.sharedcolor1
: (int64_t)obj->sprite_state.sharedcolor2),
dest));
SUCCEED_RETURN(errctx);
}

275
src/runtime_structure.c Normal file
View File

@@ -0,0 +1,275 @@
/**
* @file runtime_structure.c
* @brief The group A verbs: DO, LOOP, BEGIN, BEND, ON and END.
*
* Block structure, built on the same `waitingForCommand` machinery `FOR`/`NEXT`
* uses (section 1.6): a scope records the verb it is skipping forward to, and
* nothing executes until that verb turns up. Everything here is a variation on
* that one idea.
*
* **The line-based limitation applies to all of it.** Skipping works a source
* line at a time, so a whole loop written on one line -- `DO : PRINT 1 : LOOP` --
* does not loop, exactly as `FOR I=1 TO 3 : PRINT I : NEXT I` does not. That is
* recorded in TODO.md section 4 and it wants its own piece of work: making the
* skip operate on statements rather than lines.
*
* None of these verbs is in the Go reference, which lists all of them as
* unimplemented, so the semantics come from Commodore BASIC 7.0.
*/
#include <inttypes.h>
#include <stdio.h>
#include <string.h>
#include <akerror.h>
#include <akbasic/args.h>
#include <akbasic/error.h>
#include <akbasic/runtime.h>
#include "verbs.h"
/* Most verbs answer "did something happen"; this is that answer. */
#define SUCCEED_TRUE(__obj, __dest) \
do { \
*(__dest) = &(__obj)->staticTrueValue; \
} while ( 0 )
/**
* @brief Should a loop carrying this condition keep going?
*
* `WHILE` continues while the condition holds and `UNTIL` continues until it
* does, which is the same test read two ways. A loop with no condition on that
* end always continues -- `DO ... LOOP` is an infinite loop, and `EXIT` or a
* `GOTO` is how a program leaves it.
*/
static akerr_ErrorContext *loop_continues(akbasic_Runtime *obj, akbasic_ASTLeaf *condition, int kind, bool *dest)
{
PREPARE_ERROR(errctx);
akbasic_Value *value = NULL;
FAIL_ZERO_RETURN(errctx, (obj != NULL && dest != NULL), AKERR_NULLPOINTER,
"NULL argument in loop_continues");
if ( kind == AKBASIC_LOOPCOND_NONE || condition == NULL ) {
*dest = true;
SUCCEED_RETURN(errctx);
}
PASS(errctx, akbasic_runtime_evaluate(obj, condition, &value));
*dest = akbasic_value_is_truthy(value);
if ( kind == AKBASIC_LOOPCOND_UNTIL ) {
*dest = !(*dest);
}
SUCCEED_RETURN(errctx);
}
/* -------------------------------------------------------------- DO / LOOP -- */
akerr_ErrorContext *akbasic_cmd_do(akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest)
{
PREPARE_ERROR(errctx);
bool enter = false;
(void)expr; (void)lval; (void)rval;
FAIL_ZERO_RETURN(errctx, (obj != NULL && dest != NULL), AKERR_NULLPOINTER,
"NULL argument in DO");
/*
* The parse handler has already pushed the scope and stored the condition,
* the way FOR's does -- so by the time this runs, `obj->environment` is the
* loop's own.
*/
FAIL_ZERO_RETURN(errctx, obj->environment->isDoLoop, AKBASIC_ERR_STATE,
"DO did not establish its own scope");
PASS(errctx, loop_continues(obj, obj->environment->doConditionLeaf,
obj->environment->doConditionKind, &enter));
if ( !enter ) {
/*
* `DO WHILE` with a condition that is already false runs no body at all,
* so skip forward to the LOOP rather than executing the lines between.
* Same mechanism a zero-iteration FOR uses.
*/
PASS(errctx, akbasic_environment_wait_for_command(obj->environment, "LOOP"));
}
SUCCEED_TRUE(obj, dest);
SUCCEED_RETURN(errctx);
}
akerr_ErrorContext *akbasic_cmd_loop(akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest)
{
PREPARE_ERROR(errctx);
akbasic_Value *value = NULL;
akbasic_ASTLeaf *arg = NULL;
bool again = false;
int kind = AKBASIC_LOOPCOND_NONE;
(void)lval; (void)rval;
FAIL_ZERO_RETURN(errctx, (obj != NULL && dest != NULL), AKERR_NULLPOINTER,
"NULL argument in LOOP");
FAIL_ZERO_RETURN(errctx, obj->environment->isDoLoop, AKBASIC_ERR_STATE,
"LOOP outside the context of DO");
obj->environment->loopExitLine = obj->environment->lineno + 1;
/* An EXIT sent us here; the loop is over whatever either condition says. */
if ( obj->environment->exiting ) {
obj->environment->exiting = false;
PASS(errctx, akbasic_environment_stop_waiting(obj->environment, "LOOP"));
again = false;
} else {
PASS(errctx, akbasic_environment_stop_waiting(obj->environment, "LOOP"));
/*
* LOOP's own condition, parsed here rather than by a parse handler: the
* leaf is on this line and this line is still scanned, so unlike DO's
* there is nothing to preserve across iterations.
*/
arg = (expr != NULL ? expr->right : NULL);
if ( arg != NULL ) {
kind = (int)arg->literal_int;
PASS(errctx, loop_continues(obj, arg->left, kind, &again));
} else {
/*
* A bare LOOP re-tests whatever DO carried. `DO WHILE c ... LOOP`
* has to check `c` again at the bottom or the loop never ends.
*/
PASS(errctx, loop_continues(obj, obj->environment->doConditionLeaf,
obj->environment->doConditionKind, &again));
}
}
(void)value;
if ( again ) {
obj->environment->nextline = obj->environment->loopFirstLine;
SUCCEED_TRUE(obj, dest);
SUCCEED_RETURN(errctx);
}
FAIL_ZERO_RETURN(errctx, (obj->environment->parent != NULL), AKBASIC_ERR_ENVIRONMENT,
"LOOP in an orphaned environment");
obj->environment->parent->nextline = obj->environment->loopExitLine;
PASS(errctx, akbasic_runtime_prev_environment(obj));
SUCCEED_TRUE(obj, dest);
SUCCEED_RETURN(errctx);
}
/* ----------------------------------------------------------- BEGIN / BEND -- */
akerr_ErrorContext *akbasic_cmd_begin(akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest)
{
PREPARE_ERROR(errctx);
(void)expr; (void)lval; (void)rval;
FAIL_ZERO_RETURN(errctx, (obj != NULL && dest != NULL), AKERR_NULLPOINTER,
"NULL argument in BEGIN");
/*
* Nothing to do when the block is entered. `IF c THEN BEGIN` reaches this
* only when `c` was true, and the lines that follow are then ordinary lines
* up to the BEND. The *false* case never gets here at all: the branch arms a
* skip to BEND instead -- see the BRANCH case in akbasic_runtime_evaluate().
*/
SUCCEED_TRUE(obj, dest);
SUCCEED_RETURN(errctx);
}
akerr_ErrorContext *akbasic_cmd_bend(akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest)
{
PREPARE_ERROR(errctx);
(void)expr; (void)lval; (void)rval;
FAIL_ZERO_RETURN(errctx, (obj != NULL && dest != NULL), AKERR_NULLPOINTER,
"NULL argument in BEND");
/*
* Either this is the end of a block that ran, in which case there is nothing
* to do, or it is the BEND a skipped block was skipping to, in which case
* stopping the skip is the whole job.
*/
if ( akbasic_environment_is_waiting_for(obj->environment, "BEND") ) {
PASS(errctx, akbasic_environment_stop_waiting(obj->environment, "BEND"));
}
SUCCEED_TRUE(obj, dest);
SUCCEED_RETURN(errctx);
}
/* --------------------------------------------------------------------- ON -- */
akerr_ErrorContext *akbasic_cmd_on(akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest)
{
PREPARE_ERROR(errctx);
akbasic_ASTLeaf *arg = NULL;
akbasic_Value *value = NULL;
int64_t selector = 0;
int64_t target = 0;
int64_t returnline = 0;
int index = 0;
bool gosub = false;
(void)lval; (void)rval;
FAIL_ZERO_RETURN(errctx, (obj != NULL && expr != NULL && dest != NULL), AKERR_NULLPOINTER,
"NULL argument in ON");
arg = akbasic_leaf_first_argument(expr);
FAIL_ZERO_RETURN(errctx, (arg != NULL), AKBASIC_ERR_SYNTAX,
"Expected ON (expression) GOTO|GOSUB (line) [, ...]");
/* The parse handler puts the GOSUB flag in the first argument's literal. */
gosub = (arg->literal_int != 0);
arg = arg->next;
FAIL_ZERO_RETURN(errctx, (arg != NULL), AKBASIC_ERR_SYNTAX,
"Expected ON (expression) GOTO|GOSUB (line) [, ...]");
PASS(errctx, akbasic_runtime_evaluate(obj, arg, &value));
FAIL_NONZERO_RETURN(errctx, (value->valuetype == AKBASIC_TYPE_STRING), AKBASIC_ERR_TYPE,
"ON expected a number");
selector = (value->valuetype == AKBASIC_TYPE_FLOAT)
? (int64_t)value->floatval : value->intval;
/*
* One-based, and out of range is not an error: BASIC 7.0 falls through to
* the next statement when the selector names no target, which is what makes
* `ON X GOTO 100, 200` usable without a bounds check in the program.
*/
for ( arg = arg->next, index = 1; arg != NULL; arg = arg->next, index++ ) {
if ( (int64_t)index != selector ) {
continue;
}
PASS(errctx, akbasic_runtime_evaluate(obj, arg, &value));
FAIL_NONZERO_RETURN(errctx, (value->valuetype != AKBASIC_TYPE_INTEGER),
AKBASIC_ERR_TYPE, "ON expected a line number or a label");
target = value->intval;
if ( gosub ) {
returnline = obj->environment->lineno + 1;
PASS(errctx, akbasic_runtime_new_environment(obj));
obj->environment->gosubReturnLine = returnline;
obj->environment->nextline = target;
} else {
obj->environment->nextline = target;
}
SUCCEED_TRUE(obj, dest);
SUCCEED_RETURN(errctx);
}
SUCCEED_TRUE(obj, dest);
SUCCEED_RETURN(errctx);
}
/* -------------------------------------------------------------------- END -- */
akerr_ErrorContext *akbasic_cmd_end(akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest)
{
PREPARE_ERROR(errctx);
(void)expr; (void)lval; (void)rval;
FAIL_ZERO_RETURN(errctx, (obj != NULL && dest != NULL), AKERR_NULLPOINTER,
"NULL argument in END");
/*
* The program is over, which is not the same as the interpreter being over.
* A file run ends; a REPL session goes back to its prompt. That is what
* run_finished_mode already means, and it is the difference between END and
* QUIT -- QUIT ends the interpreter whatever started it.
*
* Unlike STOP this does not arm CONT. A C128 allows CONT after END, but END
* says the program finished and CONT after a *finished* program resumes into
* whatever line happens to follow, which is a worse answer than refusing.
*/
PASS(errctx, akbasic_runtime_set_mode(obj, obj->run_finished_mode));
SUCCEED_TRUE(obj, dest);
SUCCEED_RETURN(errctx);
}

189
src/runtime_trap.c Normal file
View File

@@ -0,0 +1,189 @@
/**
* @file runtime_trap.c
* @brief The group C verbs: TRAP, RESUME, and the ERR() message lookup.
*
* Error trapping, built on the interrupt machinery COLLISION already uses:
* #AKBASIC_INTERRUPT_ERROR was declared with it and armed by nothing until now.
* A trapped error is a GOSUB the program did not write, entered at a line
* boundary, and `RESUME` is its `RETURN`.
*
* **`ER` and `EL` are ordinary global variables here, spelled `ER#` and `EL#`.**
* A C128 exposes them as bare reserved names, which this dialect cannot do: an
* identifier carries its type in a suffix and a bare name is a *label*
* (`LABEL DONE` / `GOTO DONE`). Writing them into the global scope costs nothing,
* needs no new syntax, and `PRINT ER#` reads the way the rest of the language
* does. Recorded in TODO.md section 5.
*/
#include <inttypes.h>
#include <stdio.h>
#include <string.h>
#include <akerror.h>
#include <akbasic/args.h>
#include <akbasic/error.h>
#include <akbasic/runtime.h>
#include "verbs.h"
/* Most verbs answer "did something happen"; this is that answer. */
#define SUCCEED_TRUE(__obj, __dest) \
do { \
*(__dest) = &(__obj)->staticTrueValue; \
} while ( 0 )
akerr_ErrorContext *akbasic_trap_set_error_variables(akbasic_Runtime *obj, int status, int64_t line)
{
PREPARE_ERROR(errctx);
akbasic_Variable *variable = NULL;
int64_t zerosubscript[1] = { 0 };
FAIL_ZERO_RETURN(errctx, (obj != NULL), AKERR_NULLPOINTER,
"NULL runtime in set_error_variables");
/*
* The *global* scope, not the active one. A trapped error is reported from
* wherever it happened -- inside a GOSUB body, inside a loop -- and a
* handler that reads ER# has usually been entered through a scope of its
* own. akbasic_runtime_global() walks to the root, which is the only place
* both can see.
*/
PASS(errctx, akbasic_runtime_global(obj, "ER#", &variable));
PASS(errctx, akbasic_variable_set_integer(variable, (int64_t)status, zerosubscript, 1));
PASS(errctx, akbasic_runtime_global(obj, "EL#", &variable));
PASS(errctx, akbasic_variable_set_integer(variable, line, zerosubscript, 1));
SUCCEED_RETURN(errctx);
}
/* ------------------------------------------------------------------ TRAP -- */
akerr_ErrorContext *akbasic_cmd_trap(akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest)
{
PREPARE_ERROR(errctx);
akbasic_ASTLeaf *target = NULL;
akbasic_Value *value = NULL;
(void)lval; (void)rval;
FAIL_ZERO_RETURN(errctx, (obj != NULL && dest != NULL), AKERR_NULLPOINTER,
"NULL argument in TRAP");
target = (expr != NULL ? expr->right : NULL);
if ( target == NULL ) {
/* Bare TRAP disarms, which is how a C128 turns trapping back off. */
PASS(errctx, akbasic_runtime_disarm_interrupt(obj, AKBASIC_INTERRUPT_ERROR));
SUCCEED_TRUE(obj, dest);
SUCCEED_RETURN(errctx);
}
/*
* A label is taken by name and resolved when the trap fires, exactly as
* COLLISION's handler is: an error handler sits on a line normal flow does
* not fall into.
*/
if ( target->leaftype == AKBASIC_LEAF_IDENTIFIER &&
akbasic_leaf_first_subscript(target) == NULL ) {
PASS(errctx, akbasic_runtime_arm_interrupt(obj, AKBASIC_INTERRUPT_ERROR,
0, target->identifier));
SUCCEED_TRUE(obj, dest);
SUCCEED_RETURN(errctx);
}
PASS(errctx, akbasic_runtime_evaluate(obj, target, &value));
FAIL_NONZERO_RETURN(errctx, (value->valuetype != AKBASIC_TYPE_INTEGER), AKBASIC_ERR_TYPE,
"TRAP expected a line number or a label");
PASS(errctx, akbasic_runtime_arm_interrupt(obj, AKBASIC_INTERRUPT_ERROR,
value->intval, NULL));
SUCCEED_TRUE(obj, dest);
SUCCEED_RETURN(errctx);
}
/* ---------------------------------------------------------------- RESUME -- */
akerr_ErrorContext *akbasic_cmd_resume(akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest)
{
PREPARE_ERROR(errctx);
akbasic_ASTLeaf *target = NULL;
akbasic_Value *value = NULL;
akbasic_Variable *variable = NULL;
int64_t zerosubscript[1] = { 0 };
int64_t resumeline = 0;
(void)lval; (void)rval;
FAIL_ZERO_RETURN(errctx, (obj != NULL && dest != NULL), AKERR_NULLPOINTER,
"NULL argument in RESUME");
FAIL_ZERO_RETURN(errctx, (obj->handlerenv != NULL), AKBASIC_ERR_STATE,
"RESUME outside the context of a TRAP handler");
FAIL_ZERO_RETURN(errctx, (obj->environment == obj->handlerenv), AKBASIC_ERR_STATE,
"RESUME must return from the handler itself, not from a GOSUB inside it");
FAIL_ZERO_RETURN(errctx, (obj->environment->parent != NULL), AKBASIC_ERR_ENVIRONMENT,
"RESUME from an orphaned environment");
/* Where the error happened, which EL# is holding. */
PASS(errctx, akbasic_runtime_global(obj, "EL#", &variable));
PASS(errctx, akbasic_variable_get_subscript(variable, zerosubscript, 1, &value));
resumeline = value->intval;
target = (expr != NULL ? expr->right : NULL);
if ( target == NULL ) {
/*
* Bare RESUME retries the line that failed. That is a loop unless the
* handler fixed whatever was wrong, which is the program's business and
* is exactly what the verb is for.
*/
obj->environment->parent->nextline = resumeline;
} else if ( target->leaftype == AKBASIC_LEAF_COMMAND &&
strcmp(target->identifier, "NEXT") == 0 ) {
/* RESUME NEXT carries on at the line after the one that failed. */
obj->environment->parent->nextline = resumeline + 1;
} else {
PASS(errctx, akbasic_runtime_evaluate(obj, target, &value));
FAIL_NONZERO_RETURN(errctx, (value->valuetype != AKBASIC_TYPE_INTEGER),
AKBASIC_ERR_TYPE, "RESUME expected NEXT, a line number or a label");
obj->environment->parent->nextline = value->intval;
}
obj->handlerenv = NULL;
PASS(errctx, akbasic_runtime_prev_environment(obj));
SUCCEED_TRUE(obj, dest);
SUCCEED_RETURN(errctx);
}
/* ------------------------------------------------------------------- ERR -- */
akerr_ErrorContext *akbasic_fn_err(akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest)
{
PREPARE_ERROR(errctx);
akbasic_ASTLeaf *arg = NULL;
akbasic_Value *value = NULL;
akbasic_Value *out = NULL;
const char *name = NULL;
int64_t status = 0;
(void)lval; (void)rval;
FAIL_ZERO_RETURN(errctx, (obj != NULL && expr != NULL && dest != NULL), AKERR_NULLPOINTER,
"NULL argument in ERR");
arg = akbasic_leaf_first_argument(expr);
FAIL_ZERO_RETURN(errctx, (arg != NULL), AKBASIC_ERR_SYNTAX, "ERR expected an error number");
PASS(errctx, akbasic_runtime_evaluate(obj, arg, &value));
FAIL_NONZERO_RETURN(errctx, (value->valuetype == AKBASIC_TYPE_STRING), AKBASIC_ERR_TYPE,
"ERR expected a number");
status = (value->valuetype == AKBASIC_TYPE_FLOAT)
? (int64_t)value->floatval : value->intval;
PASS(errctx, akbasic_environment_new_value(obj->environment, &out));
PASS(errctx, akbasic_value_zero(out));
out->valuetype = AKBASIC_TYPE_STRING;
/*
* The name libakerror registered for the code, which is where every status
* in this process is named -- akbasic's own band, libakgl's, and the errno
* values underneath. It answers for an unregistered code too, with "Unknown
* Error", so there is nothing to add here; the NULL guard is for a libakerror
* that ever decides otherwise.
*/
name = akerr_name_for_status((int)status, NULL);
snprintf(out->stringval, sizeof(out->stringval), "%s",
(name != NULL ? name : "Unknown Error"));
*dest = out;
SUCCEED_RETURN(errctx);
}

9
src/scanner.c
View File

@@ -340,6 +340,14 @@ akerr_ErrorContext *akbasic_scanner_scan(akbasic_Runtime *obj, const char *line,
case '*': obj->tokentype = AKBASIC_TOK_STAR; break;
case ',': obj->tokentype = AKBASIC_TOK_COMMA; break;
case ':': obj->tokentype = AKBASIC_TOK_COLON; break;
/*
* MOVSPR's two separators. Both were UNKNOWN TOKEN until sprites, so
* scanning them breaks nothing -- and a `#` only reaches this switch
* when it is not an identifier's type suffix, which match_identifier
* consumes before returning.
*/
case ';': obj->tokentype = AKBASIC_TOK_SEMICOLON; break;
case '#': obj->tokentype = AKBASIC_TOK_HASHMARK; break;
case '[': obj->tokentype = AKBASIC_TOK_LEFT_SQUAREBRACKET; break;
case ']': obj->tokentype = AKBASIC_TOK_RIGHT_SQUAREBRACKET; break;
case '=':
@@ -388,6 +396,7 @@ akerr_ErrorContext *akbasic_scanner_scan(akbasic_Runtime *obj, const char *line,
/* Everything after REM is a comment. Stop, keeping the line intact. */
break;
} else if ( obj->tokentype == AKBASIC_TOK_LINE_NUMBER ) {
obj->hadlinenumber = true;
/*
* The line number is not kept as a token. Rewrite the line to
* everything after it, minus leading spaces, and restart the

75
src/sink_akgl.c
View File

@@ -375,6 +375,74 @@ static akerr_ErrorContext *sink_clear(akbasic_TextSink *self)
SUCCEED_RETURN(errctx);
}
/**
* @brief Put the cursor at a character cell, for CHAR.
*
* Clamped rather than refused: a program that asks for a column past the edge of
* a window it cannot measure has made an ordinary mistake, and a C128 clamps too.
*/
static akerr_ErrorContext *sink_moveto(akbasic_TextSink *self, int col, int row)
{
PREPARE_ERROR(errctx);
akbasic_AkglSink *state = NULL;
FAIL_ZERO_RETURN(errctx, (self != NULL), AKERR_NULLPOINTER, "NULL sink in moveto");
state = (akbasic_AkglSink *)self->self;
FAIL_ZERO_RETURN(errctx, (state != NULL), AKERR_NULLPOINTER, "akgl sink has no state");
if ( col < 0 ) { col = 0; }
if ( row < 0 ) { row = 0; }
if ( col >= state->columns ) { col = state->columns - 1; }
if ( row >= state->rows ) { row = state->rows - 1; }
state->cursorcol = col;
state->cursorrow = row;
SUCCEED_RETURN(errctx);
}
/**
* @brief Constrain the text area to a rectangle of cells, for WINDOW.
*
* The sink already drives everything -- wrap, scroll, cursor -- from `x`, `y`,
* `columns` and `rows`, so a window is those four fields and nothing else. The
* cell size does not change, which is what keeps a windowed program's text the
* same size as an unwindowed one's.
*
* The full-screen geometry is remembered so a later WINDOW can grow back out;
* without it each call could only ever shrink.
*/
static akerr_ErrorContext *sink_window(akbasic_TextSink *self, int left, int top, int right, int bottom)
{
PREPARE_ERROR(errctx);
akbasic_AkglSink *state = NULL;
int maxcols = 0;
int maxrows = 0;
FAIL_ZERO_RETURN(errctx, (self != NULL), AKERR_NULLPOINTER, "NULL sink in window");
state = (akbasic_AkglSink *)self->self;
FAIL_ZERO_RETURN(errctx, (state != NULL), AKERR_NULLPOINTER, "akgl sink has no state");
FAIL_ZERO_RETURN(errctx, (state->cellw > 0 && state->cellh > 0), AKBASIC_ERR_STATE,
"The sink has no character grid to window");
maxcols = state->fullwidth / state->cellw;
maxrows = state->fullheight / state->cellh;
if ( left < 0 ) { left = 0; }
if ( top < 0 ) { top = 0; }
if ( right >= maxcols ) { right = maxcols - 1; }
if ( bottom >= maxrows ) { bottom = maxrows - 1; }
FAIL_ZERO_RETURN(errctx, (right >= left && bottom >= top), AKBASIC_ERR_VALUE,
"WINDOW asks for no cells at all");
state->x = state->fullx + (left * state->cellw);
state->y = state->fully + (top * state->cellh);
state->columns = (right - left) + 1;
state->rows = (bottom - top) + 1;
state->width = state->columns * state->cellw;
state->height = state->rows * state->cellh;
state->cursorcol = 0;
state->cursorrow = 0;
SUCCEED_RETURN(errctx);
}
akerr_ErrorContext *akbasic_sink_init_akgl(akbasic_TextSink *obj, akbasic_AkglSink *state, akgl_RenderBackend *renderer, TTF_Font *font, int w, int h)
{
PREPARE_ERROR(errctx);
@@ -426,6 +494,11 @@ akerr_ErrorContext *akbasic_sink_init_akgl(akbasic_TextSink *obj, akbasic_AkglSi
state->y = 0;
state->width = w;
state->height = h;
/* Remembered so WINDOW can grow back out to the whole area. */
state->fullx = state->x;
state->fully = state->y;
state->fullwidth = w;
state->fullheight = h;
state->cellw = cellw;
state->cellh = cellh;
state->columns = w / cellw;
@@ -442,6 +515,8 @@ akerr_ErrorContext *akbasic_sink_init_akgl(akbasic_TextSink *obj, akbasic_AkglSi
obj->writeln = sink_writeln;
obj->readline = sink_readline;
obj->clear = sink_clear;
obj->moveto = sink_moveto;
obj->window = sink_window;
SUCCEED_RETURN(errctx);
}

33
src/sink_tee.c
View File

@@ -90,6 +90,31 @@ static akerr_ErrorContext *tee_clear(akbasic_TextSink *self)
SUCCEED_RETURN(errctx);
}
/**
* @brief Forward a cursor move to whichever half has a cursor.
*
* Only one of them will: an akgl sink has a character grid and a stdio sink does
* not. Forwarding to both would be wrong anyway -- there is one cursor, and it
* belongs to the half that draws.
*/
static akerr_ErrorContext *tee_moveto(akbasic_TextSink *self, int col, int row)
{
PREPARE_ERROR(errctx);
akbasic_TeeSink *state = NULL;
FAIL_ZERO_RETURN(errctx, (self != NULL), AKERR_NULLPOINTER, "NULL sink in moveto");
state = (akbasic_TeeSink *)self->self;
FAIL_ZERO_RETURN(errctx, (state != NULL), AKERR_NULLPOINTER, "tee sink has no state");
if ( state->primary != NULL && state->primary->moveto != NULL ) {
PASS(errctx, state->primary->moveto(state->primary, col, row));
}
if ( state->mirror != NULL && state->mirror->moveto != NULL ) {
PASS(errctx, state->mirror->moveto(state->mirror, col, row));
}
SUCCEED_RETURN(errctx);
}
akerr_ErrorContext *akbasic_sink_init_tee(akbasic_TextSink *obj, akbasic_TeeSink *state, akbasic_TextSink *primary, akbasic_TextSink *mirror, akbasic_TextSink *reader)
{
PREPARE_ERROR(errctx);
@@ -116,5 +141,13 @@ akerr_ErrorContext *akbasic_sink_init_tee(akbasic_TextSink *obj, akbasic_TeeSink
obj->writeln = tee_writeln;
obj->readline = tee_readline;
obj->clear = tee_clear;
/*
* Offered only when a half can actually do it, so CHAR's refusal against a
* stdio-only driver still reads correctly through a tee.
*/
if ( (primary != NULL && primary->moveto != NULL) ||
(mirror != NULL && mirror->moveto != NULL) ) {
obj->moveto = tee_moveto;
}
SUCCEED_RETURN(errctx);
}

585
src/sprite_akgl.c Normal file
View File

@@ -0,0 +1,585 @@
/**
* @file sprite_akgl.c
* @brief Wires the sprite backend record to libakgl's actors.
*
* Each of BASIC's eight sprites becomes a full libakgl object graph -- a
* spritesheet holding one texture, a sprite cutting one frame from it, a
* character mapping state 0 to that sprite, and an actor instantiating the
* character -- so a host game sees BASIC's sprites in libakgl's actor registry
* alongside its own and can do anything to them it can do to an actor.
*
* **None of that comes from JSON.** akgl_sprite_load_json() is a thin wrapper
* over the same four initializers plus writes to public struct fields, and every
* field it fills from a document -- frame list, animation speed, loop flags,
* state-to-sprite map -- is something a Commodore sprite does not have. The one
* exception is the image, and that is exactly where this file *does* call
* libakgl: `SPRSAV "ship.png", 1` resolves through akgl_path_relative() and
* loads through akgl_spritesheet_initialize(), the same two calls
* akgl_sprite_load_json_spritesheet() makes.
*
* Every actor gets a renderfunc of its own rather than akgl_actor_render(). Two
* reasons, both defects filed upstream: the default computes its destination
* height from the sprite's *width*, which draws a 24x21 Commodore sprite as a
* 24x24 square; and an actor carries one scalar `scale`, which cannot express
* SPRITE's separate x- and y-expand bits. Installing a function pointer is
* libakgl's own extension point for exactly this, so nothing is forked.
*/
#include <errno.h>
#include <string.h>
#include <SDL3_image/SDL_image.h>
#include <akerror.h>
#include <akgl/error.h>
#include <akgl/game.h>
#include <akgl/heap.h>
#include <akgl/registry.h>
#include <akgl/staticstring.h>
#include <akgl/util.h>
#include <akbasic/akgl.h>
#include <akbasic/error.h>
/** @brief The colour conversion, same as src/graphics_akgl.c's. */
static SDL_Color to_sdl(akbasic_Color color)
{
SDL_Color out;
out.r = color.r;
out.g = color.g;
out.b = color.b;
out.a = color.a;
return out;
}
/** @brief Recover the backend's own state, or say that it has none. */
static akerr_ErrorContext *state_of(akbasic_SpriteBackend *self, akbasic_AkglSprites **dest)
{
PREPARE_ERROR(errctx);
FAIL_ZERO_RETURN(errctx, (self != NULL && dest != NULL), AKERR_NULLPOINTER,
"NULL argument in akgl sprite backend");
*dest = (akbasic_AkglSprites *)self->self;
FAIL_ZERO_RETURN(errctx, (*dest != NULL), AKERR_NULLPOINTER,
"akgl sprite backend has no state");
SUCCEED_RETURN(errctx);
}
/** @brief Recover the state and turn a BASIC sprite number into a slot index. */
static akerr_ErrorContext *slot_of(akbasic_SpriteBackend *self, int n, akbasic_AkglSprites **state, int *index)
{
PREPARE_ERROR(errctx);
PASS(errctx, state_of(self, state));
FAIL_ZERO_RETURN(errctx, (n >= 1 && n <= AKBASIC_MAX_SPRITES), AKBASIC_ERR_BOUNDS,
"Sprite %d is outside 1..%d", n, AKBASIC_MAX_SPRITES);
*index = n - 1;
SUCCEED_RETURN(errctx);
}
/**
* @brief Draw one BASIC sprite, in place of akgl_actor_render().
*
* Differs from the default in exactly two ways, both noted at the top of this
* file: the destination height comes from the sprite's height rather than its
* width, and the two expansion bits scale the axes independently.
*
* Like the default, it skips rather than reports: an actor with no image, one
* that is hidden, one whose slot has been reused. A frame is not the place to
* fail.
*/
static akerr_ErrorContext *spr_render_actor(akgl_Actor *obj)
{
PREPARE_ERROR(errctx);
akbasic_AkglSprites *state = NULL;
akgl_Sprite *sprite = NULL;
SDL_FRect src;
SDL_FRect dest;
int i = 0;
int found = -1;
FAIL_ZERO_RETURN(errctx, (obj != NULL), AKERR_NULLPOINTER, "NULL actor in sprite render");
if ( !obj->visible || obj->basechar == NULL ) {
SUCCEED_RETURN(errctx);
}
state = (akbasic_AkglSprites *)obj->actorData;
FAIL_ZERO_RETURN(errctx, (state != NULL), AKERR_NULLPOINTER,
"Sprite actor \"%s\" carries no backend state", obj->name);
for ( i = 0; i < AKBASIC_MAX_SPRITES; i++ ) {
if ( state->actors[i] == obj ) {
found = i;
break;
}
}
if ( found < 0 ) {
SUCCEED_RETURN(errctx);
}
sprite = state->sprites[found];
if ( sprite == NULL || sprite->sheet == NULL || sprite->sheet->texture == NULL ) {
SUCCEED_RETURN(errctx);
}
PASS(errctx, akgl_sprite_sheet_coords_for_frame(sprite, &src, 0));
dest.x = obj->x - (camera != NULL ? camera->x : 0.0f);
dest.y = obj->y - (camera != NULL ? camera->y : 0.0f);
dest.w = (float32_t)sprite->width * (state->xexpand[found] ? 2.0f : 1.0f);
dest.h = (float32_t)sprite->height * (state->yexpand[found] ? 2.0f : 1.0f);
PASS(errctx, state->renderer->draw_texture(state->renderer, sprite->sheet->texture,
&src, &dest, 0, NULL, SDL_FLIP_NONE));
SUCCEED_RETURN(errctx);
}
/** @brief Tear down slot @p i, releasing its texture with it. */
static akerr_ErrorContext *release_slot(akbasic_AkglSprites *state, int i)
{
PREPARE_ERROR(errctx);
/*
* Actor first, then character, sprite and sheet. Each borrows the one below
* it without taking a reference, so releasing in the other order leaves a
* live object pointing at a zeroed pool slot.
*/
if ( state->actors[i] != NULL ) {
PASS(errctx, akgl_heap_release_actor(state->actors[i]));
state->actors[i] = NULL;
}
if ( state->characters[i] != NULL ) {
PASS(errctx, akgl_heap_release_character(state->characters[i]));
state->characters[i] = NULL;
}
if ( state->sprites[i] != NULL ) {
PASS(errctx, akgl_heap_release_sprite(state->sprites[i]));
state->sprites[i] = NULL;
}
if ( state->sheets[i] != NULL ) {
/* This is what destroys the texture: see akgl_heap_release_spritesheet. */
PASS(errctx, akgl_heap_release_spritesheet(state->sheets[i]));
state->sheets[i] = NULL;
}
SUCCEED_RETURN(errctx);
}
/**
* @brief Build slot @p i's object graph around a sheet that is already loaded.
*
* The names are fixed 128-byte buffers, not string literals, because
* akgl_sprite_initialize() and akgl_actor_initialize() memcpy a whole
* AKGL_*_MAX_NAME_LENGTH from whatever they are handed.
*/
static akerr_ErrorContext *build_slot(akbasic_AkglSprites *state, int i, int width, int height)
{
PREPARE_ERROR(errctx);
char spritename[AKGL_SPRITE_MAX_NAME_LENGTH];
char charname[AKGL_SPRITE_MAX_NAME_LENGTH];
char actorname[AKGL_ACTOR_MAX_NAME_LENGTH];
float32_t oldx = 0.0f;
float32_t oldy = 0.0f;
bool oldvisible = false;
if ( state->actors[i] != NULL ) {
oldx = state->actors[i]->x;
oldy = state->actors[i]->y;
oldvisible = state->actors[i]->visible;
}
memset(spritename, 0, sizeof(spritename));
memset(charname, 0, sizeof(charname));
memset(actorname, 0, sizeof(actorname));
SDL_snprintf(spritename, sizeof(spritename), "akbasic:sprite:%d", i + 1);
SDL_snprintf(charname, sizeof(charname), "akbasic:character:%d", i + 1);
SDL_snprintf(actorname, sizeof(actorname), "akbasic:actor:%d", i + 1);
PASS(errctx, akgl_heap_next_sprite(&state->sprites[i]));
PASS(errctx, akgl_sprite_initialize(state->sprites[i], spritename, state->sheets[i]));
state->sprites[i]->frames = 1;
state->sprites[i]->frameids[0] = 0;
state->sprites[i]->width = (uint32_t)width;
state->sprites[i]->height = (uint32_t)height;
PASS(errctx, akgl_heap_next_character(&state->characters[i]));
PASS(errctx, akgl_character_initialize(state->characters[i], charname));
PASS(errctx, akgl_character_sprite_add(state->characters[i], state->sprites[i], 0));
PASS(errctx, akgl_heap_next_actor(&state->actors[i]));
PASS(errctx, akgl_actor_initialize(state->actors[i], actorname));
PASS(errctx, akgl_actor_set_character(state->actors[i], charname));
state->actors[i]->state = 0;
state->actors[i]->actorData = state;
state->actors[i]->renderfunc = spr_render_actor;
/*
* Position and visibility survive a redefinition. SPRSAV changes what a
* sprite looks like, not where it is or whether it is on -- a program that
* animates by swapping patterns in a loop would otherwise have to re-issue
* SPRITE and MOVSPR after every frame.
*/
state->actors[i]->x = oldx;
state->actors[i]->y = oldy;
state->actors[i]->visible = oldvisible;
SUCCEED_RETURN(errctx);
}
/** @brief Take ownership of @p surface as slot @p i's image, replacing whatever was there. */
static akerr_ErrorContext *install_surface(akbasic_AkglSprites *state, int i, SDL_Surface *surface)
{
PREPARE_ERROR(errctx);
SDL_Texture *texture = NULL;
char sheetname[AKGL_SPRITE_SHEET_MAX_FILENAME_LENGTH];
int width = 0;
int height = 0;
FAIL_ZERO_RETURN(errctx, (surface != NULL), AKERR_NULLPOINTER, "NULL surface for a sprite");
width = surface->w;
height = surface->h;
texture = SDL_CreateTextureFromSurface(state->renderer->sdl_renderer, surface);
FAIL_ZERO_RETURN(errctx, (texture != NULL), AKGL_ERR_SDL,
"Could not upload a sprite pattern: %s", SDL_GetError());
/*
* Nearest-neighbour. A sprite is a 24x21 bitmap and an expanded one is drawn
* at twice the size; smoothing it would turn a pixel into a smudge, which is
* not what anybody typing SPRSAV into a BASIC has in mind.
*/
SDL_SetTextureScaleMode(texture, SDL_SCALEMODE_NEAREST);
PASS(errctx, release_slot(state, i));
/*
* The sheet is assembled rather than initialized: akgl_spritesheet_initialize
* loads an image from a path, and this pattern came from bytes or from a
* saved region. Everything about it still matches what that function
* produces, so akgl_heap_release_spritesheet() tears it down the same way --
* which is what makes the texture's ownership one rule rather than two.
*/
PASS(errctx, akgl_heap_next_spritesheet(&state->sheets[i]));
memset(state->sheets[i], 0, sizeof(*state->sheets[i]));
memset(sheetname, 0, sizeof(sheetname));
SDL_snprintf(sheetname, sizeof(sheetname), "akbasic:sheet:%d", i + 1);
SDL_strlcpy(state->sheets[i]->name, sheetname, sizeof(state->sheets[i]->name));
state->sheets[i]->texture = texture;
state->sheets[i]->refcount = 1;
SDL_SetPointerProperty(AKGL_REGISTRY_SPRITESHEET, state->sheets[i]->name, state->sheets[i]);
PASS(errctx, build_slot(state, i, width, height));
SUCCEED_RETURN(errctx);
}
/** @brief Write one unpacked pattern into @p surface, a set bit in @p fg and a clear one in @p bg. */
static akerr_ErrorContext *paint_pattern(SDL_Surface *surface, const uint8_t *pixels, akbasic_Color fg, akbasic_Color bg)
{
PREPARE_ERROR(errctx);
int x = 0;
int y = 0;
for ( y = 0; y < AKBASIC_SPRITE_HEIGHT; y++ ) {
for ( x = 0; x < AKBASIC_SPRITE_WIDTH; x++ ) {
akbasic_Color c = (pixels[(y * AKBASIC_SPRITE_WIDTH) + x] != 0 ? fg : bg);
FAIL_ZERO_RETURN(errctx,
SDL_WriteSurfacePixel(surface, x, y, c.r, c.g, c.b, c.a),
AKGL_ERR_SDL,
"Could not write sprite pixel %d,%d: %s", x, y, SDL_GetError());
}
}
SUCCEED_RETURN(errctx);
}
static akerr_ErrorContext *spr_define(akbasic_SpriteBackend *self, int n, const uint8_t *pattern, int bytes, akbasic_Color fg, akbasic_Color bg)
{
PREPARE_ERROR(errctx);
akbasic_AkglSprites *state = NULL;
SDL_Surface *surface = NULL;
uint8_t pixels[AKBASIC_SPRITE_WIDTH * AKBASIC_SPRITE_HEIGHT];
int index = 0;
PASS(errctx, slot_of(self, n, &state, &index));
PASS(errctx, akbasic_sprite_unpack(pattern, bytes, pixels));
surface = SDL_CreateSurface(AKBASIC_SPRITE_WIDTH, AKBASIC_SPRITE_HEIGHT,
SDL_PIXELFORMAT_RGBA32);
FAIL_ZERO_RETURN(errctx, (surface != NULL), AKGL_ERR_SDL,
"Could not create a sprite surface: %s", SDL_GetError());
ATTEMPT {
/*
* The pixel loop is its own function so that it can be reached with a
* single CATCH. Written inline it would need a FAIL inside two nested
* loops inside this ATTEMPT, and the _BREAK forms expand to a C break
* that escapes only the inner loop.
*/
CATCH(errctx, paint_pattern(surface, pixels, fg, bg));
CATCH(errctx, install_surface(state, index, surface));
} CLEANUP {
SDL_DestroySurface(surface);
} PROCESS(errctx) {
} FINISH(errctx, true);
SUCCEED_RETURN(errctx);
}
static akerr_ErrorContext *spr_define_shape(akbasic_SpriteBackend *self, int n, int handle)
{
PREPARE_ERROR(errctx);
akbasic_AkglSprites *state = NULL;
int index = 0;
PASS(errctx, slot_of(self, n, &state, &index));
FAIL_ZERO_RETURN(errctx, (state->graphics != NULL), AKBASIC_ERR_DEVICE,
"SPRSAV from a saved shape needs a graphics backend, and this host supplied none");
FAIL_ZERO_RETURN(errctx, (handle >= 0 && handle < state->graphics->shapecount),
AKBASIC_ERR_VALUE,
"Shape handle %d names no saved region", handle);
FAIL_ZERO_RETURN(errctx, (state->graphics->shapes[handle] != NULL), AKBASIC_ERR_VALUE,
"Shape handle %d has been released", handle);
PASS(errctx, install_surface(state, index, state->graphics->shapes[handle]));
SUCCEED_RETURN(errctx);
}
static akerr_ErrorContext *spr_define_file(akbasic_SpriteBackend *self, int n, const char *path, const char *root)
{
PREPARE_ERROR(errctx);
akbasic_AkglSprites *state = NULL;
akgl_String *resolved = NULL;
int index = 0;
bool missing = false;
PASS(errctx, slot_of(self, n, &state, &index));
FAIL_ZERO_RETURN(errctx, (path != NULL && path[0] != '\0'), AKBASIC_ERR_VALUE,
"SPRSAV was given an empty file name");
PASS(errctx, akgl_heap_next_string(&resolved));
ATTEMPT {
CATCH(errctx, akgl_string_initialize(resolved, NULL));
/*
* The same resolution a sprite document gets for the spritesheet it
* names: the working directory first, then the directory the file doing
* the naming lives in -- here, the directory the BASIC program was
* loaded from. A program stored beside its art therefore works whether
* it was launched from its own directory or from anywhere else.
*/
CATCH(errctx, akgl_path_relative((char *)(root != NULL ? root : "."),
(char *)path, resolved));
CATCH(errctx, release_slot(state, index));
CATCH(errctx, akgl_heap_next_spritesheet(&state->sheets[index]));
/*
* And the same load. The two frame-size arguments are dead upstream --
* akgl_spritesheet_initialize does not write them -- and a Commodore
* sprite has no frame grid anyway, so the image is one whole frame.
*/
CATCH(errctx, akgl_spritesheet_initialize(state->sheets[index], 0, 0,
(char *)&resolved->data));
FAIL_ZERO_BREAK(errctx, (state->sheets[index]->texture != NULL), AKGL_ERR_SDL,
"Loaded %s but it produced no texture", path);
SDL_SetTextureScaleMode(state->sheets[index]->texture, SDL_SCALEMODE_NEAREST);
/*
* The image's own size, not 24x21. A Commodore sprite is 24x21 because
* that is what the hardware could address; there is no reason to throw
* away art that is not sprite-shaped on a machine with no such limit.
*/
CATCH(errctx, build_slot(state, index,
state->sheets[index]->texture->w,
state->sheets[index]->texture->h));
} CLEANUP {
IGNORE(akgl_heap_release_string(resolved));
} PROCESS(errctx) {
} HANDLE(errctx, ENOENT) {
/*
* Recorded rather than raised here. Returning from inside a HANDLE block
* leaves FINISH's bookkeeping undone, so the flag is set and the new
* error is raised below where an ordinary return is safe.
*/
missing = true;
} FINISH(errctx, true);
FAIL_NONZERO_RETURN(errctx, missing, AKBASIC_ERR_VALUE, "No such sprite image: %s", path);
SUCCEED_RETURN(errctx);
}
static akerr_ErrorContext *spr_show(akbasic_SpriteBackend *self, int n, bool visible)
{
PREPARE_ERROR(errctx);
akbasic_AkglSprites *state = NULL;
int index = 0;
PASS(errctx, slot_of(self, n, &state, &index));
if ( state->actors[index] != NULL ) {
state->actors[index]->visible = visible;
}
SUCCEED_RETURN(errctx);
}
static akerr_ErrorContext *spr_move(akbasic_SpriteBackend *self, int n, double x, double y)
{
PREPARE_ERROR(errctx);
akbasic_AkglSprites *state = NULL;
int index = 0;
PASS(errctx, slot_of(self, n, &state, &index));
if ( state->actors[index] != NULL ) {
state->actors[index]->x = (float32_t)x;
state->actors[index]->y = (float32_t)y;
}
SUCCEED_RETURN(errctx);
}
static akerr_ErrorContext *spr_configure(akbasic_SpriteBackend *self, int n, akbasic_Color color, bool xexpand, bool yexpand, bool behind)
{
PREPARE_ERROR(errctx);
akbasic_AkglSprites *state = NULL;
SDL_Color sdl = to_sdl(color);
int index = 0;
PASS(errctx, slot_of(self, n, &state, &index));
state->xexpand[index] = xexpand;
state->yexpand[index] = yexpand;
/*
* Colour is a texture modulation rather than a repaint: a sprite defined
* from a pattern was drawn in the colour SPRSAV was given, and SPRITE's
* colour argument tints it. For a sprite loaded from an image that means a
* white image takes the colour and a coloured one is shaded by it, which is
* what texture modulation does everywhere else.
*/
if ( state->sheets[index] != NULL && state->sheets[index]->texture != NULL ) {
SDL_SetTextureColorMod(state->sheets[index]->texture, sdl.r, sdl.g, sdl.b);
}
/*
* Priority is not honoured. A C128 draws a low-priority sprite behind the
* bitmap screen; here the text layer and the drawing surface are the same
* render target and sprites are composited on top of it every frame, so
* there is nothing to go behind. Recorded in TODO.md section 5.
*/
(void)behind;
SUCCEED_RETURN(errctx);
}
static akerr_ErrorContext *spr_shared_colors(akbasic_SpriteBackend *self, akbasic_Color c1, akbasic_Color c2)
{
PREPARE_ERROR(errctx);
akbasic_AkglSprites *state = NULL;
PASS(errctx, state_of(self, &state));
/*
* Nothing to do yet, and saying so is better than pretending. Multicolour
* mode packs two bitmap bits per pixel and selects between the sprite's own
* colour and these two shared registers; SPRSAV here takes one bit per pixel,
* so there is no second bit to select with. The state is kept by the
* interpreter, RSPCOLOR reads it back, and the day a multicolour pattern
* format exists this is where it lands.
*/
(void)c1;
(void)c2;
SUCCEED_RETURN(errctx);
}
static akerr_ErrorContext *spr_collisions(akbasic_SpriteBackend *self, uint16_t *mask)
{
PREPARE_ERROR(errctx);
akbasic_AkglSprites *state = NULL;
int i = 0;
int j = 0;
PASS(errctx, state_of(self, &state));
FAIL_ZERO_RETURN(errctx, (mask != NULL), AKERR_NULLPOINTER, "NULL mask in collisions");
*mask = 0;
/*
* Axis-aligned bounding boxes, compared here rather than through
* akgl_collide_rectangles(): that function has a documented
* corner-containment defect -- it misses a plus-shaped overlap where neither
* rectangle contains a corner of the other -- and nothing in libakgl calls
* it. Four comparisons are both correct and smaller.
*
* Box against box, not pixel against pixel. A C128 collides on set pixels,
* so two sprites whose boxes touch but whose art does not are reported as
* colliding here and would not be there. Recorded in TODO.md section 5.
*/
for ( i = 0; i < AKBASIC_MAX_SPRITES; i++ ) {
for ( j = i + 1; j < AKBASIC_MAX_SPRITES; j++ ) {
float32_t ax = 0.0f, ay = 0.0f, aw = 0.0f, ah = 0.0f;
float32_t bx = 0.0f, by = 0.0f, bw = 0.0f, bh = 0.0f;
if ( state->actors[i] == NULL || state->actors[j] == NULL ) {
continue;
}
if ( !state->actors[i]->visible || !state->actors[j]->visible ) {
continue;
}
if ( state->sprites[i] == NULL || state->sprites[j] == NULL ) {
continue;
}
ax = state->actors[i]->x;
ay = state->actors[i]->y;
aw = (float32_t)state->sprites[i]->width * (state->xexpand[i] ? 2.0f : 1.0f);
ah = (float32_t)state->sprites[i]->height * (state->yexpand[i] ? 2.0f : 1.0f);
bx = state->actors[j]->x;
by = state->actors[j]->y;
bw = (float32_t)state->sprites[j]->width * (state->xexpand[j] ? 2.0f : 1.0f);
bh = (float32_t)state->sprites[j]->height * (state->yexpand[j] ? 2.0f : 1.0f);
if ( ax < bx + bw && bx < ax + aw && ay < by + bh && by < ay + ah ) {
*mask |= (uint16_t)(1u << i);
*mask |= (uint16_t)(1u << j);
}
}
}
SUCCEED_RETURN(errctx);
}
akerr_ErrorContext *akbasic_sprite_init_akgl(akbasic_SpriteBackend *obj, akbasic_AkglSprites *state, akgl_RenderBackend *renderer, akbasic_AkglGraphics *graphics)
{
PREPARE_ERROR(errctx);
FAIL_ZERO_RETURN(errctx, (obj != NULL && state != NULL && renderer != NULL),
AKERR_NULLPOINTER, "NULL argument in sprite_init_akgl");
/* Before anything else in libakgl, so every AKGL_ERR_* has a name to print. */
PASS(errctx, akgl_error_init());
memset(state, 0, sizeof(*state));
state->renderer = renderer;
state->graphics = graphics;
memset(obj, 0, sizeof(*obj));
obj->self = state;
obj->define = spr_define;
obj->define_shape = spr_define_shape;
obj->define_file = spr_define_file;
obj->show = spr_show;
obj->move = spr_move;
obj->configure = spr_configure;
obj->shared_colors = spr_shared_colors;
obj->collisions = spr_collisions;
SUCCEED_RETURN(errctx);
}
akerr_ErrorContext *akbasic_sprite_akgl_render(akbasic_SpriteBackend *obj)
{
PREPARE_ERROR(errctx);
akbasic_AkglSprites *state = NULL;
int i = 0;
PASS(errctx, state_of(obj, &state));
for ( i = 0; i < AKBASIC_MAX_SPRITES; i++ ) {
if ( state->actors[i] == NULL ) {
continue;
}
/*
* PASS rather than CATCH: this is a loop, and CATCH expands to a break.
* Through the actor's own renderfunc rather than calling spr_render_actor
* directly, so a host that has replaced it gets what it asked for.
*/
PASS(errctx, state->actors[i]->renderfunc(state->actors[i]));
}
SUCCEED_RETURN(errctx);
}
void akbasic_sprite_akgl_shutdown(akbasic_SpriteBackend *obj)
{
akbasic_AkglSprites *state = NULL;
int i = 0;
if ( obj == NULL || obj->self == NULL ) {
return;
}
state = (akbasic_AkglSprites *)obj->self;
for ( i = 0; i < AKBASIC_MAX_SPRITES; i++ ) {
IGNORE(release_slot(state, i));
}
}

78
src/sprite_tables.c Normal file
View File

@@ -0,0 +1,78 @@
/**
* @file sprite_tables.c
* @brief The sprite state's power-on values, and the pattern bit order.
*
* The counterpart to src/graphics_tables.c: everything about sprites that is
* data rather than behaviour, kept away from the verbs so the verb file is
* verbs. Both things here are shared by every backend, which is the point --
* the bit order in particular is asserted once here rather than trusted in each
* adaptor that has to turn a pattern into pixels.
*/
#include <string.h>
#include <akerror.h>
#include <akbasic/error.h>
#include <akbasic/sprite.h>
/**
* @brief What SPRCOLOR's two registers hold before a program sets them.
*
* A C128 powers up with multicolour 1 at grey and multicolour 2 at yellow. They
* only matter to a multicolour sprite, so a program that never sets them and
* never asks for multicolour never sees them.
*
* register palette colour
* -------- ------- ------
* 1 12 medium grey
* 2 8 orange
*/
#define SHARED_COLOR_1_DEFAULT 12
#define SHARED_COLOR_2_DEFAULT 8
/** @brief The palette index a sprite has before SPRITE names one. White. */
#define SPRITE_COLOR_DEFAULT 2
akerr_ErrorContext *akbasic_sprite_state_init(akbasic_SpriteState *obj)
{
PREPARE_ERROR(errctx);
int i = 0;
FAIL_ZERO_RETURN(errctx, (obj != NULL), AKERR_NULLPOINTER, "NULL sprite state in init");
memset(obj, 0, sizeof(*obj));
for ( i = 0; i < AKBASIC_MAX_SPRITES; i++ ) {
obj->sprites[i].colorindex = SPRITE_COLOR_DEFAULT;
}
obj->sharedcolor1 = SHARED_COLOR_1_DEFAULT;
obj->sharedcolor2 = SHARED_COLOR_2_DEFAULT;
SUCCEED_RETURN(errctx);
}
akerr_ErrorContext *akbasic_sprite_unpack(const uint8_t *pattern, int bytes, uint8_t *dest)
{
PREPARE_ERROR(errctx);
int row = 0;
int col = 0;
FAIL_ZERO_RETURN(errctx, (pattern != NULL && dest != NULL), AKERR_NULLPOINTER,
"NULL argument in sprite unpack");
FAIL_ZERO_RETURN(errctx, (bytes == AKBASIC_SPRITE_PATTERN_BYTES), AKBASIC_ERR_BOUNDS,
"A sprite pattern is %d bytes, not %d",
AKBASIC_SPRITE_PATTERN_BYTES, bytes);
/*
* Three bytes per row, most significant bit leftmost -- which is to say the
* first byte of a row is its left eight pixels, and bit 7 of that byte is
* the leftmost pixel of all. That is the order a C128 keeps a sprite block
* in and the order a type-in listing's DATA statements are written in, so
* getting it backwards would mirror every published sprite.
*/
for ( row = 0; row < AKBASIC_SPRITE_HEIGHT; row++ ) {
for ( col = 0; col < AKBASIC_SPRITE_WIDTH; col++ ) {
uint8_t byte = pattern[(row * 3) + (col / 8)];
dest[(row * AKBASIC_SPRITE_WIDTH) + col] = (uint8_t)((byte >> (7 - (col % 8))) & 1);
}
}
SUCCEED_RETURN(errctx);
}

148
src/value.c
View File

@@ -25,14 +25,34 @@
* numeric payload the right operand is carrying" -- is legible, and so there is
* one place to change when TODO.md section 12 item 5 is fixed.
*/
/*
* Selected on the type, not summed. The reference adds both numeric fields --
* `rval.intval + int64(rval.floatval)` -- which happens to give the right answer
* only because whichever field is unused is always zero (TODO.md section 6
* item 5). Nothing enforces that: a value that ever carries both, or one reused
* from the pool without being zeroed, silently computes the sum of the two.
*/
static int64_t rval_as_int(akbasic_Value *rval)
{
return rval->intval + (int64_t)rval->floatval;
if ( rval->valuetype == AKBASIC_TYPE_FLOAT ) {
return (int64_t)rval->floatval;
}
if ( rval->valuetype == AKBASIC_TYPE_BOOLEAN ) {
return rval->boolvalue;
}
return rval->intval;
}
/** @brief The float counterpart of rval_as_int(); same reasoning. */
static double rval_as_float(akbasic_Value *rval)
{
return rval->floatval + (double)rval->intval;
if ( rval->valuetype == AKBASIC_TYPE_FLOAT ) {
return rval->floatval;
}
if ( rval->valuetype == AKBASIC_TYPE_BOOLEAN ) {
return (double)rval->boolvalue;
}
return (double)rval->intval;
}
/* Copy a string into a value's inline buffer. Truncation is an error. */
@@ -173,6 +193,35 @@ bool akbasic_value_is_true(akbasic_Value *self)
return (self->boolvalue == AKBASIC_TRUE);
}
bool akbasic_value_is_truthy(akbasic_Value *self)
{
if ( self == NULL ) {
return false;
}
/*
* Nonzero is true, which is Commodore's rule rather than a convenience.
* BASIC 7.0 has no separate boolean type: a comparison yields -1 or 0, `AND`
* and `OR` are the bitwise operators, and `IF A THEN` is legal for any
* numeric A. Testing only for the boolean type would make `IF A# THEN` and
* `IF A = 1 OR B = 2 THEN` -- whose OR yields an integer -- both silently
* false.
*
* A string is never true. A C128 raises a type mismatch instead; that is a
* stricter answer this interpreter could adopt later, and false is the
* conservative one meanwhile.
*/
switch ( self->valuetype ) {
case AKBASIC_TYPE_BOOLEAN:
return (self->boolvalue != 0);
case AKBASIC_TYPE_INTEGER:
return (self->intval != 0);
case AKBASIC_TYPE_FLOAT:
return (self->floatval != 0.0);
default:
return false;
}
}
/* Shared prologue for the unary operators: validate, clone into scratch. */
static akerr_ErrorContext *unary_prologue(akbasic_Value *self, akbasic_Value *scratch, akbasic_Value **dest)
{
@@ -200,6 +249,31 @@ static akerr_ErrorContext *binary_prologue(akbasic_Value *self, akbasic_Value *r
SUCCEED_RETURN(errctx);
}
/**
* @brief The integer a bitwise operator should use for @p value.
*
* BOOLEAN counts as an integer here, and that is what makes `AND` and `OR`
* double as logical operators. Commodore BASIC has no separate logical pair: it
* represents true as -1, every bit set, precisely so that `A = 1 AND B = 2`
* works out bit by bit and lands on -1 or 0. Refusing a boolean operand would
* make the commonest conditional in the language a type error.
*/
static bool bitwise_operand(akbasic_Value *value, int64_t *dest)
{
if ( value == NULL ) {
return false;
}
if ( value->valuetype == AKBASIC_TYPE_INTEGER ) {
*dest = value->intval;
return true;
}
if ( value->valuetype == AKBASIC_TYPE_BOOLEAN ) {
*dest = value->boolvalue;
return true;
}
return false;
}
akerr_ErrorContext *akbasic_value_invert(akbasic_Value *self, akbasic_Value *scratch, akbasic_Value **dest)
{
PREPARE_ERROR(errctx);
@@ -216,12 +290,21 @@ akerr_ErrorContext *akbasic_value_invert(akbasic_Value *self, akbasic_Value *scr
akerr_ErrorContext *akbasic_value_bitwise_not(akbasic_Value *self, akbasic_Value *scratch, akbasic_Value **dest)
{
PREPARE_ERROR(errctx);
int64_t a = 0;
FAIL_ZERO_RETURN(errctx, (self != NULL), AKERR_NULLPOINTER, "NULL value in bitwise not");
FAIL_ZERO_RETURN(errctx, (self->valuetype == AKBASIC_TYPE_INTEGER),
AKBASIC_ERR_TYPE, "Cannot only perform bitwise operations on integers");
FAIL_ZERO_RETURN(errctx, bitwise_operand(self, &a), AKBASIC_ERR_TYPE,
"Can only perform bitwise operations on integers and truth values");
PASS(errctx, unary_prologue(self, scratch, dest));
(*dest)->intval = ~(self->intval);
/*
* A truth value inverts to a truth value. On a C128 true is -1 -- every bit
* set -- so `NOT` of it is 0 and `NOT` of 0 is -1 either way you compute it;
* carrying the type through is what keeps `IF NOT (A = 9) THEN` reading as a
* condition rather than as an integer that happens to be nonzero.
*/
(*dest)->valuetype = self->valuetype;
(*dest)->intval = ~a;
(*dest)->boolvalue = ~a;
SUCCEED_RETURN(errctx);
}
@@ -261,40 +344,54 @@ akerr_ErrorContext *akbasic_value_shift_right(akbasic_Value *self, int64_t bits,
akerr_ErrorContext *akbasic_value_bitwise_and(akbasic_Value *self, akbasic_Value *rval, akbasic_Value *scratch, akbasic_Value **dest)
{
PREPARE_ERROR(errctx);
int64_t a = 0;
int64_t b = 0;
FAIL_ZERO_RETURN(errctx, (self != NULL), AKERR_NULLPOINTER, "NULL value in bitwise and");
FAIL_ZERO_RETURN(errctx, (rval != NULL), AKERR_NULLPOINTER, "nil rval");
FAIL_ZERO_RETURN(errctx, (self->valuetype == AKBASIC_TYPE_INTEGER),
AKBASIC_ERR_TYPE, "Cannot perform bitwise operations on string or float");
FAIL_ZERO_RETURN(errctx, (bitwise_operand(self, &a) && bitwise_operand(rval, &b)),
AKBASIC_ERR_TYPE,
"Can only perform bitwise operations on integers and truth values");
PASS(errctx, binary_prologue(self, rval, scratch, dest));
(*dest)->intval = self->intval & rval->intval;
(*dest)->valuetype = AKBASIC_TYPE_INTEGER;
(*dest)->intval = a & b;
(*dest)->boolvalue = (*dest)->intval;
SUCCEED_RETURN(errctx);
}
akerr_ErrorContext *akbasic_value_bitwise_or(akbasic_Value *self, akbasic_Value *rval, akbasic_Value *scratch, akbasic_Value **dest)
{
PREPARE_ERROR(errctx);
int64_t a = 0;
int64_t b = 0;
FAIL_ZERO_RETURN(errctx, (self != NULL), AKERR_NULLPOINTER, "NULL value in bitwise or");
FAIL_ZERO_RETURN(errctx, (rval != NULL), AKERR_NULLPOINTER, "nil rval");
FAIL_ZERO_RETURN(errctx, (self->valuetype == AKBASIC_TYPE_INTEGER),
AKBASIC_ERR_TYPE, "Can only perform bitwise operations on integers");
FAIL_ZERO_RETURN(errctx, (bitwise_operand(self, &a) && bitwise_operand(rval, &b)),
AKBASIC_ERR_TYPE,
"Can only perform bitwise operations on integers and truth values");
PASS(errctx, binary_prologue(self, rval, scratch, dest));
(*dest)->intval = self->intval | rval->intval;
(*dest)->valuetype = AKBASIC_TYPE_INTEGER;
(*dest)->intval = a | b;
(*dest)->boolvalue = (*dest)->intval;
SUCCEED_RETURN(errctx);
}
akerr_ErrorContext *akbasic_value_bitwise_xor(akbasic_Value *self, akbasic_Value *rval, akbasic_Value *scratch, akbasic_Value **dest)
{
PREPARE_ERROR(errctx);
int64_t a = 0;
int64_t b = 0;
FAIL_ZERO_RETURN(errctx, (self != NULL), AKERR_NULLPOINTER, "NULL value in bitwise xor");
FAIL_ZERO_RETURN(errctx, (rval != NULL), AKERR_NULLPOINTER, "nil rval");
FAIL_ZERO_RETURN(errctx,
(self->valuetype == AKBASIC_TYPE_INTEGER && rval->valuetype == AKBASIC_TYPE_INTEGER),
AKBASIC_ERR_TYPE, "Can only perform bitwise operations on integers");
FAIL_ZERO_RETURN(errctx, (bitwise_operand(self, &a) && bitwise_operand(rval, &b)),
AKBASIC_ERR_TYPE,
"Can only perform bitwise operations on integers and truth values");
PASS(errctx, binary_prologue(self, rval, scratch, dest));
(*dest)->intval = self->intval ^ rval->intval;
(*dest)->valuetype = AKBASIC_TYPE_INTEGER;
(*dest)->intval = a ^ b;
(*dest)->boolvalue = (*dest)->intval;
SUCCEED_RETURN(errctx);
}
@@ -310,17 +407,18 @@ akerr_ErrorContext *akbasic_value_math_plus(akbasic_Value *self, akbasic_Value *
FAIL_ZERO_RETURN(errctx, (dest != NULL), AKERR_NULLPOINTER, "NULL destination in math plus");
/*
* The asymmetry with every other operator is deliberate and load-bearing:
* mathPlus mutates self in place when self is mutable, and CommandNEXT's
* loop increment relies on that to advance the loop variable. TODO.md
* section 12 item 4.
* Always a clone, like every other operator. The reference mutates `self` in
* place when it happens to be mutable, so `A# + 1` modified `A#` whenever
* the left operand came from a variable rather than from a literal --
* TODO.md section 6 item 4, and the highest-blast-radius entry on that list.
*
* It was load-bearing: NEXT advanced its counter by calling this and letting
* the mutation land in the variable. NEXT now writes the result back itself,
* which is what made this safe to change. tests/for_next.c is the coverage
* that had to exist first.
*/
if ( !self->mutable_ ) {
PASS(errctx, akbasic_value_clone(self, scratch));
out = scratch;
} else {
out = self;
}
PASS(errctx, akbasic_value_clone(self, scratch));
out = scratch;
if ( self->valuetype == AKBASIC_TYPE_INTEGER ) {
out->intval = self->intval + rval_as_int(rval);

65
src/verbs.c
View File

@@ -35,25 +35,48 @@ static const akbasic_Verb VERBS[] = {
/* name token type arity parse handler exec handler */
{ "ABS", AKBASIC_TOK_FUNCTION, 1, NULL, akbasic_fn_abs },
{ "AND", AKBASIC_TOK_AND, -1, NULL, NULL },
{ "APPEND", AKBASIC_TOK_COMMAND, -1, akbasic_parse_arglist, akbasic_cmd_append },
{ "ATN", AKBASIC_TOK_FUNCTION, 1, NULL, akbasic_fn_atn },
{ "AUTO", AKBASIC_TOK_COMMAND_IMMEDIATE, -1, NULL, akbasic_cmd_auto },
{ "BACKUP", AKBASIC_TOK_COMMAND, -1, akbasic_parse_optional_arglist, akbasic_cmd_backup },
{ "BEGIN", AKBASIC_TOK_COMMAND, -1, NULL, akbasic_cmd_begin },
{ "BEND", AKBASIC_TOK_COMMAND, -1, NULL, akbasic_cmd_bend },
{ "BLOAD", AKBASIC_TOK_COMMAND, -1, akbasic_parse_arglist, akbasic_cmd_bload },
{ "BOOT", AKBASIC_TOK_COMMAND, -1, akbasic_parse_optional_arglist, akbasic_cmd_boot },
{ "BOX", AKBASIC_TOK_COMMAND, -1, akbasic_parse_arglist, akbasic_cmd_box },
{ "BSAVE", AKBASIC_TOK_COMMAND, -1, akbasic_parse_arglist, akbasic_cmd_bsave },
{ "BUMP", AKBASIC_TOK_FUNCTION, 1, NULL, akbasic_fn_bump },
{ "CATALOG", AKBASIC_TOK_COMMAND_IMMEDIATE, -1, akbasic_parse_optional_arglist, akbasic_cmd_directory },
{ "CHAR", AKBASIC_TOK_COMMAND, -1, akbasic_parse_arglist, akbasic_cmd_char },
{ "CHR", AKBASIC_TOK_FUNCTION, 1, NULL, akbasic_fn_chr },
{ "CIRCLE", AKBASIC_TOK_COMMAND, -1, akbasic_parse_arglist, akbasic_cmd_circle },
{ "CLR", AKBASIC_TOK_COMMAND, -1, NULL, akbasic_cmd_clr },
{ "COLLECT", AKBASIC_TOK_COMMAND, -1, akbasic_parse_optional_arglist, akbasic_cmd_collect },
{ "COLLISION", AKBASIC_TOK_COMMAND, -1, akbasic_parse_arglist, akbasic_cmd_collision },
{ "COLOR", AKBASIC_TOK_COMMAND, -1, akbasic_parse_arglist, akbasic_cmd_color },
{ "CONCAT", AKBASIC_TOK_COMMAND, -1, akbasic_parse_arglist, akbasic_cmd_concat },
{ "CONT", AKBASIC_TOK_COMMAND_IMMEDIATE, -1, NULL, akbasic_cmd_cont },
{ "COPY", AKBASIC_TOK_COMMAND, -1, akbasic_parse_arglist, akbasic_cmd_copy },
{ "COS", AKBASIC_TOK_FUNCTION, 1, NULL, akbasic_fn_cos },
{ "DATA", AKBASIC_TOK_COMMAND, -1, akbasic_parse_data, akbasic_cmd_data },
{ "DCLEAR", AKBASIC_TOK_COMMAND, -1, akbasic_parse_optional_arglist, akbasic_cmd_dclear },
{ "DCLOSE", AKBASIC_TOK_COMMAND, -1, akbasic_parse_optional_arglist, akbasic_cmd_dclose },
{ "DEF", AKBASIC_TOK_COMMAND, -1, akbasic_parse_def, akbasic_cmd_def },
{ "DELETE", AKBASIC_TOK_COMMAND_IMMEDIATE, -1, NULL, akbasic_cmd_delete },
{ "DIM", AKBASIC_TOK_COMMAND, -1, akbasic_parse_dim, akbasic_cmd_dim },
{ "DIRECTORY", AKBASIC_TOK_COMMAND_IMMEDIATE, -1, akbasic_parse_optional_arglist, akbasic_cmd_directory },
{ "DLOAD", AKBASIC_TOK_COMMAND_IMMEDIATE, -1, NULL, akbasic_cmd_dload },
{ "DO", AKBASIC_TOK_COMMAND, -1, akbasic_parse_do, akbasic_cmd_do },
{ "DOPEN", AKBASIC_TOK_COMMAND, -1, akbasic_parse_arglist, akbasic_cmd_dopen },
{ "DRAW", AKBASIC_TOK_COMMAND, -1, akbasic_parse_draw, akbasic_cmd_draw },
{ "DSAVE", AKBASIC_TOK_COMMAND_IMMEDIATE, -1, NULL, akbasic_cmd_dsave },
{ "DVERIFY", AKBASIC_TOK_COMMAND_IMMEDIATE, -1, akbasic_parse_arglist, akbasic_cmd_dverify },
{ "ELSE", AKBASIC_TOK_COMMAND, -1, NULL, NULL },
{ "END", AKBASIC_TOK_COMMAND, -1, NULL, akbasic_cmd_end },
{ "ENVELOPE", AKBASIC_TOK_COMMAND, -1, akbasic_parse_arglist, akbasic_cmd_envelope },
{ "ERR", AKBASIC_TOK_FUNCTION, 1, NULL, akbasic_fn_err },
{ "EXIT", AKBASIC_TOK_COMMAND, -1, NULL, akbasic_cmd_exit },
{ "FETCH", AKBASIC_TOK_COMMAND, -1, akbasic_parse_arglist, akbasic_cmd_fetch },
{ "FILTER", AKBASIC_TOK_COMMAND, -1, akbasic_parse_arglist, akbasic_cmd_filter },
{ "FOR", AKBASIC_TOK_COMMAND, -1, akbasic_parse_for, akbasic_cmd_for },
{ "GET", AKBASIC_TOK_COMMAND, -1, NULL, akbasic_cmd_get },
@@ -62,23 +85,37 @@ static const akbasic_Verb VERBS[] = {
{ "GOTO", AKBASIC_TOK_COMMAND, -1, NULL, akbasic_cmd_goto },
{ "GRAPHIC", AKBASIC_TOK_COMMAND, -1, akbasic_parse_arglist, akbasic_cmd_graphic },
{ "GSHAPE", AKBASIC_TOK_COMMAND, -1, akbasic_parse_arglist, akbasic_cmd_gshape },
{ "HEADER", AKBASIC_TOK_COMMAND, -1, akbasic_parse_optional_arglist, akbasic_cmd_header },
{ "HELP", AKBASIC_TOK_COMMAND_IMMEDIATE, -1, NULL, akbasic_cmd_help },
{ "HEX", AKBASIC_TOK_FUNCTION, 1, NULL, akbasic_fn_hex },
{ "IF", AKBASIC_TOK_COMMAND, -1, akbasic_parse_if, akbasic_cmd_if },
{ "INPUT", AKBASIC_TOK_COMMAND, -1, akbasic_parse_input, akbasic_cmd_input },
/*
* `INPUT#` and `PRINT#` are never scanned as verb names -- the scanner reads
* a `#` as a type suffix and refuses a verb carrying one -- so these rows are
* reached only from akbasic_parse_input() and akbasic_parse_print(), which
* build a leaf with the name directly. They still have to be here, and in
* order, because dispatch is a bsearch on the leaf's name.
*/
{ "INPUT#", AKBASIC_TOK_COMMAND, -1, NULL, akbasic_cmd_input_channel },
{ "INSTR", AKBASIC_TOK_FUNCTION, 2, NULL, akbasic_fn_instr },
{ "KEY", AKBASIC_TOK_COMMAND, -1, akbasic_parse_optional_arglist, akbasic_cmd_key },
{ "LABEL", AKBASIC_TOK_COMMAND, -1, akbasic_parse_label, akbasic_cmd_label },
{ "LEFT", AKBASIC_TOK_FUNCTION, 2, NULL, akbasic_fn_left },
{ "LEN", AKBASIC_TOK_FUNCTION, 1, NULL, akbasic_fn_len },
{ "LET", AKBASIC_TOK_COMMAND, -1, akbasic_parse_let, akbasic_cmd_let },
{ "LIST", AKBASIC_TOK_COMMAND_IMMEDIATE, -1, NULL, akbasic_cmd_list },
{ "LOAD", AKBASIC_TOK_COMMAND_IMMEDIATE, -1, NULL, akbasic_cmd_dload },
{ "LOCATE", AKBASIC_TOK_COMMAND, -1, akbasic_parse_arglist, akbasic_cmd_locate },
{ "LOG", AKBASIC_TOK_FUNCTION, 1, NULL, akbasic_fn_log },
{ "LOOP", AKBASIC_TOK_COMMAND, -1, akbasic_parse_loop, akbasic_cmd_loop },
{ "MID", AKBASIC_TOK_FUNCTION, 3, NULL, akbasic_fn_mid },
{ "MOD", AKBASIC_TOK_FUNCTION, 2, NULL, akbasic_fn_mod },
{ "MOVSPR", AKBASIC_TOK_COMMAND, -1, akbasic_parse_movspr, akbasic_cmd_movspr },
{ "NEW", AKBASIC_TOK_COMMAND_IMMEDIATE, -1, NULL, akbasic_cmd_new },
{ "NEXT", AKBASIC_TOK_COMMAND, -1, NULL, akbasic_cmd_next },
{ "NOT", AKBASIC_TOK_NOT, -1, NULL, NULL },
{ "ON", AKBASIC_TOK_COMMAND, -1, akbasic_parse_on, akbasic_cmd_on },
{ "OR", AKBASIC_TOK_OR, -1, NULL, NULL },
{ "PAINT", AKBASIC_TOK_COMMAND, -1, akbasic_parse_arglist, akbasic_cmd_paint },
{ "PEEK", AKBASIC_TOK_FUNCTION, 1, NULL, akbasic_fn_peek },
@@ -86,35 +123,61 @@ static const akbasic_Verb VERBS[] = {
{ "POINTER", AKBASIC_TOK_FUNCTION, 1, NULL, akbasic_fn_pointer },
{ "POINTERVAR", AKBASIC_TOK_FUNCTION, 1, NULL, akbasic_fn_pointervar },
{ "POKE", AKBASIC_TOK_COMMAND, -1, akbasic_parse_poke, akbasic_cmd_poke },
{ "PRINT", AKBASIC_TOK_COMMAND, -1, NULL, akbasic_cmd_print },
{ "PRINT", AKBASIC_TOK_COMMAND, -1, akbasic_parse_print, akbasic_cmd_print },
{ "PRINT#", AKBASIC_TOK_COMMAND, -1, NULL, akbasic_cmd_print_channel },
{ "PUDEF", AKBASIC_TOK_COMMAND, -1, NULL, akbasic_cmd_pudef },
{ "QUIT", AKBASIC_TOK_COMMAND_IMMEDIATE, -1, NULL, akbasic_cmd_quit },
{ "RAD", AKBASIC_TOK_FUNCTION, 1, NULL, akbasic_fn_rad },
{ "READ", AKBASIC_TOK_COMMAND, -1, akbasic_parse_read, akbasic_cmd_read },
{ "RECORD", AKBASIC_TOK_COMMAND, -1, akbasic_parse_arglist, akbasic_cmd_record },
{ "REM", AKBASIC_TOK_REM, -1, NULL, NULL },
{ "RENAME", AKBASIC_TOK_COMMAND, -1, akbasic_parse_arglist, akbasic_cmd_rename },
{ "RENUMBER", AKBASIC_TOK_COMMAND_IMMEDIATE, -1, akbasic_parse_optional_arglist, akbasic_cmd_renumber },
{ "RESTORE", AKBASIC_TOK_COMMAND, -1, NULL, akbasic_cmd_restore },
{ "RESUME", AKBASIC_TOK_COMMAND, -1, akbasic_parse_resume, akbasic_cmd_resume },
{ "RETURN", AKBASIC_TOK_COMMAND, -1, NULL, akbasic_cmd_return },
{ "RIGHT", AKBASIC_TOK_FUNCTION, 2, NULL, akbasic_fn_right },
{ "RSPCOLOR", AKBASIC_TOK_FUNCTION, 1, NULL, akbasic_fn_rspcolor },
{ "RSPPOS", AKBASIC_TOK_FUNCTION, 2, NULL, akbasic_fn_rsppos },
{ "RSPRITE", AKBASIC_TOK_FUNCTION, 2, NULL, akbasic_fn_rsprite },
{ "RUN", AKBASIC_TOK_COMMAND_IMMEDIATE, -1, NULL, akbasic_cmd_run },
{ "SAVE", AKBASIC_TOK_COMMAND_IMMEDIATE, -1, NULL, akbasic_cmd_dsave },
{ "SCALE", AKBASIC_TOK_COMMAND, -1, akbasic_parse_arglist, akbasic_cmd_scale },
{ "SCNCLR", AKBASIC_TOK_COMMAND, -1, NULL, akbasic_cmd_scnclr },
{ "SCRATCH", AKBASIC_TOK_COMMAND, -1, akbasic_parse_arglist, akbasic_cmd_scratch },
{ "SGN", AKBASIC_TOK_FUNCTION, 1, NULL, akbasic_fn_sgn },
{ "SHL", AKBASIC_TOK_FUNCTION, 2, NULL, akbasic_fn_shl },
{ "SHR", AKBASIC_TOK_FUNCTION, 2, NULL, akbasic_fn_shr },
{ "SIN", AKBASIC_TOK_FUNCTION, 1, NULL, akbasic_fn_sin },
{ "SLEEP", AKBASIC_TOK_COMMAND, -1, akbasic_parse_arglist, akbasic_cmd_sleep },
{ "SOUND", AKBASIC_TOK_COMMAND, -1, akbasic_parse_arglist, akbasic_cmd_sound },
{ "SPC", AKBASIC_TOK_FUNCTION, 1, NULL, akbasic_fn_spc },
{ "SPRCOLOR", AKBASIC_TOK_COMMAND, -1, akbasic_parse_arglist, akbasic_cmd_sprcolor },
{ "SPRITE", AKBASIC_TOK_COMMAND, -1, akbasic_parse_arglist, akbasic_cmd_sprite },
{ "SPRSAV", AKBASIC_TOK_COMMAND, -1, akbasic_parse_arglist, akbasic_cmd_sprsav },
{ "SSHAPE", AKBASIC_TOK_COMMAND, -1, akbasic_parse_arglist, akbasic_cmd_sshape },
{ "STASH", AKBASIC_TOK_COMMAND, -1, akbasic_parse_arglist, akbasic_cmd_stash },
{ "STEP", AKBASIC_TOK_COMMAND, -1, NULL, NULL },
{ "STOP", AKBASIC_TOK_COMMAND, -1, NULL, akbasic_cmd_stop },
{ "STR", AKBASIC_TOK_FUNCTION, 1, NULL, akbasic_fn_str },
{ "SWAP", AKBASIC_TOK_COMMAND, -1, akbasic_parse_arglist, akbasic_cmd_swap },
{ "SYS", AKBASIC_TOK_COMMAND, -1, akbasic_parse_arglist, akbasic_cmd_sys },
{ "TAN", AKBASIC_TOK_FUNCTION, 1, NULL, akbasic_fn_tan },
{ "TEMPO", AKBASIC_TOK_COMMAND, -1, akbasic_parse_arglist, akbasic_cmd_tempo },
{ "THEN", AKBASIC_TOK_COMMAND, -1, NULL, NULL },
{ "TO", AKBASIC_TOK_COMMAND, -1, NULL, NULL },
{ "TRAP", AKBASIC_TOK_COMMAND, -1, NULL, akbasic_cmd_trap },
{ "TROFF", AKBASIC_TOK_COMMAND, -1, NULL, akbasic_cmd_troff },
{ "TRON", AKBASIC_TOK_COMMAND, -1, NULL, akbasic_cmd_tron },
{ "UNTIL", AKBASIC_TOK_COMMAND, -1, NULL, NULL },
{ "USING", AKBASIC_TOK_COMMAND, -1, NULL, NULL },
{ "VAL", AKBASIC_TOK_FUNCTION, 1, NULL, akbasic_fn_val },
{ "VERIFY", AKBASIC_TOK_COMMAND_IMMEDIATE, -1, akbasic_parse_arglist, akbasic_cmd_dverify },
{ "VOL", AKBASIC_TOK_COMMAND, -1, akbasic_parse_arglist, akbasic_cmd_vol },
{ "WAIT", AKBASIC_TOK_COMMAND, -1, akbasic_parse_arglist, akbasic_cmd_wait },
{ "WHILE", AKBASIC_TOK_COMMAND, -1, NULL, NULL },
{ "WIDTH", AKBASIC_TOK_COMMAND, -1, akbasic_parse_arglist, akbasic_cmd_width },
{ "WINDOW", AKBASIC_TOK_COMMAND, -1, akbasic_parse_arglist, akbasic_cmd_window },
{ "XOR", AKBASIC_TOK_FUNCTION, 2, NULL, akbasic_fn_xor },
};

70
src/verbs.h
View File

@@ -23,16 +23,85 @@ akerr_ErrorContext AKERR_NOIGNORE *akbasic_parse_dim(struct akbasic_Parser *pars
akerr_ErrorContext AKERR_NOIGNORE *akbasic_parse_for(struct akbasic_Parser *parser, akbasic_ASTLeaf **dest);
akerr_ErrorContext AKERR_NOIGNORE *akbasic_parse_if(struct akbasic_Parser *parser, akbasic_ASTLeaf **dest);
akerr_ErrorContext AKERR_NOIGNORE *akbasic_parse_input(struct akbasic_Parser *parser, akbasic_ASTLeaf **dest);
akerr_ErrorContext AKERR_NOIGNORE *akbasic_parse_optional_arglist(struct akbasic_Parser *parser, akbasic_ASTLeaf **dest);
akerr_ErrorContext AKERR_NOIGNORE *akbasic_parse_label(struct akbasic_Parser *parser, akbasic_ASTLeaf **dest);
akerr_ErrorContext AKERR_NOIGNORE *akbasic_parse_let(struct akbasic_Parser *parser, akbasic_ASTLeaf **dest);
akerr_ErrorContext AKERR_NOIGNORE *akbasic_parse_poke(struct akbasic_Parser *parser, akbasic_ASTLeaf **dest);
akerr_ErrorContext AKERR_NOIGNORE *akbasic_parse_do(struct akbasic_Parser *parser, akbasic_ASTLeaf **dest);
akerr_ErrorContext AKERR_NOIGNORE *akbasic_parse_loop(struct akbasic_Parser *parser, akbasic_ASTLeaf **dest);
akerr_ErrorContext AKERR_NOIGNORE *akbasic_parse_resume(struct akbasic_Parser *parser, akbasic_ASTLeaf **dest);
akerr_ErrorContext AKERR_NOIGNORE *akbasic_parse_on(struct akbasic_Parser *parser, akbasic_ASTLeaf **dest);
akerr_ErrorContext AKERR_NOIGNORE *akbasic_parse_movspr(struct akbasic_Parser *parser, akbasic_ASTLeaf **dest);
akerr_ErrorContext AKERR_NOIGNORE *akbasic_parse_print(struct akbasic_Parser *parser, akbasic_ASTLeaf **dest);
akerr_ErrorContext AKERR_NOIGNORE *akbasic_parse_read(struct akbasic_Parser *parser, akbasic_ASTLeaf **dest);
/* Group F disk verbs -- src/runtime_disk.c */
akerr_ErrorContext AKERR_NOIGNORE *akbasic_cmd_append(struct akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest);
akerr_ErrorContext AKERR_NOIGNORE *akbasic_cmd_backup(struct akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest);
akerr_ErrorContext AKERR_NOIGNORE *akbasic_cmd_bload(struct akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest);
akerr_ErrorContext AKERR_NOIGNORE *akbasic_cmd_boot(struct akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest);
akerr_ErrorContext AKERR_NOIGNORE *akbasic_cmd_bsave(struct akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest);
akerr_ErrorContext AKERR_NOIGNORE *akbasic_cmd_collect(struct akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest);
akerr_ErrorContext AKERR_NOIGNORE *akbasic_cmd_concat(struct akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest);
akerr_ErrorContext AKERR_NOIGNORE *akbasic_cmd_copy(struct akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest);
akerr_ErrorContext AKERR_NOIGNORE *akbasic_cmd_dclear(struct akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest);
akerr_ErrorContext AKERR_NOIGNORE *akbasic_cmd_dclose(struct akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest);
akerr_ErrorContext AKERR_NOIGNORE *akbasic_cmd_directory(struct akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest);
akerr_ErrorContext AKERR_NOIGNORE *akbasic_cmd_dopen(struct akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest);
akerr_ErrorContext AKERR_NOIGNORE *akbasic_cmd_input_channel(struct akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest);
akerr_ErrorContext AKERR_NOIGNORE *akbasic_cmd_print_channel(struct akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest);
akerr_ErrorContext AKERR_NOIGNORE *akbasic_cmd_dverify(struct akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest);
akerr_ErrorContext AKERR_NOIGNORE *akbasic_cmd_header(struct akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest);
akerr_ErrorContext AKERR_NOIGNORE *akbasic_cmd_record(struct akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest);
akerr_ErrorContext AKERR_NOIGNORE *akbasic_cmd_rename(struct akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest);
akerr_ErrorContext AKERR_NOIGNORE *akbasic_cmd_scratch(struct akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest);
/* Group J machine verbs -- src/runtime_machine.c */
akerr_ErrorContext AKERR_NOIGNORE *akbasic_cmd_fetch(struct akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest);
akerr_ErrorContext AKERR_NOIGNORE *akbasic_cmd_stash(struct akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest);
akerr_ErrorContext AKERR_NOIGNORE *akbasic_cmd_sys(struct akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest);
/* Group E console verbs -- src/runtime_console.c */
akerr_ErrorContext AKERR_NOIGNORE *akbasic_cmd_key(struct akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest);
akerr_ErrorContext AKERR_NOIGNORE *akbasic_cmd_sleep(struct akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest);
akerr_ErrorContext AKERR_NOIGNORE *akbasic_cmd_wait(struct akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest);
akerr_ErrorContext AKERR_NOIGNORE *akbasic_cmd_window(struct akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest);
/* Group D format verbs -- src/runtime_format.c */
akerr_ErrorContext AKERR_NOIGNORE *akbasic_cmd_char(struct akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest);
akerr_ErrorContext AKERR_NOIGNORE *akbasic_cmd_pudef(struct akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest);
akerr_ErrorContext AKERR_NOIGNORE *akbasic_cmd_width(struct akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest);
/* Group C error verbs -- src/runtime_trap.c */
akerr_ErrorContext AKERR_NOIGNORE *akbasic_cmd_resume(struct akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest);
akerr_ErrorContext AKERR_NOIGNORE *akbasic_cmd_trap(struct akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest);
akerr_ErrorContext AKERR_NOIGNORE *akbasic_fn_err(struct akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest);
/* Group A structure verbs -- src/runtime_structure.c */
akerr_ErrorContext AKERR_NOIGNORE *akbasic_cmd_begin(struct akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest);
akerr_ErrorContext AKERR_NOIGNORE *akbasic_cmd_bend(struct akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest);
akerr_ErrorContext AKERR_NOIGNORE *akbasic_cmd_do(struct akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest);
akerr_ErrorContext AKERR_NOIGNORE *akbasic_cmd_end(struct akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest);
akerr_ErrorContext AKERR_NOIGNORE *akbasic_cmd_loop(struct akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest);
akerr_ErrorContext AKERR_NOIGNORE *akbasic_cmd_on(struct akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest);
/* Group H sprite verbs and readbacks -- src/runtime_sprite.c */
akerr_ErrorContext AKERR_NOIGNORE *akbasic_cmd_collision(struct akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest);
akerr_ErrorContext AKERR_NOIGNORE *akbasic_cmd_movspr(struct akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest);
akerr_ErrorContext AKERR_NOIGNORE *akbasic_cmd_sprcolor(struct akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest);
akerr_ErrorContext AKERR_NOIGNORE *akbasic_cmd_sprite(struct akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest);
akerr_ErrorContext AKERR_NOIGNORE *akbasic_cmd_sprsav(struct akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest);
akerr_ErrorContext AKERR_NOIGNORE *akbasic_fn_bump(struct akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest);
akerr_ErrorContext AKERR_NOIGNORE *akbasic_fn_rspcolor(struct akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest);
akerr_ErrorContext AKERR_NOIGNORE *akbasic_fn_rsppos(struct akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest);
akerr_ErrorContext AKERR_NOIGNORE *akbasic_fn_rsprite(struct akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest);
/* Verb handlers -- src/runtime_housekeeping.c */
akerr_ErrorContext AKERR_NOIGNORE *akbasic_cmd_clr(struct akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest);
akerr_ErrorContext AKERR_NOIGNORE *akbasic_cmd_cont(struct akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest);
akerr_ErrorContext AKERR_NOIGNORE *akbasic_cmd_help(struct akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest);
akerr_ErrorContext AKERR_NOIGNORE *akbasic_cmd_new(struct akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest);
akerr_ErrorContext AKERR_NOIGNORE *akbasic_cmd_renumber(struct akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest);
akerr_ErrorContext AKERR_NOIGNORE *akbasic_cmd_swap(struct akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest);
akerr_ErrorContext AKERR_NOIGNORE *akbasic_cmd_troff(struct akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest);
akerr_ErrorContext AKERR_NOIGNORE *akbasic_cmd_tron(struct akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest);
@@ -59,6 +128,7 @@ akerr_ErrorContext AKERR_NOIGNORE *akbasic_cmd_poke(struct akbasic_Runtime *obj,
akerr_ErrorContext AKERR_NOIGNORE *akbasic_cmd_print(struct akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest);
akerr_ErrorContext AKERR_NOIGNORE *akbasic_cmd_quit(struct akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest);
akerr_ErrorContext AKERR_NOIGNORE *akbasic_cmd_read(struct akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest);
akerr_ErrorContext AKERR_NOIGNORE *akbasic_cmd_restore(struct akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest);
akerr_ErrorContext AKERR_NOIGNORE *akbasic_cmd_return(struct akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest);
akerr_ErrorContext AKERR_NOIGNORE *akbasic_cmd_run(struct akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest);
akerr_ErrorContext AKERR_NOIGNORE *akbasic_cmd_stop(struct akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest);