BASIC 7.0 has no records at all, so none of this is a port. The `@` suffix was not invented either: the Go reference reserved IDENTIFIER_STRUCT and never used it, and src/grammar.c rendered such a leaf as "NOT IMPLEMENTED" until now. Declaring the type is what buys the storage model. A TYPE states its fields, so an instance has a known slot count and is laid out exactly as an array is -- one contiguous run from the same value pool DIM already draws from, with field access as offset arithmetic. No new pool holds data; the only new table holds descriptors. A nested value flattens into its container's run, which is why LINE with two POINTs and a string is five slots rather than three. Each field takes its type from its own suffix, the same rule every other name here follows, so a field list needs no type column. An `@` field is the exception and has to name its type, because three primitive types fit in three suffix characters and N declared types do not fit in one. The declaration is prescanned before the program runs, like labels and DATA and for the same reason: it has to be in effect wherever control goes. Three passes, each for a case the one before cannot do -- names first so a field can refer to a type declared later, then field lists, then sizes by repeated resolution. What never resolves is a cycle of by-value containment, so "a TYPE cannot contain itself by value" is a diagnosis rather than an assumption, and the message says to use PTR TO instead. Assignment copies. That interception is the whole feature and it cannot live in akbasic_value_clone(), which copies one slot -- and one slot holds a *reference* to an instance rather than the instance, so going through it would alias. A structure is intercepted before that path and its slots are copied one at a time, walking the descriptor rather than memcpy-ing the run, because a pointer field must copy its reference where a value field must copy its slots. Two smaller things the work required. All three prescans now sit inside one ATTEMPT: a malformed declaration is the program's mistake, and it was printing a stack trace and taking the driver with it, which is the boundary goal 3 exists to draw. And a fresh variable's structtype is -1 rather than the 0 a memset leaves, because 0 is a valid type index and every new variable was claiming to be the first type declared. Co-Authored-By: Claude Opus 5 (1M context) <noreply@anthropic.com>
1465 lines
54 KiB
C
1465 lines
54 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 <string.h>
|
|
#include <strings.h>
|
|
|
|
#include <akerror.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 ) {
|
|
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_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 ) {
|
|
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;
|
|
|
|
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;
|
|
/*
|
|
* 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());
|
|
|
|
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_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));
|
|
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_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);
|
|
}
|
|
|
|
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.
|
|
*/
|
|
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 three prescans, and all three 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));
|
|
} CLEANUP {
|
|
} PROCESS(errctx) {
|
|
} HANDLE_DEFAULT(errctx) {
|
|
char message[AKERR_MAX_ERROR_CONTEXT_STRING_LENGTH];
|
|
snprintf(message, sizeof(message), "%s", 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);
|
|
char message[AKERR_MAX_ERROR_CONTEXT_STRING_LENGTH];
|
|
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));
|
|
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));
|
|
if ( variable->ispointer ) {
|
|
/* A pointer variable holds its reference in its own slot. */
|
|
copy->structtype = slot->structtype;
|
|
copy->structbase = slot->structbase;
|
|
}
|
|
*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;
|
|
|
|
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 &&
|
|
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);
|
|
|
|
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;
|
|
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);
|
|
|
|
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.
|
|
*/
|
|
if ( akbasic_environment_is_waiting_for_any(obj->environment) ) {
|
|
if ( expr->leaftype != AKBASIC_LEAF_COMMAND ||
|
|
!akbasic_environment_is_waiting_for(obj->environment, expr->identifier) ) {
|
|
*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);
|
|
}
|
|
|
|
akerr_ErrorContext *akbasic_runtime_user_function(akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value **dest)
|
|
{
|
|
PREPARE_ERROR(errctx);
|
|
akbasic_FunctionDef *fndef = NULL;
|
|
akbasic_Environment *targetenv = obj->environment;
|
|
akbasic_ASTLeaf *leafptr = NULL;
|
|
akbasic_ASTLeaf *argptr = NULL;
|
|
akbasic_Value *argvalue = NULL;
|
|
akbasic_Value *unused = NULL;
|
|
void *fnptr = NULL;
|
|
|
|
PASS(errctx, akbasic_environment_get_function(obj->environment, expr->identifier, &fnptr));
|
|
fndef = (akbasic_FunctionDef *)fnptr;
|
|
|
|
/*
|
|
* The function's environment is owned by the funcdef, not by the pool free
|
|
* list: it is reset on every call and outlives any single one. The reference
|
|
* holds it by value inside BasicFunctionDef for the same reason.
|
|
*/
|
|
if ( fndef->environment == NULL ) {
|
|
PASS(errctx, akbasic_runtime_new_environment(obj));
|
|
fndef->environment = obj->environment;
|
|
obj->environment = targetenv;
|
|
}
|
|
PASS(errctx, akbasic_environment_init(fndef->environment, obj, obj->environment));
|
|
|
|
/* Bind arguments into the function's scope before entering it. */
|
|
leafptr = (expr->right != NULL ? expr->right->right : NULL);
|
|
argptr = (fndef->arglist != NULL ? fndef->arglist->right : NULL);
|
|
while ( leafptr != NULL && argptr != NULL ) {
|
|
akbasic_Environment *callerenv = obj->environment;
|
|
PASS(errctx, akbasic_runtime_evaluate(obj, leafptr, &argvalue));
|
|
obj->environment = fndef->environment;
|
|
PASS(errctx, akbasic_environment_assign(fndef->environment, argptr, argvalue, &unused));
|
|
obj->environment = callerenv;
|
|
leafptr = leafptr->next;
|
|
argptr = argptr->next;
|
|
}
|
|
|
|
obj->environment = fndef->environment;
|
|
|
|
if ( fndef->expression != NULL ) {
|
|
PASS(errctx, akbasic_runtime_evaluate(obj, fndef->expression, dest));
|
|
obj->environment = obj->environment->parent;
|
|
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. The result is the
|
|
* value RETURN parked in the child environment.
|
|
*/
|
|
obj->environment->gosubReturnLine = obj->environment->lineno + 1;
|
|
obj->environment->nextline = fndef->lineno;
|
|
while ( obj->environment != targetenv && obj->mode == AKBASIC_MODE_RUN ) {
|
|
PASS(errctx, akbasic_runtime_process_line_run(obj));
|
|
}
|
|
*dest = &fndef->environment->returnValue;
|
|
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)
|
|
{
|
|
PREPARE_ERROR(errctx);
|
|
|
|
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);
|
|
FAIL_ZERO_RETURN(errctx, (strlen(code) < AKBASIC_MAX_LINE_LENGTH), AKBASIC_ERR_BOUNDS,
|
|
"Source line exceeds the %d character limit", AKBASIC_MAX_LINE_LENGTH - 1);
|
|
strncpy(obj->source[lineno].code, code, AKBASIC_MAX_LINE_LENGTH - 1);
|
|
obj->source[lineno].code[AKBASIC_MAX_LINE_LENGTH - 1] = '\0';
|
|
obj->source[lineno].lineno = lineno;
|
|
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);
|
|
}
|
|
|
|
/*
|
|
* All this mode does is pick the line number off the front and file the
|
|
* source line under it. DLOAD reaches this from REPL mode, where the line
|
|
* numbers must be stripped the same way the REPL strips them.
|
|
*/
|
|
PASS(errctx, akbasic_scanner_scan(obj, buffer, scanned, sizeof(scanned)));
|
|
if ( obj->mode == AKBASIC_MODE_REPL ) {
|
|
PASS(errctx, akbasic_runtime_store_line(obj, obj->environment->lineno, scanned));
|
|
} else {
|
|
PASS(errctx, akbasic_runtime_store_line(obj, obj->environment->lineno, buffer));
|
|
}
|
|
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;
|
|
bool eof = false;
|
|
|
|
if ( obj->autoLineNumber > 0 ) {
|
|
snprintf(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;
|
|
obj->hadlinenumber = false;
|
|
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];
|
|
snprintf(message, sizeof(message), "%s", 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. */
|
|
PASS(errctx, akbasic_runtime_store_line(obj, obj->environment->lineno, scanned));
|
|
} 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;
|
|
|
|
if ( obj->environment->nextline >= AKBASIC_MAX_SOURCE_LINES ) {
|
|
PASS(errctx, akbasic_runtime_set_mode(obj, obj->run_finished_mode));
|
|
SUCCEED_RETURN(errctx);
|
|
}
|
|
|
|
strncpy(line, obj->source[obj->environment->nextline].code, sizeof(line) - 1);
|
|
line[sizeof(line) - 1] = '\0';
|
|
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];
|
|
snprintf(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];
|
|
snprintf(message, sizeof(message), "%s", 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;
|
|
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)
|
|
{
|
|
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);
|
|
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;
|
|
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");
|
|
|
|
for ( cursor = source; *cursor != '\0'; cursor = (*eol == '\0' ? eol : eol + 1) ) {
|
|
eol = strchr(cursor, '\n');
|
|
if ( eol == NULL ) {
|
|
eol = cursor + strlen(cursor);
|
|
}
|
|
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);
|
|
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_store_line(obj, obj->environment->lineno, 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);
|
|
}
|
|
|
|
/*
|
|
* 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];
|
|
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:
|
|
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);
|
|
}
|