Tachikoma
d219f80777
Some checks failed
akbasic CI Build / cmake_build (push) Failing after 3m27s
akbasic CI Build / coverage (push) Failing after 3m44s
akbasic CI Build / sanitizers (push) Failing after 4m43s
akbasic CI Build / mutation_test (push) Failing after 3m45s
akbasic CI Build / akgl_build (push) Failing after 4m51s
akbasic's src/ now calls libakstdlib 313 times and raw libc 7 -- 2.2% bypassed, against 86.4% on the same tree before this. The submodule bump 669b2b3 -> 2b79aca needed no source change of its own: the release is drop-in for what akbasic already used. Seven of the eight sites the earlier port left on raw libc change their own signature rather than swallowing an error, per andrew's ruling on libakstdlib#38. word_is, the is_waiting_for pair, the scanner's is_at_end, peek, peek_next and match_next_char, format.c's overflow, and sink_akgl's scroll/newline/putchar_at/echo_line/edit_key chain all return an akerr_ErrorContext * and hand the answer back through an out parameter. is_waiting_for and is_waiting_for_any are a public header change; every call site that used one as a term in a condition hoists it into a statement first. verb_compare is the eighth and stays on strcmp. bsearch(3) fixes the comparator's signature, so there is no out parameter to report through -- which is what libakstdlib#38 concluded. It carries a comment saying so and saying why the bypass is safe there. Six snprintf sites stay raw because they want truncation as an answer rather than an error, and aksl_snprintf cannot express that until libakstdlib#34 hands the required length back. Each of the six says so at the site. Two of them, in host.c, are a latent defect rather than a decision: a host type name over 31 characters truncates silently and two sharing a prefix then collide, where structtype.c refuses the same case. DLOAD leaked a file descriptor. Its read loop sat inside an ATTEMPT and the PASS in it returned past CLEANUP, so a scan error left the file open. Hoisting the loop into its own helper to convert fgets fixes it. Refs libakstdlib#26, libakstdlib#38 Co-Authored-By: Claude Opus 5 (1M context) <noreply@anthropic.com>
1936 lines
75 KiB
C
1936 lines
75 KiB
C
/**
|
|
* @file runtime.c
|
|
* @brief Implements the interpreter core: pools, evaluation and the step loop.
|
|
*/
|
|
|
|
#include <ctype.h>
|
|
#include <inttypes.h>
|
|
#include <stdio.h>
|
|
|
|
#include <akerror.h>
|
|
#include <akstdlib.h>
|
|
|
|
#include <akbasic/error.h>
|
|
#include <akbasic/parser.h>
|
|
#include <akbasic/runtime.h>
|
|
#include <akbasic/scanner.h>
|
|
#include <akbasic/verbs.h>
|
|
|
|
/* ------------------------------------------------------------------ pools -- */
|
|
|
|
akerr_ErrorContext *akbasic_runtime_new_variable(akbasic_Runtime *obj, akbasic_Variable **dest)
|
|
{
|
|
PREPARE_ERROR(errctx);
|
|
int i = 0;
|
|
|
|
FAIL_ZERO_RETURN(errctx, (obj != NULL && dest != NULL), AKERR_NULLPOINTER,
|
|
"NULL argument in new_variable");
|
|
for ( i = 0; i < AKBASIC_MAX_VARIABLES; i++ ) {
|
|
if ( !obj->variables[i].used ) {
|
|
PASS(errctx, aksl_memset(&obj->variables[i], 0, sizeof(obj->variables[i])));
|
|
obj->variables[i].used = true;
|
|
/*
|
|
* Not zero: zero is a valid structure type index, so a memset alone
|
|
* would hand back a fresh variable already claiming to be the first
|
|
* TYPE the program declared -- and `DIM P@ AS RECT` would then refuse
|
|
* it as a re-DIM of something never DIMmed at all.
|
|
*/
|
|
obj->variables[i].structtype = -1;
|
|
*dest = &obj->variables[i];
|
|
SUCCEED_RETURN(errctx);
|
|
}
|
|
}
|
|
FAIL_RETURN(errctx, AKBASIC_ERR_BOUNDS, "Maximum runtime variables reached");
|
|
}
|
|
|
|
akerr_ErrorContext *akbasic_runtime_global(akbasic_Runtime *obj, const char *name, akbasic_Variable **dest)
|
|
{
|
|
PREPARE_ERROR(errctx);
|
|
akbasic_Environment *root = NULL;
|
|
|
|
FAIL_ZERO_RETURN(errctx, (obj != NULL && name != NULL && dest != NULL), AKERR_NULLPOINTER,
|
|
"NULL argument in runtime global");
|
|
FAIL_ZERO_RETURN(errctx, (obj->environment != NULL), AKERR_NULLPOINTER,
|
|
"Runtime has no environment; call akbasic_runtime_init() first");
|
|
|
|
/*
|
|
* Walk to the root rather than using obj->environment. That is the whole
|
|
* point: a script suspended part-way through a bounded run() is usually
|
|
* inside a FOR or GOSUB body, and a variable created there dies when the
|
|
* body pops -- silently, with the script reading it correctly right up
|
|
* until it stops. See the note on the declaration.
|
|
*/
|
|
for ( root = obj->environment; root->parent != NULL; root = root->parent ) {
|
|
}
|
|
PASS(errctx, akbasic_environment_create(root, name, dest));
|
|
SUCCEED_RETURN(errctx);
|
|
}
|
|
|
|
akerr_ErrorContext *akbasic_runtime_reserve_globals(akbasic_Runtime *obj)
|
|
{
|
|
PREPARE_ERROR(errctx);
|
|
akbasic_Variable *variable = NULL;
|
|
|
|
FAIL_ZERO_RETURN(errctx, (obj != NULL), AKERR_NULLPOINTER, "NULL runtime in reserve_globals");
|
|
/*
|
|
* ER# and EL# exist from the start, because the moment they are needed is
|
|
* the moment the interpreter is least able to make them.
|
|
*
|
|
* akbasic_trap_set_error_variables() reaches them through
|
|
* akbasic_runtime_global(), which *creates* a name the program never used --
|
|
* and creating one costs a variable slot. So a program that filled the
|
|
* variable table and then raised could not have its handler entered at all,
|
|
* and because the failure happened inside the error path rather than raising,
|
|
* the program carried on with the failing statement's effect quietly
|
|
* missing. A wrong answer delivered as a right one. TODO.md section 6 item
|
|
* 33 has the reduction.
|
|
*
|
|
* Called again from CLR and NEW, which empty the table this fills.
|
|
*/
|
|
PASS(errctx, akbasic_runtime_global(obj, "ER#", &variable));
|
|
PASS(errctx, akbasic_runtime_global(obj, "EL#", &variable));
|
|
SUCCEED_RETURN(errctx);
|
|
}
|
|
|
|
akerr_ErrorContext *akbasic_runtime_new_function(akbasic_Runtime *obj, akbasic_FunctionDef **dest)
|
|
{
|
|
PREPARE_ERROR(errctx);
|
|
int i = 0;
|
|
|
|
FAIL_ZERO_RETURN(errctx, (obj != NULL && dest != NULL), AKERR_NULLPOINTER,
|
|
"NULL argument in new_function");
|
|
for ( i = 0; i < AKBASIC_MAX_FUNCTIONS; i++ ) {
|
|
if ( !obj->functions[i].used ) {
|
|
PASS(errctx, aksl_memset(&obj->functions[i], 0, sizeof(obj->functions[i])));
|
|
obj->functions[i].used = true;
|
|
obj->functions[i].leafpool.next = 0;
|
|
obj->functions[i].leafpool.capacity = AKBASIC_MAX_LEAVES * 2;
|
|
obj->functions[i].leafpool.leaves = obj->functions[i].leafstorage;
|
|
*dest = &obj->functions[i];
|
|
SUCCEED_RETURN(errctx);
|
|
}
|
|
}
|
|
FAIL_RETURN(errctx, AKBASIC_ERR_BOUNDS, "Maximum function definitions reached");
|
|
}
|
|
|
|
static akerr_ErrorContext *env_acquire(akbasic_Runtime *obj, akbasic_Environment **dest)
|
|
{
|
|
PREPARE_ERROR(errctx);
|
|
int i = 0;
|
|
|
|
for ( i = 0; i < AKBASIC_MAX_ENVIRONMENTS; i++ ) {
|
|
if ( !obj->environments[i].used ) {
|
|
obj->environments[i].used = true;
|
|
*dest = &obj->environments[i];
|
|
SUCCEED_RETURN(errctx);
|
|
}
|
|
}
|
|
FAIL_RETURN(errctx, AKBASIC_ERR_ENVIRONMENT,
|
|
"Environment pool exhausted at line %" PRId64 " (%d in use)",
|
|
(obj->environment == NULL ? 0 : obj->environment->lineno),
|
|
AKBASIC_MAX_ENVIRONMENTS);
|
|
}
|
|
|
|
akerr_ErrorContext *akbasic_runtime_new_environment(akbasic_Runtime *obj)
|
|
{
|
|
PREPARE_ERROR(errctx);
|
|
akbasic_Environment *env = NULL;
|
|
|
|
FAIL_ZERO_RETURN(errctx, (obj != NULL), AKERR_NULLPOINTER, "NULL runtime in new_environment");
|
|
PASS(errctx, env_acquire(obj, &env));
|
|
PASS(errctx, akbasic_environment_init(env, obj, obj->environment));
|
|
obj->environment = env;
|
|
SUCCEED_RETURN(errctx);
|
|
}
|
|
|
|
akerr_ErrorContext *akbasic_runtime_prev_environment(akbasic_Runtime *obj)
|
|
{
|
|
PREPARE_ERROR(errctx);
|
|
akbasic_Environment *popped = NULL;
|
|
int i = 0;
|
|
|
|
FAIL_ZERO_RETURN(errctx, (obj != NULL), AKERR_NULLPOINTER, "NULL runtime in prev_environment");
|
|
FAIL_ZERO_RETURN(errctx, (obj->environment->parent != NULL), AKBASIC_ERR_ENVIRONMENT,
|
|
"No previous environment to return to");
|
|
popped = obj->environment;
|
|
obj->environment = popped->parent;
|
|
|
|
/*
|
|
* Give back the variables this scope created, as well as the scope.
|
|
*
|
|
* Safe because a scope's own table holds *only* what it created:
|
|
* akbasic_environment_get() walks up to find an outer variable and returns
|
|
* it without caching a reference here, so nothing in this table belongs to
|
|
* anybody else. That is worth stating, because if it ever started caching,
|
|
* this loop would free a parent's variable out from under it.
|
|
*
|
|
* It is the variable *slot* that comes back, not its storage. The value pool
|
|
* never frees, so a pointer into a record DIMmed in this scope stays sound
|
|
* after the scope is gone -- which is a documented property of structures,
|
|
* not an accident this could take away.
|
|
*
|
|
* Without it, one variable leaked per call: a function called two hundred
|
|
* times exhausted the 128-slot pool and reported "Maximum runtime variables
|
|
* reached" on a four-line program.
|
|
*/
|
|
for ( i = 0; i < popped->variables.capacity; i++ ) {
|
|
akbasic_Variable *variable = (akbasic_Variable *)popped->variables.slots[i].value;
|
|
if ( popped->variables.slots[i].used && variable != NULL ) {
|
|
variable->used = false;
|
|
}
|
|
}
|
|
|
|
/*
|
|
* Release it. The reference never does, which is a leak the GC papers over;
|
|
* here the pool is finite, so an unreleased environment is a bug that shows
|
|
* up as exhaustion a few thousand GOSUBs later.
|
|
*/
|
|
popped->used = false;
|
|
SUCCEED_RETURN(errctx);
|
|
}
|
|
|
|
/* ------------------------------------------------------------- lifecycle -- */
|
|
|
|
akerr_ErrorContext *akbasic_runtime_zero(akbasic_Runtime *obj)
|
|
{
|
|
PREPARE_ERROR(errctx);
|
|
|
|
FAIL_ZERO_RETURN(errctx, (obj != NULL), AKERR_NULLPOINTER, "NULL runtime in zero");
|
|
PASS(errctx, akbasic_environment_zero(obj->environment));
|
|
SUCCEED_RETURN(errctx);
|
|
}
|
|
|
|
akerr_ErrorContext *akbasic_runtime_init(akbasic_Runtime *obj, akbasic_TextSink *sink)
|
|
{
|
|
PREPARE_ERROR(errctx);
|
|
|
|
FAIL_ZERO_RETURN(errctx, (obj != NULL), AKERR_NULLPOINTER, "NULL runtime in init");
|
|
FAIL_ZERO_RETURN(errctx, (sink != NULL), AKERR_NULLPOINTER, "NULL text sink in init");
|
|
|
|
/*
|
|
* Claim the status band before anything can raise one of our codes, or the
|
|
* first error out of this function prints "Unknown Error". Idempotent, so a
|
|
* host that already called it loses nothing.
|
|
*/
|
|
PASS(errctx, akbasic_error_register());
|
|
|
|
PASS(errctx, aksl_memset(obj, 0, sizeof(*obj)));
|
|
obj->sink = sink;
|
|
obj->environment = NULL;
|
|
obj->autoLineNumber = 0;
|
|
obj->eval_clone_identifiers = true;
|
|
obj->errclass = AKBASIC_ERRCLASS_NONE;
|
|
obj->mode = AKBASIC_MODE_REPL;
|
|
obj->run_finished_mode = AKBASIC_MODE_REPL;
|
|
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_ui_state_init(&obj->ui_state));
|
|
PASS(errctx, akbasic_valuepool_init(&obj->valuepool));
|
|
PASS(errctx, akbasic_value_zero(&obj->staticTrueValue));
|
|
PASS(errctx, akbasic_value_zero(&obj->staticFalseValue));
|
|
PASS(errctx, akbasic_value_set_bool(&obj->staticTrueValue, true));
|
|
PASS(errctx, akbasic_value_set_bool(&obj->staticFalseValue, false));
|
|
|
|
PASS(errctx, akbasic_runtime_new_environment(obj));
|
|
PASS(errctx, akbasic_runtime_zero(obj));
|
|
PASS(errctx, akbasic_scanner_zero(obj));
|
|
PASS(errctx, akbasic_runtime_reserve_globals(obj));
|
|
SUCCEED_RETURN(errctx);
|
|
}
|
|
|
|
akerr_ErrorContext *akbasic_runtime_set_devices(akbasic_Runtime *obj, akbasic_GraphicsBackend *graphics, akbasic_AudioBackend *audio, akbasic_InputBackend *input, akbasic_SpriteBackend *sprites)
|
|
{
|
|
PREPARE_ERROR(errctx);
|
|
|
|
FAIL_ZERO_RETURN(errctx, (obj != NULL), AKERR_NULLPOINTER,
|
|
"NULL runtime in set_devices");
|
|
|
|
/*
|
|
* No validation of the records themselves. A backend with a NULL entry point
|
|
* is caught at the call site by the verb that needs it, which can say which
|
|
* verb wanted what -- checking every pointer here would only be able to say
|
|
* that something, somewhere, was incomplete.
|
|
*/
|
|
obj->graphics = graphics;
|
|
obj->audio = audio;
|
|
obj->input = input;
|
|
obj->sprites = sprites;
|
|
SUCCEED_RETURN(errctx);
|
|
}
|
|
|
|
akerr_ErrorContext *akbasic_runtime_set_ui(akbasic_Runtime *obj, akbasic_UiBackend *ui)
|
|
{
|
|
PREPARE_ERROR(errctx);
|
|
|
|
FAIL_ZERO_RETURN(errctx, (obj != NULL), AKERR_NULLPOINTER,
|
|
"NULL runtime in set_ui");
|
|
obj->ui = ui;
|
|
SUCCEED_RETURN(errctx);
|
|
}
|
|
|
|
akerr_ErrorContext *akbasic_runtime_set_source_path(akbasic_Runtime *obj, const char *path)
|
|
{
|
|
PREPARE_ERROR(errctx);
|
|
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.
|
|
*/
|
|
PASS(errctx, aksl_strrchr(path, '/', &slash));
|
|
length = (slash == NULL ? 0 : (size_t)(slash - path));
|
|
if ( length == 0 ) {
|
|
/* Either no directory at all, or the root. */
|
|
PASS(errctx, aksl_strcpy(obj->sourcepath, sizeof(obj->sourcepath),
|
|
(slash == NULL ? "." : "/")));
|
|
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);
|
|
PASS(errctx, aksl_memcpy(obj->sourcepath, path, length));
|
|
obj->sourcepath[length] = '\0';
|
|
SUCCEED_RETURN(errctx);
|
|
}
|
|
|
|
akerr_ErrorContext *akbasic_runtime_settime(akbasic_Runtime *obj, int64_t timems)
|
|
{
|
|
PREPARE_ERROR(errctx);
|
|
|
|
FAIL_ZERO_RETURN(errctx, (obj != NULL), AKERR_NULLPOINTER,
|
|
"NULL runtime in settime");
|
|
|
|
/*
|
|
* Deliberately not rejecting a time that moves backwards. A host is free to
|
|
* drive this from a paused, scrubbed or replayed clock, and the only thing
|
|
* that happens is a note holding longer than it asked to.
|
|
*/
|
|
obj->timems = timems;
|
|
SUCCEED_RETURN(errctx);
|
|
}
|
|
|
|
/* ---------------------------------------------------------------- output -- */
|
|
|
|
akerr_ErrorContext *akbasic_runtime_write(akbasic_Runtime *obj, const char *text)
|
|
{
|
|
PREPARE_ERROR(errctx);
|
|
|
|
FAIL_ZERO_RETURN(errctx, (obj != NULL && text != NULL), AKERR_NULLPOINTER,
|
|
"NULL argument in write");
|
|
PASS(errctx, obj->sink->write(obj->sink, text));
|
|
SUCCEED_RETURN(errctx);
|
|
}
|
|
|
|
akerr_ErrorContext *akbasic_runtime_println(akbasic_Runtime *obj, const char *text)
|
|
{
|
|
PREPARE_ERROR(errctx);
|
|
|
|
FAIL_ZERO_RETURN(errctx, (obj != NULL && text != NULL), AKERR_NULLPOINTER,
|
|
"NULL argument in println");
|
|
PASS(errctx, obj->sink->writeln(obj->sink, text));
|
|
SUCCEED_RETURN(errctx);
|
|
}
|
|
|
|
static const char *errclass_to_string(akbasic_ErrorClass errclass)
|
|
{
|
|
switch ( errclass ) {
|
|
case AKBASIC_ERRCLASS_IO: return "IO ERROR";
|
|
case AKBASIC_ERRCLASS_PARSE: return "PARSE ERROR";
|
|
case AKBASIC_ERRCLASS_RUNTIME: return "RUNTIME ERROR";
|
|
case AKBASIC_ERRCLASS_SYNTAX: return "SYNTAX ERROR";
|
|
default: return "UNDEF";
|
|
}
|
|
}
|
|
|
|
akerr_ErrorContext *akbasic_runtime_error(akbasic_Runtime *obj, akbasic_ErrorClass errclass, const char *message)
|
|
{
|
|
PREPARE_ERROR(errctx);
|
|
char line[AKBASIC_MAX_LINE_LENGTH * 2];
|
|
|
|
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. */
|
|
obj->errorline = obj->environment->lineno;
|
|
/*
|
|
* The format, the trailing \n inside the string, and the second newline
|
|
* writeln adds are all part of the acceptance contract --
|
|
* tests/language/array_outofbounds.txt ends in 0a 0a. See TODO.md 1.8.
|
|
*
|
|
* **Raw snprintf on purpose, and this is the site where it matters most.**
|
|
* `line` is 512 bytes; `message` arrives from an akerr_ErrorContext, whose
|
|
* own buffer is AKERR_MAX_ERROR_CONTEXT_STRING_LENGTH -- 12384. An ordinary
|
|
* long diagnostic therefore truncates, and truncating a report is correct
|
|
* here: this is the one function that tells the user *what went wrong*, and
|
|
* aksl_snprintf would turn a long message into a second, different failure
|
|
* that replaces the first. A report may be shortened; it may not be lost.
|
|
* libakstdlib #34 is the issue tracking the contract that would let a caller
|
|
* ask for the length instead.
|
|
*/
|
|
snprintf(line, sizeof(line), "? %" PRId64 " : %s %s\n",
|
|
obj->environment->lineno, errclass_to_string(errclass), message);
|
|
PASS(errctx, akbasic_runtime_println(obj, line));
|
|
SUCCEED_RETURN(errctx);
|
|
}
|
|
|
|
akerr_ErrorContext *akbasic_runtime_set_mode(akbasic_Runtime *obj, int mode)
|
|
{
|
|
PREPARE_ERROR(errctx);
|
|
|
|
FAIL_ZERO_RETURN(errctx, (obj != NULL), AKERR_NULLPOINTER, "NULL runtime in set_mode");
|
|
obj->mode = 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 ) {
|
|
/*
|
|
* All four prescans, and all four inside one ATTEMPT.
|
|
*
|
|
* **A prescan failure is the program's mistake, not the host's**, so it
|
|
* has to leave here as a BASIC error line rather than as a raised
|
|
* context -- goal 3, the same boundary process_line_run() draws around
|
|
* parsing. Without this a malformed TYPE printed a stack trace and took
|
|
* the driver with it, which is exactly what section 8 records for the
|
|
* scanner on a path this one would otherwise have joined.
|
|
*
|
|
* It matters most for TYPE because a mistyped declaration is an ordinary
|
|
* thing to write; labels and DATA are wrapped with it because they can
|
|
* fail too and there is no reason for three different answers.
|
|
*/
|
|
ATTEMPT {
|
|
/*
|
|
* Labels first, filed 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.
|
|
*/
|
|
CATCH(errctx, akbasic_runtime_scan_labels(obj));
|
|
/*
|
|
* Then the DATA items, for the same reason: 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.
|
|
*/
|
|
CATCH(errctx, akbasic_data_scan(obj));
|
|
/*
|
|
* Then the TYPE declarations, for the third time and the same
|
|
* reason: a declaration has to be in effect wherever control goes,
|
|
* so `DIM P@ AS RECT` cannot run before RECT exists even if a branch
|
|
* skipped the lines that declared it.
|
|
*/
|
|
CATCH(errctx, akbasic_structtype_scan(obj));
|
|
/*
|
|
* Then the branch targets, last because it is the only one that reads
|
|
* nothing into the runtime -- it only refuses. A loaded line may be
|
|
* *given* its number rather than carry one, so `GOTO 100` in a script
|
|
* written without numbers would otherwise find the hundredth line and
|
|
* branch there, which is plausible, silent and wrong. Said here rather
|
|
* than at the branch, because before the program runs is earlier and
|
|
* every path into a run comes through this function.
|
|
*/
|
|
CATCH(errctx, akbasic_runtime_check_targets(obj));
|
|
} CLEANUP {
|
|
} PROCESS(errctx) {
|
|
} HANDLE_DEFAULT(errctx) {
|
|
char message[AKERR_MAX_ERROR_CONTEXT_STRING_LENGTH];
|
|
/*
|
|
* Ignored rather than propagated: `errctx` is the error being
|
|
* handled, so a PASS here would overwrite it with the copy's own
|
|
* failure and the next line would read a released context. Same
|
|
* reason the two calls below are ignored. aksl_strcpy empties the
|
|
* destination before it copies, so a refusal leaves an empty
|
|
* message rather than an uninitialised one.
|
|
*/
|
|
IGNORE(aksl_strcpy(message, sizeof(message), errctx->message));
|
|
obj->lasterrorstatus = errctx->status;
|
|
IGNORE(akbasic_runtime_error(obj, AKBASIC_ERRCLASS_PARSE, message));
|
|
IGNORE(akbasic_runtime_set_mode(obj, obj->run_finished_mode));
|
|
} FINISH(errctx, false);
|
|
}
|
|
SUCCEED_RETURN(errctx);
|
|
}
|
|
|
|
/* ------------------------------------------------------------ evaluation -- */
|
|
|
|
/*
|
|
* Report a runtime error carrying an akerr message, then re-raise. Used where
|
|
* the reference calls basicError() and returns the error: the BASIC-visible line
|
|
* goes to the sink and the context keeps propagating.
|
|
*/
|
|
static akerr_ErrorContext *report_and_reraise(akbasic_Runtime *obj, akerr_ErrorContext *cause)
|
|
{
|
|
PREPARE_ERROR(errctx);
|
|
akerr_ErrorContext *reporting = NULL;
|
|
char message[AKERR_MAX_ERROR_CONTEXT_STRING_LENGTH];
|
|
int status = cause->status;
|
|
|
|
/*
|
|
* Ignored rather than passed: this function's whole contract is that the
|
|
* program's own error is the one that leaves, so a failure to copy the
|
|
* message must not become the error that gets raised. aksl_strcpy empties
|
|
* the destination first, so a refusal reports an empty message rather than
|
|
* an uninitialised one.
|
|
*/
|
|
IGNORE(aksl_strcpy(message, sizeof(message), 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));
|
|
|
|
/*
|
|
* **Reporting can itself fail, and the program's own error still wins.**
|
|
*
|
|
* The way it fails is the `TRAP` dispatch inside akbasic_runtime_error():
|
|
* entering a handler takes a scope, and a program deep enough to have run
|
|
* out of them raises for that reason while already raising for another. A
|
|
* plain PASS here would return the *dispatch's* failure and lose the one the
|
|
* program needs to hear about -- "Environment pool exhausted" in place of
|
|
* the subscript that was actually out of range.
|
|
*
|
|
* So the secondary failure is logged where a developer will see it and the
|
|
* original is re-raised. TODO.md section 6 item 33 is where this was found;
|
|
* item 33's other half stops the dispatch needing to allocate at all, which
|
|
* is what makes this path rare rather than routine.
|
|
*/
|
|
reporting = akbasic_runtime_error(obj, AKBASIC_ERRCLASS_RUNTIME, message);
|
|
if ( reporting != NULL ) {
|
|
LOG_ERROR_WITH_MESSAGE(reporting, "could not report a BASIC error");
|
|
reporting->handled = true;
|
|
IGNORE(akerr_release_error(reporting));
|
|
}
|
|
FAIL_RETURN(errctx, status, "%s", message);
|
|
}
|
|
|
|
static akerr_ErrorContext *evaluate_identifier(akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value **dest)
|
|
{
|
|
PREPARE_ERROR(errctx);
|
|
akbasic_ASTLeaf *texpr = NULL;
|
|
akbasic_Value *tval = NULL;
|
|
akbasic_Value *slot = NULL;
|
|
akbasic_Value *copy = NULL;
|
|
akbasic_Variable *variable = NULL;
|
|
int64_t subscripts[AKBASIC_MAX_ARRAY_DEPTH];
|
|
int subscriptcount = 0;
|
|
|
|
/*
|
|
* An identifier's subscript list hangs off .expr, deliberately clear of
|
|
* .right -- which is where an argument list chains its arguments, and where
|
|
* INPUT's parse handler would otherwise collide with it. Checked for the
|
|
* ARRAY_SUBSCRIPT operator anyway, because .expr means something else on the
|
|
* leaf types that use it for grouping.
|
|
*/
|
|
texpr = expr->expr;
|
|
if ( texpr != NULL &&
|
|
texpr->leaftype == AKBASIC_LEAF_ARGUMENTLIST &&
|
|
texpr->operator_ == AKBASIC_TOK_ARRAY_SUBSCRIPT ) {
|
|
for ( texpr = texpr->right; texpr != NULL; texpr = texpr->next ) {
|
|
FAIL_ZERO_RETURN(errctx, (subscriptcount < AKBASIC_MAX_ARRAY_DEPTH),
|
|
AKBASIC_ERR_BOUNDS,
|
|
"More than %d array subscripts", AKBASIC_MAX_ARRAY_DEPTH);
|
|
PASS(errctx, akbasic_runtime_evaluate(obj, texpr, &tval));
|
|
FAIL_NONZERO_RETURN(errctx, (tval->valuetype != AKBASIC_TYPE_INTEGER),
|
|
AKBASIC_ERR_TYPE,
|
|
"Array dimensions must evaluate to integer (C)");
|
|
subscripts[subscriptcount] = tval->intval;
|
|
subscriptcount += 1;
|
|
}
|
|
}
|
|
if ( subscriptcount == 0 ) {
|
|
subscripts[0] = 0;
|
|
subscriptcount = 1;
|
|
}
|
|
|
|
PASS(errctx, akbasic_environment_get(obj->environment, expr->identifier, &variable));
|
|
FAIL_ZERO_RETURN(errctx, (variable != NULL), AKBASIC_ERR_UNDEFINED,
|
|
"Identifier %s is undefined", expr->identifier);
|
|
PASS(errctx, akbasic_variable_get_subscript(variable, subscripts, subscriptcount, &slot));
|
|
|
|
/*
|
|
* A structure variable's *slots are* the instance, so what an expression
|
|
* gets is a description of where it lives rather than a copy of it -- one
|
|
* value cannot hold a run of them. Assignment is what turns that
|
|
* description into a copy, which is the one place a copy was actually asked
|
|
* for.
|
|
*/
|
|
if ( variable->valuetype == AKBASIC_TYPE_STRUCT && variable->structtype >= 0 ) {
|
|
PASS(errctx, akbasic_environment_new_value(obj->environment, ©));
|
|
PASS(errctx, akbasic_struct_describe(obj, variable->structtype, slot,
|
|
variable->ispointer, copy));
|
|
/*
|
|
* A host binding carries its instance along, so a field read can go to
|
|
* the game's memory rather than to the shadow slot. Refreshed here too,
|
|
* so `B@ = FOE@` copies what the game holds now rather than what it held
|
|
* when the binding was made.
|
|
*/
|
|
if ( variable->hostbase != NULL ) {
|
|
copy->hostbase = variable->hostbase;
|
|
PASS(errctx, akbasic_host_refresh(obj, variable->structtype,
|
|
variable->hostbase, slot));
|
|
}
|
|
if ( variable->ispointer ) {
|
|
/* A pointer variable holds its reference in its own slot. */
|
|
copy->structtype = slot->structtype;
|
|
copy->structbase = slot->structbase;
|
|
copy->hostbase = slot->hostbase;
|
|
}
|
|
*dest = copy;
|
|
SUCCEED_RETURN(errctx);
|
|
}
|
|
|
|
if ( !obj->eval_clone_identifiers ) {
|
|
*dest = slot;
|
|
SUCCEED_RETURN(errctx);
|
|
}
|
|
PASS(errctx, akbasic_environment_new_value(obj->environment, ©));
|
|
PASS(errctx, akbasic_value_clone(slot, copy));
|
|
*dest = copy;
|
|
SUCCEED_RETURN(errctx);
|
|
}
|
|
|
|
static akerr_ErrorContext *evaluate_binary(akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value **dest)
|
|
{
|
|
PREPARE_ERROR(errctx);
|
|
akbasic_Value *lval = NULL;
|
|
akbasic_Value *rval = NULL;
|
|
akbasic_Value *scratch = NULL;
|
|
|
|
PASS(errctx, akbasic_runtime_evaluate(obj, expr->left, &lval));
|
|
PASS(errctx, akbasic_runtime_evaluate(obj, expr->right, &rval));
|
|
|
|
if ( expr->operator_ == AKBASIC_TOK_ASSIGNMENT ) {
|
|
PASS(errctx, akbasic_environment_assign(obj->environment, expr->left, rval, dest));
|
|
SUCCEED_RETURN(errctx);
|
|
}
|
|
|
|
PASS(errctx, akbasic_environment_new_value(obj->environment, &scratch));
|
|
switch ( expr->operator_ ) {
|
|
case AKBASIC_TOK_MINUS:
|
|
PASS(errctx, akbasic_value_math_minus(lval, rval, scratch, dest));
|
|
break;
|
|
case AKBASIC_TOK_PLUS:
|
|
PASS(errctx, akbasic_value_math_plus(lval, rval, scratch, dest));
|
|
break;
|
|
case AKBASIC_TOK_LEFT_SLASH:
|
|
PASS(errctx, akbasic_value_math_divide(lval, rval, scratch, dest));
|
|
break;
|
|
case AKBASIC_TOK_STAR:
|
|
PASS(errctx, akbasic_value_math_multiply(lval, rval, scratch, dest));
|
|
break;
|
|
case AKBASIC_TOK_AND:
|
|
PASS(errctx, akbasic_value_bitwise_and(lval, rval, scratch, dest));
|
|
break;
|
|
case AKBASIC_TOK_OR:
|
|
PASS(errctx, akbasic_value_bitwise_or(lval, rval, scratch, dest));
|
|
break;
|
|
case AKBASIC_TOK_LESS_THAN:
|
|
PASS(errctx, akbasic_value_less_than(lval, rval, scratch, dest));
|
|
break;
|
|
case AKBASIC_TOK_LESS_THAN_EQUAL:
|
|
PASS(errctx, akbasic_value_less_than_equal(lval, rval, scratch, dest));
|
|
break;
|
|
case AKBASIC_TOK_EQUAL:
|
|
PASS(errctx, akbasic_value_is_equal(lval, rval, scratch, dest));
|
|
break;
|
|
case AKBASIC_TOK_NOT_EQUAL:
|
|
PASS(errctx, akbasic_value_is_not_equal(lval, rval, scratch, dest));
|
|
break;
|
|
case AKBASIC_TOK_GREATER_THAN:
|
|
PASS(errctx, akbasic_value_greater_than(lval, rval, scratch, dest));
|
|
break;
|
|
case AKBASIC_TOK_GREATER_THAN_EQUAL:
|
|
PASS(errctx, akbasic_value_greater_than_equal(lval, rval, scratch, dest));
|
|
break;
|
|
default:
|
|
FAIL_RETURN(errctx, AKBASIC_ERR_SYNTAX,
|
|
"Don't know how to perform binary operation %d", (int)expr->operator_);
|
|
}
|
|
SUCCEED_RETURN(errctx);
|
|
}
|
|
|
|
akerr_ErrorContext *akbasic_runtime_evaluate(akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value **dest)
|
|
{
|
|
PREPARE_ERROR(errctx);
|
|
akbasic_Value *lval = NULL;
|
|
akbasic_Value *rval = NULL;
|
|
akbasic_Value *scratch = NULL;
|
|
const akbasic_Verb *verb = NULL;
|
|
int cmp = 0;
|
|
|
|
FAIL_ZERO_RETURN(errctx, (obj != NULL && dest != NULL), AKERR_NULLPOINTER,
|
|
"NULL argument in evaluate");
|
|
FAIL_ZERO_RETURN(errctx, (expr != NULL), AKERR_NULLPOINTER, "NULL expression in evaluate");
|
|
|
|
PASS(errctx, akbasic_environment_new_value(obj->environment, &lval));
|
|
PASS(errctx, akbasic_value_zero(lval));
|
|
*dest = lval;
|
|
|
|
switch ( expr->leaftype ) {
|
|
case AKBASIC_LEAF_GROUPING:
|
|
PASS(errctx, akbasic_runtime_evaluate(obj, expr->expr, dest));
|
|
SUCCEED_RETURN(errctx);
|
|
|
|
case AKBASIC_LEAF_BRANCH:
|
|
ATTEMPT {
|
|
CATCH(errctx, akbasic_runtime_evaluate(obj, expr->expr, &rval));
|
|
} CLEANUP {
|
|
} PROCESS(errctx) {
|
|
} HANDLE_DEFAULT(errctx) {
|
|
PASS(errctx, report_and_reraise(obj, errctx));
|
|
} FINISH(errctx, true);
|
|
/*
|
|
* Who owns the rest of the line?
|
|
*
|
|
* BASIC 7.0 scopes every statement after THEN to the condition, and the
|
|
* parser only ever takes *one* statement for each arm -- the rest arrive
|
|
* at the statement loop as ordinary top-level statements. So the branch
|
|
* has to say whether that loop should run them.
|
|
*
|
|
* IF C THEN A : B C false -> B belongs to THEN, skip it
|
|
* IF C THEN A ELSE B : D C true -> D belongs to ELSE, skip it
|
|
*
|
|
* which is not "skip when false": the remainder always belongs to
|
|
* whichever arm was written last, so it is skipped exactly when that arm
|
|
* is the one *not* taken. With an ELSE present the last arm is ELSE;
|
|
* without one it is THEN.
|
|
*/
|
|
{
|
|
bool taken = akbasic_value_is_truthy(rval);
|
|
akbasic_ASTLeaf *notaken = (taken ? expr->right : expr->left);
|
|
|
|
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 ) {
|
|
PASS(errctx, aksl_strcmp(notaken->identifier, "BEGIN", &cmp));
|
|
if ( cmp == 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);
|
|
|
|
case AKBASIC_LEAF_IDENTIFIER_INT:
|
|
case AKBASIC_LEAF_IDENTIFIER_FLOAT:
|
|
case AKBASIC_LEAF_IDENTIFIER_STRING:
|
|
case AKBASIC_LEAF_IDENTIFIER_STRUCT:
|
|
PASS(errctx, evaluate_identifier(obj, expr, dest));
|
|
SUCCEED_RETURN(errctx);
|
|
|
|
case AKBASIC_LEAF_IDENTIFIER:
|
|
/* A bare identifier with no type suffix is a label. */
|
|
lval->valuetype = AKBASIC_TYPE_INTEGER;
|
|
PASS(errctx, akbasic_environment_get_label(obj->environment, expr->identifier, &lval->intval));
|
|
SUCCEED_RETURN(errctx);
|
|
|
|
case AKBASIC_LEAF_LITERAL_INT:
|
|
lval->valuetype = AKBASIC_TYPE_INTEGER;
|
|
lval->intval = expr->literal_int;
|
|
SUCCEED_RETURN(errctx);
|
|
|
|
case AKBASIC_LEAF_LITERAL_FLOAT:
|
|
lval->valuetype = AKBASIC_TYPE_FLOAT;
|
|
lval->floatval = expr->literal_float;
|
|
SUCCEED_RETURN(errctx);
|
|
|
|
case AKBASIC_LEAF_LITERAL_STRING:
|
|
lval->valuetype = AKBASIC_TYPE_STRING;
|
|
PASS(errctx, aksl_memcpy(lval->stringval, expr->literal_string, sizeof(lval->stringval)));
|
|
SUCCEED_RETURN(errctx);
|
|
|
|
case AKBASIC_LEAF_UNARY:
|
|
/* .left: a unary leaf's operand, kept clear of the argument chain. */
|
|
PASS(errctx, akbasic_runtime_evaluate(obj, expr->left, &rval));
|
|
PASS(errctx, akbasic_environment_new_value(obj->environment, &scratch));
|
|
if ( expr->operator_ == AKBASIC_TOK_MINUS ) {
|
|
PASS(errctx, akbasic_value_invert(rval, scratch, dest));
|
|
} else if ( expr->operator_ == AKBASIC_TOK_NOT ) {
|
|
PASS(errctx, akbasic_value_bitwise_not(rval, scratch, dest));
|
|
} else {
|
|
FAIL_RETURN(errctx, AKBASIC_ERR_SYNTAX,
|
|
"Don't know how to perform operation %d on unary type %d",
|
|
(int)expr->operator_, (int)rval->valuetype);
|
|
}
|
|
SUCCEED_RETURN(errctx);
|
|
|
|
case AKBASIC_LEAF_FUNCTION:
|
|
PASS(errctx, akbasic_verb_lookup(expr->identifier, &verb));
|
|
if ( verb != NULL && verb->exec != NULL && verb->tokentype == AKBASIC_TOK_FUNCTION ) {
|
|
PASS(errctx, verb->exec(obj, expr, lval, rval, dest));
|
|
SUCCEED_RETURN(errctx);
|
|
}
|
|
PASS(errctx, akbasic_runtime_user_function(obj, expr, dest));
|
|
SUCCEED_RETURN(errctx);
|
|
|
|
case AKBASIC_LEAF_COMMAND_IMMEDIATE:
|
|
case AKBASIC_LEAF_COMMAND:
|
|
PASS(errctx, akbasic_verb_lookup(expr->identifier, &verb));
|
|
FAIL_ZERO_RETURN(errctx, (verb != NULL && verb->exec != NULL), AKBASIC_ERR_UNDEFINED,
|
|
"Unknown command %s", expr->identifier);
|
|
PASS(errctx, verb->exec(obj, expr, lval, rval, dest));
|
|
SUCCEED_RETURN(errctx);
|
|
|
|
case AKBASIC_LEAF_FIELD:
|
|
PASS(errctx, akbasic_struct_evaluate_field(obj, expr, dest));
|
|
SUCCEED_RETURN(errctx);
|
|
|
|
case AKBASIC_LEAF_BINARY:
|
|
PASS(errctx, evaluate_binary(obj, expr, dest));
|
|
SUCCEED_RETURN(errctx);
|
|
|
|
default:
|
|
SUCCEED_RETURN(errctx);
|
|
}
|
|
}
|
|
|
|
akerr_ErrorContext *akbasic_runtime_interpret(akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value **dest)
|
|
{
|
|
PREPARE_ERROR(errctx);
|
|
int cmp = 0;
|
|
bool waiting = false;
|
|
bool matchesverb = false;
|
|
bool waitingbend = false;
|
|
|
|
FAIL_ZERO_RETURN(errctx, (obj != NULL && expr != NULL && dest != NULL), AKERR_NULLPOINTER,
|
|
"NULL argument in interpret");
|
|
/*
|
|
* While an environment is skipping forward to a verb, nothing runs but that
|
|
* verb. This is what keeps a zero-iteration FOR body from executing, given
|
|
* that the loop condition is evaluated at the bottom of the structure.
|
|
*/
|
|
PASS(errctx, akbasic_environment_is_waiting_for_any(obj->environment, &waiting));
|
|
if ( waiting ) {
|
|
/*
|
|
* Hoisted out of the condition it used to be a term in: the test reads a
|
|
* recorded verb name, that read can fail, and the old `bool` return had
|
|
* nowhere to report it. `matchesverb` stays false unless the leaf really
|
|
* is a command whose name is what the scope is waiting for, which is what
|
|
* the `||` short-circuit used to say. See libakstdlib #38.
|
|
*/
|
|
matchesverb = false;
|
|
if ( expr->leaftype == AKBASIC_LEAF_COMMAND ) {
|
|
PASS(errctx, akbasic_environment_is_waiting_for(obj->environment,
|
|
expr->identifier, &matchesverb));
|
|
}
|
|
if ( !matchesverb ) {
|
|
/*
|
|
* **A skipped loop has already pushed its scope, and this is where it
|
|
* comes back.**
|
|
*
|
|
* akbasic_parse_for() and akbasic_parse_do() create the environment
|
|
* while the line is *parsed*; whether to skip is decided here, after
|
|
* parsing. So a `FOR` inside a block that is not taken pushes a scope,
|
|
* its body is skipped, and the `NEXT` that would pop it is skipped
|
|
* too. Nothing else ever will.
|
|
*
|
|
* Left behind, thirty-two of them exhausted the pool -- and inside a
|
|
* routine it was much more confusing than that: the orphan sat between
|
|
* the routine and its caller, so the `RETURN` after the block reported
|
|
* "RETURN outside the context of GOSUB" from a routine that plainly
|
|
* *was* entered by a `GOSUB`. The error named the one construct that
|
|
* was not at fault. TODO.md section 9 item 2.
|
|
*
|
|
* `loopFirstLine` is what makes this safe: it is set by both parse
|
|
* handlers and by nothing else, so it identifies the scope this very
|
|
* line pushed rather than whatever happened to be on top.
|
|
*
|
|
* **Only a block skip**, which is what the `BEND` test is for. A
|
|
* zero-iteration `FOR` skips its body the same way, and there the
|
|
* orphan is load-bearing: `tests/reference/.../nestedforloopwaiting
|
|
* forcommand.bas` nests a loop inside one that runs zero times, and
|
|
* the inner scope is what absorbs the inner `NEXT` so the outer `NEXT`
|
|
* still finds its `FOR`. Popping it there turns that case into "NEXT
|
|
* outside the context of FOR". A `FOR` inside a skipped block cannot
|
|
* be in that position, because nothing in a skipped block ever runs to
|
|
* arm a `NEXT` wait in the first place.
|
|
*/
|
|
if ( expr->leaftype == AKBASIC_LEAF_COMMAND &&
|
|
obj->environment->loopFirstLine != 0 &&
|
|
obj->environment->waitingForCommand[0] == '\0' ) {
|
|
PASS(errctx, akbasic_environment_is_waiting_for(obj->environment, "BEND",
|
|
&waitingbend));
|
|
if ( waitingbend ) {
|
|
PASS(errctx, aksl_strcmp(expr->identifier, "FOR", &cmp));
|
|
if ( cmp != 0 ) {
|
|
PASS(errctx, aksl_strcmp(expr->identifier, "DO", &cmp));
|
|
}
|
|
if ( cmp == 0 ) {
|
|
PASS(errctx, akbasic_runtime_prev_environment(obj));
|
|
}
|
|
}
|
|
}
|
|
*dest = &obj->staticTrueValue;
|
|
SUCCEED_RETURN(errctx);
|
|
}
|
|
}
|
|
ATTEMPT {
|
|
CATCH(errctx, akbasic_runtime_evaluate(obj, expr, dest));
|
|
} CLEANUP {
|
|
} PROCESS(errctx) {
|
|
} HANDLE_DEFAULT(errctx) {
|
|
PASS(errctx, report_and_reraise(obj, errctx));
|
|
} FINISH(errctx, true);
|
|
SUCCEED_RETURN(errctx);
|
|
}
|
|
|
|
akerr_ErrorContext *akbasic_runtime_interpret_immediate(akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value **dest)
|
|
{
|
|
PREPARE_ERROR(errctx);
|
|
|
|
FAIL_ZERO_RETURN(errctx, (obj != NULL && expr != NULL && dest != NULL), AKERR_NULLPOINTER,
|
|
"NULL argument in interpret_immediate");
|
|
*dest = NULL;
|
|
if ( expr->leaftype != AKBASIC_LEAF_COMMAND_IMMEDIATE ) {
|
|
SUCCEED_RETURN(errctx);
|
|
}
|
|
PASS(errctx, akbasic_runtime_evaluate(obj, expr, dest));
|
|
SUCCEED_RETURN(errctx);
|
|
}
|
|
|
|
/**
|
|
* @brief Give a structure parameter storage in the call's scope, then fill it.
|
|
*
|
|
* A primitive parameter needs no preparation: `akbasic_environment_assign()`
|
|
* creates the variable and writes a value into it. A structure does, because a
|
|
* structure variable is a *run* of slots sized by its type and there is nothing
|
|
* to copy into until that run exists -- which is the same thing `DIM ... AS`
|
|
* does, done here on the caller's behalf.
|
|
*
|
|
* **Passing is by value, because assignment is.** A structure argument is
|
|
* deep-copied, so a function cannot change its caller's record by accident; a
|
|
* pointer argument copies the reference, which is how a function changes one on
|
|
* purpose. Neither is a special rule -- both fall out of the parameter being
|
|
* assigned like any other variable.
|
|
*/
|
|
static akerr_ErrorContext *bind_structure_parameter(akbasic_Runtime *obj, akbasic_Environment *callenv,
|
|
akbasic_ASTLeaf *param, akbasic_Value *argvalue)
|
|
{
|
|
PREPARE_ERROR(errctx);
|
|
akbasic_Variable *variable = NULL;
|
|
int64_t sizes[1] = { 1 };
|
|
int typeindex = -1;
|
|
bool ispointer = (param->literal_int != 0);
|
|
|
|
PASS(errctx, akbasic_structtype_find(&obj->structtypes, param->literal_string, &typeindex));
|
|
FAIL_ZERO_RETURN(errctx, (typeindex >= 0), AKBASIC_ERR_UNDEFINED,
|
|
"%s is declared AS %s, which is not a type",
|
|
param->identifier, param->literal_string);
|
|
|
|
/*
|
|
* The type check a caller actually meets. `DEF AREA(S@ AS RECT)` handed a
|
|
* COORD is refused here, by name -- which is the whole reason a structure
|
|
* parameter has to name its type rather than saying only `@`.
|
|
*/
|
|
FAIL_ZERO_RETURN(errctx,
|
|
(argvalue->valuetype == (ispointer ? AKBASIC_TYPE_POINTER : AKBASIC_TYPE_STRUCT)),
|
|
AKBASIC_ERR_TYPE,
|
|
"%s expects %s%s", param->identifier,
|
|
(ispointer ? "a pointer to " : "a "), obj->structtypes.types[typeindex].name);
|
|
FAIL_ZERO_RETURN(errctx, (argvalue->structtype == typeindex), AKBASIC_ERR_TYPE,
|
|
"%s is %s%s and cannot take a %s", param->identifier,
|
|
(ispointer ? "a pointer to " : "a "),
|
|
obj->structtypes.types[typeindex].name,
|
|
obj->structtypes.types[argvalue->structtype].name);
|
|
|
|
PASS(errctx, akbasic_environment_create(callenv, param->identifier, &variable));
|
|
sizes[0] = (ispointer ? 1 : obj->structtypes.types[typeindex].slotcount);
|
|
PASS(errctx, akbasic_variable_init(variable, &obj->valuepool, sizes, 1));
|
|
variable->valuetype = AKBASIC_TYPE_STRUCT;
|
|
variable->structtype = typeindex;
|
|
variable->ispointer = ispointer;
|
|
|
|
if ( ispointer ) {
|
|
PASS(errctx, akbasic_value_clone(argvalue, &variable->values[0]));
|
|
SUCCEED_RETURN(errctx);
|
|
}
|
|
PASS(errctx, akbasic_struct_init_slots(obj, typeindex, variable->values));
|
|
PASS(errctx, akbasic_struct_copy(obj, typeindex, argvalue->structbase, variable->values));
|
|
SUCCEED_RETURN(errctx);
|
|
}
|
|
|
|
akerr_ErrorContext *akbasic_runtime_call_function(akbasic_Runtime *obj, const char *name,
|
|
akbasic_Value **args, int nargs,
|
|
akbasic_Value **dest)
|
|
{
|
|
PREPARE_ERROR(errctx);
|
|
akbasic_FunctionDef *fndef = NULL;
|
|
akbasic_Environment *targetenv = NULL;
|
|
akbasic_ASTLeaf *argptr = NULL;
|
|
akbasic_Value *unused = NULL;
|
|
akbasic_Value *result = NULL;
|
|
akbasic_Value *out = NULL;
|
|
akbasic_Environment *callenv = NULL;
|
|
void *fnptr = NULL;
|
|
int i = 0;
|
|
|
|
FAIL_ZERO_RETURN(errctx, (obj != NULL && name != NULL && dest != NULL), AKERR_NULLPOINTER,
|
|
"NULL argument in call_function");
|
|
FAIL_ZERO_RETURN(errctx, (nargs == 0 || args != NULL), AKERR_NULLPOINTER,
|
|
"call_function was given %d arguments and no array", nargs);
|
|
targetenv = obj->environment;
|
|
|
|
PASS(errctx, akbasic_environment_get_function(obj->environment, name, &fnptr));
|
|
fndef = (akbasic_FunctionDef *)fnptr;
|
|
|
|
/*
|
|
* **One environment per call, from the pool -- exactly as GOSUB does.**
|
|
*
|
|
* It used to be owned by the funcdef and reset on every call, which made a
|
|
* function not re-entrant and cost two silent defects:
|
|
*
|
|
* - Calling one twice in a single expression aliased one storage slot, so
|
|
* the second call overwrote the first result before the operator saw it.
|
|
* `DBL(10) + DBL(1)` was 4 rather than 22, and two different functions
|
|
* in one expression were fine, which is what made it so hard to see.
|
|
* - Recursion did not terminate. The recursive call re-initialised the
|
|
* environment the outer call was still using, so the loop below could
|
|
* never see control come back. No error, no bound, no diagnostic -- the
|
|
* one place in this interpreter that hung instead of raising.
|
|
*
|
|
* Taking it from the pool fixes both, and makes recursion depth answer to
|
|
* AKBASIC_MAX_ENVIRONMENTS like every other nesting: too deep is now
|
|
* "Environment pool exhausted", which is a diagnosis rather than a hang.
|
|
*/
|
|
PASS(errctx, akbasic_runtime_new_environment(obj));
|
|
callenv = obj->environment;
|
|
obj->environment = targetenv;
|
|
|
|
/*
|
|
* Bind the values into the call's scope. Passing is by value: assignment is
|
|
* what copies, so a structure argument deep-copies and a pointer argument
|
|
* copies its reference.
|
|
*
|
|
* The values arrive already evaluated, which is the whole difference between
|
|
* this and what it was. Evaluating a *leaf* here is what tied a call to
|
|
* having been parsed from a call site, and therefore to being reachable only
|
|
* from an expression -- a verb wanting to hand a function four numbers had
|
|
* nowhere to start.
|
|
*/
|
|
argptr = (fndef->arglist != NULL ? fndef->arglist->right : NULL);
|
|
for ( i = 0; i < nargs && argptr != NULL; i++ ) {
|
|
obj->environment = callenv;
|
|
if ( argptr->leaftype == AKBASIC_LEAF_IDENTIFIER_STRUCT ) {
|
|
PASS(errctx, bind_structure_parameter(obj, callenv, argptr, args[i]));
|
|
} else {
|
|
PASS(errctx, akbasic_environment_assign(callenv, argptr, args[i], &unused));
|
|
}
|
|
obj->environment = targetenv;
|
|
argptr = argptr->next;
|
|
}
|
|
|
|
obj->environment = callenv;
|
|
|
|
if ( fndef->expression != NULL ) {
|
|
PASS(errctx, akbasic_runtime_evaluate(obj, fndef->expression, &result));
|
|
/*
|
|
* Copied into the *caller's* scratch before the call's environment goes
|
|
* back to the pool. Handing back a pointer into the callee is what made
|
|
* two calls in one expression collide, and it would now be a pointer
|
|
* into a released slot as well.
|
|
*/
|
|
PASS(errctx, akbasic_runtime_prev_environment(obj));
|
|
PASS(errctx, akbasic_environment_new_value(targetenv, &out));
|
|
PASS(errctx, akbasic_value_clone(result, out));
|
|
*dest = out;
|
|
SUCCEED_RETURN(errctx);
|
|
}
|
|
|
|
/*
|
|
* A multi-line subroutine. Hand control to its environment and let the
|
|
* caller's step loop run it until RETURN pops back out. RETURN parks its
|
|
* result on the *parent* -- this environment -- precisely so it outlives the
|
|
* pop, and it is copied into a fresh scratch here for the same reason the
|
|
* single-expression form does.
|
|
*/
|
|
callenv->gosubReturnLine = callenv->lineno + 1;
|
|
callenv->nextline = fndef->lineno;
|
|
/*
|
|
* **The body only runs in RUN mode, and that is a defect rather than a
|
|
* rule.** A multi-line function called at the REPL falls straight past this
|
|
* loop and returns whatever is in the caller's return slot -- zero -- so
|
|
* `PRINT TRIPLE(14)` answers "(UNDEFINED STRING REPRESENTATION FOR 0)" with
|
|
* no error and no diagnostic. Issue #8.
|
|
*
|
|
* Widening it to `mode != AKBASIC_MODE_QUIT` is the obvious fix and is
|
|
* *wrong*: akbasic_runtime_process_line_run() does not advance a REPL-mode
|
|
* runtime the way this loop assumes, so the interpreter hangs instead of
|
|
* answering wrongly -- which is worse. The fix wants the REPL's own line
|
|
* cycle, and that is a larger change than a condition.
|
|
*/
|
|
while ( obj->environment != targetenv && obj->mode == AKBASIC_MODE_RUN ) {
|
|
PASS(errctx, akbasic_runtime_process_line_run(obj));
|
|
}
|
|
PASS(errctx, akbasic_environment_new_value(targetenv, &out));
|
|
PASS(errctx, akbasic_value_clone(&targetenv->returnValue, out));
|
|
*dest = out;
|
|
SUCCEED_RETURN(errctx);
|
|
}
|
|
|
|
/**
|
|
* @brief Call a user-defined function from a parsed call site.
|
|
*
|
|
* Evaluates the arguments in the caller's scope and hands the values to
|
|
* akbasic_runtime_call_function(). The split is what lets a verb call a BASIC
|
|
* function too: everything below the evaluation is shared.
|
|
*/
|
|
akerr_ErrorContext *akbasic_runtime_user_function(akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value **dest)
|
|
{
|
|
PREPARE_ERROR(errctx);
|
|
akbasic_Value *args[AKBASIC_MAX_CALL_ARGUMENTS];
|
|
akbasic_ASTLeaf *leafptr = NULL;
|
|
int nargs = 0;
|
|
|
|
FAIL_ZERO_RETURN(errctx, (obj != NULL && expr != NULL && dest != NULL), AKERR_NULLPOINTER,
|
|
"NULL argument in user_function");
|
|
|
|
/*
|
|
* All of them first, then the call. Evaluating as each one is bound would
|
|
* mean a later argument could see an earlier one already in the callee's
|
|
* scope, which is not what by-value passing means anywhere else.
|
|
*/
|
|
leafptr = (expr->right != NULL ? expr->right->right : NULL);
|
|
while ( leafptr != NULL ) {
|
|
FAIL_ZERO_RETURN(errctx, (nargs < AKBASIC_MAX_CALL_ARGUMENTS), AKBASIC_ERR_BOUNDS,
|
|
"%s was called with more than %d arguments",
|
|
expr->identifier, AKBASIC_MAX_CALL_ARGUMENTS);
|
|
PASS(errctx, akbasic_runtime_evaluate(obj, leafptr, &args[nargs]));
|
|
nargs += 1;
|
|
leafptr = leafptr->next;
|
|
}
|
|
PASS(errctx, akbasic_runtime_call_function(obj, expr->identifier, args, nargs, dest));
|
|
SUCCEED_RETURN(errctx);
|
|
}
|
|
|
|
/* ------------------------------------------------------------ line cycle -- */
|
|
|
|
int64_t akbasic_runtime_find_previous_lineno(akbasic_Runtime *obj)
|
|
{
|
|
int64_t i = 0;
|
|
|
|
for ( i = obj->environment->lineno - 1; i > 0; i-- ) {
|
|
if ( obj->source[i].code[0] != '\0' ) {
|
|
return i;
|
|
}
|
|
}
|
|
return obj->environment->lineno;
|
|
}
|
|
|
|
akerr_ErrorContext *akbasic_runtime_store_line(akbasic_Runtime *obj, int64_t lineno, const char *code, bool numbered)
|
|
{
|
|
PREPARE_ERROR(errctx);
|
|
size_t length = 0;
|
|
|
|
FAIL_ZERO_RETURN(errctx, (lineno >= 0 && lineno < AKBASIC_MAX_SOURCE_LINES),
|
|
AKBASIC_ERR_BOUNDS,
|
|
"Line number %" PRId64 " is outside 0..%d",
|
|
lineno, AKBASIC_MAX_SOURCE_LINES - 1);
|
|
PASS(errctx, aksl_strlen(code, &length));
|
|
FAIL_ZERO_RETURN(errctx, (length < AKBASIC_MAX_LINE_LENGTH), AKBASIC_ERR_BOUNDS,
|
|
"Source line exceeds the %d character limit", AKBASIC_MAX_LINE_LENGTH - 1);
|
|
/* aksl_strcpy always terminates and refuses rather than truncates; the
|
|
length check above is what makes the refusal unreachable. */
|
|
PASS(errctx, aksl_strcpy(obj->source[lineno].code, sizeof(obj->source[lineno].code), code));
|
|
obj->source[lineno].lineno = lineno;
|
|
obj->source[lineno].numbered = numbered;
|
|
SUCCEED_RETURN(errctx);
|
|
}
|
|
|
|
akerr_ErrorContext *akbasic_runtime_file_line(akbasic_Runtime *obj, const char *code)
|
|
{
|
|
PREPARE_ERROR(errctx);
|
|
int64_t slot = 0;
|
|
|
|
FAIL_ZERO_RETURN(errctx, (obj != NULL), AKERR_NULLPOINTER, "NULL runtime in file_line");
|
|
|
|
/*
|
|
* The scanner writes environment->lineno when it takes a number off the front
|
|
* of a line, and leaves it alone when there is none. That makes the field the
|
|
* loader's cursor as well as the current line: a numbered line moves it, and
|
|
* an unnumbered one takes the slot after wherever it now points.
|
|
*
|
|
* Before this, an unnumbered line was filed under the cursor *unchanged* --
|
|
* that is, on top of the line before it. Two in a row silently lost the first,
|
|
* with no error and no output, which is why nothing could be written without
|
|
* numbers.
|
|
*/
|
|
if ( obj->hadlinenumber ) {
|
|
slot = obj->environment->lineno;
|
|
} else {
|
|
slot = obj->environment->lineno + 1;
|
|
FAIL_ZERO_RETURN(errctx, (slot < AKBASIC_MAX_SOURCE_LINES), AKBASIC_ERR_BOUNDS,
|
|
"A program with no line numbers may hold at most %d lines",
|
|
AKBASIC_MAX_SOURCE_LINES - 1);
|
|
}
|
|
|
|
/*
|
|
* Refuse a collision that involves an assigned number, rather than letting one
|
|
* line quietly replace another. Only a file that mixes the two badly can reach
|
|
* this -- `500 GOTO X` after five hundred unnumbered lines -- and losing a line
|
|
* to it is not recoverable.
|
|
*
|
|
* Numbered onto numbered is left alone: a duplicate line number in a file has
|
|
* always kept the last one, and changing that is a separate decision with its
|
|
* own corpus risk. TODO.md records it.
|
|
*/
|
|
FAIL_NONZERO_RETURN(errctx,
|
|
(obj->source[slot].code[0] != '\0'
|
|
&& (!obj->hadlinenumber || !obj->source[slot].numbered)),
|
|
AKBASIC_ERR_BOUNDS,
|
|
"Line %" PRId64 " was assigned to two different lines", slot);
|
|
|
|
obj->environment->lineno = slot;
|
|
PASS(errctx, akbasic_runtime_store_line(obj, slot, code, obj->hadlinenumber));
|
|
SUCCEED_RETURN(errctx);
|
|
}
|
|
|
|
akerr_ErrorContext *akbasic_runtime_process_line_runstream(akbasic_Runtime *obj)
|
|
{
|
|
PREPARE_ERROR(errctx);
|
|
char buffer[AKBASIC_MAX_LINE_LENGTH];
|
|
char scanned[AKBASIC_MAX_LINE_LENGTH];
|
|
bool eof = false;
|
|
|
|
PASS(errctx, obj->sink->readline(obj->sink, buffer, sizeof(buffer), &eof));
|
|
if ( eof ) {
|
|
obj->environment->nextline = 0;
|
|
PASS(errctx, akbasic_runtime_set_mode(obj, AKBASIC_MODE_RUN));
|
|
SUCCEED_RETURN(errctx);
|
|
}
|
|
|
|
/*
|
|
* A blank line is whitespace between statements, not a statement. Skipped
|
|
* here the way akbasic_runtime_load() and DLOAD already skip it, so all three
|
|
* loading paths agree about what a program line is.
|
|
*
|
|
* This mode used to file it like any other, under the cursor -- which for a
|
|
* blank line is the number of the line *before* it. A file ending in a blank
|
|
* line therefore had its last line erased before it ever ran, silently. The
|
|
* reference did the same, and `tests/reference/language/arithmetic/integer.bas`
|
|
* has an expectation with three values for four PRINT statements to prove it.
|
|
*/
|
|
if ( buffer[0] == '\0' ) {
|
|
SUCCEED_RETURN(errctx);
|
|
}
|
|
|
|
/*
|
|
* All this mode does is pick the line number off the front and file the
|
|
* source line under it. What is filed is what the scanner handed back, with
|
|
* the number stripped -- the same text `akbasic_runtime_load()` and `DLOAD`
|
|
* file, so a program is stored identically however it arrived.
|
|
*
|
|
* It used to file the raw buffer here, number and all, on the theory that
|
|
* only a REPL-driven load needed stripping. Nothing reaches this function
|
|
* except the RUNSTREAM arm of step(), so that was every file the driver
|
|
* runs: `source[]` held `10 PRINT "A"` under slot 10, and LIST, DSAVE and
|
|
* HELP would each have printed the number twice. No .bas in either corpus
|
|
* calls LIST, which is why it went unseen.
|
|
*/
|
|
PASS(errctx, akbasic_scanner_scan(obj, buffer, scanned, sizeof(scanned)));
|
|
PASS(errctx, akbasic_runtime_file_line(obj, scanned));
|
|
SUCCEED_RETURN(errctx);
|
|
}
|
|
|
|
akerr_ErrorContext *akbasic_runtime_process_line_repl(akbasic_Runtime *obj)
|
|
{
|
|
PREPARE_ERROR(errctx);
|
|
char prompt[32];
|
|
char scanned[AKBASIC_MAX_LINE_LENGTH];
|
|
akbasic_ASTLeaf *leaf = NULL;
|
|
akbasic_Value *value = NULL;
|
|
akbasic_Parser parser;
|
|
int written = 0;
|
|
bool eof = false;
|
|
|
|
if ( obj->autoLineNumber > 0 ) {
|
|
PASS(errctx, aksl_snprintf(&written, prompt, sizeof(prompt), "%" PRId64 " ",
|
|
obj->environment->lineno + obj->autoLineNumber));
|
|
PASS(errctx, akbasic_runtime_write(obj, prompt));
|
|
}
|
|
|
|
PASS(errctx, obj->sink->readline(obj->sink, obj->userline, sizeof(obj->userline), &eof));
|
|
if ( eof ) {
|
|
obj->inputEof = true;
|
|
PASS(errctx, akbasic_runtime_set_mode(obj, AKBASIC_MODE_QUIT));
|
|
SUCCEED_RETURN(errctx);
|
|
}
|
|
if ( obj->userline[0] == '\0' ) {
|
|
SUCCEED_RETURN(errctx);
|
|
}
|
|
|
|
obj->environment->lineno += obj->autoLineNumber;
|
|
PASS(errctx, akbasic_scanner_scan(obj, obj->userline, scanned, sizeof(scanned)));
|
|
PASS(errctx, akbasic_parser_init(&parser, obj));
|
|
obj->skiprestofline = false;
|
|
|
|
while ( !akbasic_parser_is_at_end(&parser) && !obj->skiprestofline ) {
|
|
ATTEMPT {
|
|
CATCH(errctx, akbasic_parser_parse(&parser, &leaf));
|
|
} CLEANUP {
|
|
} PROCESS(errctx) {
|
|
} HANDLE_DEFAULT(errctx) {
|
|
char message[AKERR_MAX_ERROR_CONTEXT_STRING_LENGTH];
|
|
/* Ignored, not passed: `errctx` is the error being handled here. */
|
|
IGNORE(aksl_strcpy(message, sizeof(message), errctx->message));
|
|
obj->lasterrorstatus = errctx->status;
|
|
IGNORE(akbasic_runtime_error(obj, AKBASIC_ERRCLASS_PARSE, message));
|
|
} FINISH(errctx, false);
|
|
if ( obj->errclass != AKBASIC_ERRCLASS_NONE ) {
|
|
SUCCEED_RETURN(errctx);
|
|
}
|
|
|
|
if ( leaf == NULL ) {
|
|
/* Nothing but statement separators left; an empty statement is not one. */
|
|
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 ) {
|
|
/*
|
|
* Swallow the context exactly as process_line_run() does, and for the
|
|
* same reason: interpret() has already put the BASIC-visible line on
|
|
* the sink, and letting the error out of here hands a *script's*
|
|
* mistake to the host. A bare PASS here meant `VERIFY` against a file
|
|
* that did not match -- an ordinary user answer -- terminated the
|
|
* driver with a stack trace instead of printing an error line.
|
|
*/
|
|
ATTEMPT {
|
|
CATCH(errctx, akbasic_runtime_interpret(obj, leaf, &value));
|
|
} CLEANUP {
|
|
} PROCESS(errctx) {
|
|
} HANDLE_DEFAULT(errctx) {
|
|
} FINISH(errctx, false);
|
|
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. Numbered by
|
|
* construction -- this arm only runs when hadlinenumber was set, because
|
|
* the branch above took every line that arrived without one.
|
|
*/
|
|
PASS(errctx, akbasic_runtime_store_line(obj, obj->environment->lineno, scanned, true));
|
|
} else if ( obj->autoLineNumber > 0 ) {
|
|
obj->environment->lineno = akbasic_runtime_find_previous_lineno(obj);
|
|
}
|
|
}
|
|
SUCCEED_RETURN(errctx);
|
|
}
|
|
|
|
akerr_ErrorContext *akbasic_runtime_process_line_run(akbasic_Runtime *obj)
|
|
{
|
|
PREPARE_ERROR(errctx);
|
|
char line[AKBASIC_MAX_LINE_LENGTH];
|
|
akbasic_ASTLeaf *leaf = NULL;
|
|
akbasic_Value *value = NULL;
|
|
akbasic_Parser parser;
|
|
int written = 0;
|
|
|
|
if ( obj->environment->nextline >= AKBASIC_MAX_SOURCE_LINES ) {
|
|
PASS(errctx, akbasic_runtime_set_mode(obj, obj->run_finished_mode));
|
|
SUCCEED_RETURN(errctx);
|
|
}
|
|
|
|
PASS(errctx, aksl_strcpy(line, sizeof(line), obj->source[obj->environment->nextline].code));
|
|
obj->environment->lineno = obj->environment->nextline;
|
|
obj->environment->nextline += 1;
|
|
if ( line[0] == '\0' ) {
|
|
SUCCEED_RETURN(errctx);
|
|
}
|
|
|
|
/*
|
|
* TRON. Inline and with no newline, which is what a C128 prints: a traced
|
|
* program's output reads `[10][20]HELLO`. Blank lines are skipped above, so
|
|
* a trace shows only the lines that actually hold something.
|
|
*/
|
|
if ( obj->trace ) {
|
|
char tracemark[32];
|
|
PASS(errctx, aksl_snprintf(&written, tracemark, sizeof(tracemark), "[%" PRId64 "]",
|
|
obj->environment->lineno));
|
|
PASS(errctx, akbasic_runtime_write(obj, tracemark));
|
|
}
|
|
|
|
PASS(errctx, akbasic_scanner_scan(obj, line, NULL, 0));
|
|
PASS(errctx, akbasic_parser_init(&parser, obj));
|
|
obj->skiprestofline = false;
|
|
|
|
while ( !akbasic_parser_is_at_end(&parser) && !obj->skiprestofline ) {
|
|
ATTEMPT {
|
|
CATCH(errctx, akbasic_parser_parse(&parser, &leaf));
|
|
} CLEANUP {
|
|
} PROCESS(errctx) {
|
|
} HANDLE_DEFAULT(errctx) {
|
|
char message[AKERR_MAX_ERROR_CONTEXT_STRING_LENGTH];
|
|
/* Ignored, not passed: `errctx` is the error being handled here. */
|
|
IGNORE(aksl_strcpy(message, sizeof(message), errctx->message));
|
|
/*
|
|
* What ER# reports, recorded before the context goes -- the same line
|
|
* report_and_reraise() carries for a runtime error, and it was missing
|
|
* here, so a trapped parse error handed the handler ER# 0.
|
|
*/
|
|
obj->lasterrorstatus = errctx->status;
|
|
IGNORE(akbasic_runtime_error(obj, AKBASIC_ERRCLASS_PARSE, message));
|
|
/*
|
|
* Only when the error was actually reported. An armed TRAP intercepts
|
|
* inside akbasic_runtime_error() and leaves `errclass` clear, meaning
|
|
* "the handler runs at the next line boundary" -- and ending the run
|
|
* here reaches that boundary never. Setting the mode unconditionally
|
|
* made a parse error under a TRAP vanish outright: no error line,
|
|
* because the trap suppressed it, and no handler, because
|
|
* run_finished_mode for a file is QUIT. Arming an error handler made
|
|
* errors disappear, which is the opposite of what it is for.
|
|
*/
|
|
if ( obj->errclass != AKBASIC_ERRCLASS_NONE ) {
|
|
IGNORE(akbasic_runtime_set_mode(obj, obj->run_finished_mode));
|
|
}
|
|
} FINISH(errctx, false);
|
|
if ( obj->errclass != AKBASIC_ERRCLASS_NONE ) {
|
|
SUCCEED_RETURN(errctx);
|
|
}
|
|
if ( leaf == NULL ) {
|
|
/* Nothing but statement separators left; an empty statement is not one. */
|
|
continue;
|
|
}
|
|
|
|
/*
|
|
* The reference discards both results here. An error has already been
|
|
* reported to the sink by interpret(); swallowing the context keeps a
|
|
* BASIC-level error from tearing down the host, which is the whole point
|
|
* of goal 3.
|
|
*/
|
|
ATTEMPT {
|
|
CATCH(errctx, akbasic_runtime_interpret(obj, leaf, &value));
|
|
} CLEANUP {
|
|
} PROCESS(errctx) {
|
|
} HANDLE_DEFAULT(errctx) {
|
|
} FINISH(errctx, false);
|
|
if ( obj->errclass != AKBASIC_ERRCLASS_NONE ) {
|
|
SUCCEED_RETURN(errctx);
|
|
}
|
|
}
|
|
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;
|
|
int cmp = 0;
|
|
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. Every path inside the
|
|
* library files what the scanner already stripped, but
|
|
* akbasic_runtime_store_line() is public and a host may hand it a raw line
|
|
* -- so "30 LABEL X" and "LABEL X" are both real spellings of source[30].
|
|
* Step over the number without ending the statement.
|
|
*/
|
|
if ( statementstart && isdigit((unsigned char)*cursor) ) {
|
|
while ( isdigit((unsigned char)*cursor) ) {
|
|
cursor += 1;
|
|
}
|
|
continue;
|
|
}
|
|
if ( statementstart ) {
|
|
PASS(errctx, aksl_strncasecmp(cursor, "LABEL", 5, &cmp));
|
|
if ( cmp == 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;
|
|
size_t length = 0;
|
|
|
|
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' ) {
|
|
PASS(errctx, aksl_strlen(label, &length));
|
|
FAIL_ZERO_RETURN(errctx, (length < sizeof(slot->label)), AKBASIC_ERR_BOUNDS,
|
|
"Handler label \"%s\" exceeds the %zu character limit",
|
|
label, sizeof(slot->label) - 1);
|
|
/* aksl_strcpy always terminates and refuses rather than truncates; the
|
|
length check above is what makes the refusal unreachable. */
|
|
PASS(errctx, aksl_strcpy(slot->label, sizeof(slot->label), label));
|
|
}
|
|
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);
|
|
PASS(errctx, aksl_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)
|
|
{
|
|
PREPARE_ERROR(errctx);
|
|
|
|
FAIL_ZERO_RETURN(errctx, (obj != NULL), AKERR_NULLPOINTER, "NULL runtime in start");
|
|
obj->run_finished_mode = (mode == AKBASIC_MODE_REPL ? AKBASIC_MODE_REPL : AKBASIC_MODE_QUIT);
|
|
/*
|
|
* Start means start, so a run begins at the first line and is not something
|
|
* CONT may resume into -- the same two lines `RUN` has always set.
|
|
*
|
|
* It was missing here, which cost nothing while a host started a script
|
|
* once: `nextline` is already 0 the first time. It costs a host that runs a
|
|
* script *again* everything, because the second start began past the end and
|
|
* silently did nothing. A game rebinding a structure per enemy and running
|
|
* one script over each of them is exactly that shape, which is how this was
|
|
* found.
|
|
*/
|
|
if ( mode == AKBASIC_MODE_RUN && obj->environment != NULL ) {
|
|
obj->environment->nextline = 0;
|
|
obj->stopped = false;
|
|
}
|
|
PASS(errctx, akbasic_runtime_set_mode(obj, mode));
|
|
SUCCEED_RETURN(errctx);
|
|
}
|
|
|
|
akerr_ErrorContext *akbasic_runtime_load(akbasic_Runtime *obj, const char *source)
|
|
{
|
|
PREPARE_ERROR(errctx);
|
|
char line[AKBASIC_MAX_LINE_LENGTH];
|
|
char scanned[AKBASIC_MAX_LINE_LENGTH];
|
|
const char *cursor = NULL;
|
|
const char *eol = NULL;
|
|
char *match = NULL;
|
|
size_t length = 0;
|
|
|
|
FAIL_ZERO_RETURN(errctx, (obj != NULL), AKERR_NULLPOINTER, "NULL runtime in load");
|
|
FAIL_ZERO_RETURN(errctx, (source != NULL), AKERR_NULLPOINTER, "NULL source in load");
|
|
|
|
/*
|
|
* Start the loader's cursor at 0, so the first unnumbered line of a program
|
|
* lands on slot 1 rather than wherever a previous load left off. It also
|
|
* leaves slot 0 empty, which reads better in a LIST than a program starting
|
|
* at line 0 does.
|
|
*/
|
|
obj->environment->lineno = 0;
|
|
|
|
for ( cursor = source; *cursor != '\0'; cursor = (*eol == '\0' ? eol : eol + 1) ) {
|
|
PASS(errctx, aksl_strchr(cursor, '\n', &match));
|
|
eol = match;
|
|
if ( eol == NULL ) {
|
|
PASS(errctx, aksl_strlen(cursor, &length));
|
|
eol = cursor + length;
|
|
}
|
|
length = (size_t)(eol - cursor);
|
|
if ( length > 0 && cursor[length - 1] == '\r' ) {
|
|
length -= 1;
|
|
}
|
|
FAIL_ZERO_RETURN(errctx, (length < sizeof(line)), AKBASIC_ERR_BOUNDS,
|
|
"Source line of %zu characters exceeds the %d character limit",
|
|
length, AKBASIC_MAX_LINE_LENGTH - 1);
|
|
PASS(errctx, aksl_memcpy(line, cursor, length));
|
|
line[length] = '\0';
|
|
if ( line[0] == '\0' ) {
|
|
continue;
|
|
}
|
|
/*
|
|
* Scanning is what picks the line number off the front and rewrites the
|
|
* line to what follows it -- the same path RUNSTREAM takes, so a program
|
|
* loaded from memory and one read from a file are filed identically.
|
|
*/
|
|
PASS(errctx, akbasic_runtime_zero(obj));
|
|
PASS(errctx, akbasic_scanner_zero(obj));
|
|
PASS(errctx, akbasic_scanner_scan(obj, line, scanned, sizeof(scanned)));
|
|
PASS(errctx, akbasic_runtime_file_line(obj, scanned));
|
|
}
|
|
obj->environment->nextline = 0;
|
|
SUCCEED_RETURN(errctx);
|
|
}
|
|
|
|
akerr_ErrorContext *akbasic_runtime_step(akbasic_Runtime *obj)
|
|
{
|
|
PREPARE_ERROR(errctx);
|
|
bool blocked = false;
|
|
|
|
FAIL_ZERO_RETURN(errctx, (obj != NULL), AKERR_NULLPOINTER, "NULL runtime in step");
|
|
|
|
/*
|
|
* Release the next queued note if its predecessor's time is up. PLAY does not
|
|
* block -- section 1.6 forbids it -- so this is what paces a tune, and it
|
|
* runs before the QUIT check so a program's last notes still come out while
|
|
* a host keeps calling step().
|
|
*/
|
|
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);
|
|
}
|
|
|
|
/*
|
|
* A GETKEY with nothing typed yet holds the program here. The step still
|
|
* returns -- a host keeps its frame rate and a bounded run() still comes
|
|
* back -- it simply does not advance, which is what GETKEY means. The note
|
|
* queue above is serviced first on purpose: music should keep playing while
|
|
* a program waits for a keypress.
|
|
*/
|
|
PASS(errctx, akbasic_input_service(obj, &blocked));
|
|
if ( blocked ) {
|
|
SUCCEED_RETURN(errctx);
|
|
}
|
|
|
|
/*
|
|
* A GETMENU nobody has answered yet holds it the same way, and beside the
|
|
* keyboard rather than after the clock because it is the same kind of wait:
|
|
* the program is parked on the player, not on time.
|
|
*/
|
|
PASS(errctx, akbasic_ui_service(obj, &blocked));
|
|
if ( blocked ) {
|
|
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));
|
|
|
|
switch ( obj->mode ) {
|
|
case AKBASIC_MODE_RUNSTREAM:
|
|
PASS(errctx, akbasic_runtime_process_line_runstream(obj));
|
|
break;
|
|
case AKBASIC_MODE_REPL:
|
|
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];
|
|
/* Ignored, not passed: `errctx` is the error being handled here. */
|
|
IGNORE(aksl_strcpy(message, sizeof(message), 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:
|
|
break;
|
|
}
|
|
|
|
/*
|
|
* The reference never clears runtime.errno, so the first BASIC-level error
|
|
* ends the program: in a file run, run_finished_mode is QUIT. Reproduced
|
|
* deliberately -- tests/language/array_outofbounds.txt depends on exactly one
|
|
* error line being printed and nothing after it.
|
|
*
|
|
* The clear on the way back to the REPL is *not* the reference's, and it is
|
|
* a fix rather than a deviation. A sticky errclass with run_finished_mode
|
|
* REPL means every later step re-enters REPL mode and prints READY again --
|
|
* so an interactive session that hits one runtime error and then reaches end
|
|
* of input spins forever printing READY instead of quitting, because the
|
|
* QUIT that process_line_repl() set on EOF is overwritten right here. A
|
|
* fresh prompt is a fresh statement; the error has been reported and acted
|
|
* on and there is nothing left for it to do.
|
|
*/
|
|
if ( obj->errclass != AKBASIC_ERRCLASS_NONE ) {
|
|
PASS(errctx, akbasic_runtime_set_mode(obj, obj->run_finished_mode));
|
|
if ( obj->mode == AKBASIC_MODE_REPL ) {
|
|
obj->errclass = AKBASIC_ERRCLASS_NONE;
|
|
}
|
|
}
|
|
SUCCEED_RETURN(errctx);
|
|
}
|
|
|
|
akerr_ErrorContext *akbasic_runtime_run(akbasic_Runtime *obj, int maxsteps)
|
|
{
|
|
PREPARE_ERROR(errctx);
|
|
int steps = 0;
|
|
|
|
FAIL_ZERO_RETURN(errctx, (obj != NULL), AKERR_NULLPOINTER, "NULL runtime in run");
|
|
while ( obj->mode != AKBASIC_MODE_QUIT ) {
|
|
PASS(errctx, akbasic_runtime_step(obj));
|
|
steps += 1;
|
|
if ( maxsteps > 0 && steps >= maxsteps ) {
|
|
break;
|
|
}
|
|
}
|
|
SUCCEED_RETURN(errctx);
|
|
}
|