/** * @file runtime.c * @brief Implements the interpreter core: pools, evaluation and the step loop. */ #include #include #include #include #include #include #include #include #include #include #include /* ------------------------------------------------------------------ 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_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 ) { 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()); 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)); 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_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 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]; 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); akerr_ErrorContext *reporting = NULL; 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)); /* * **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; 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) ) { /* * **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' && akbasic_environment_is_waiting_for(obj->environment, "BEND") && (strcmp(expr->identifier, "FOR") == 0 || strcmp(expr->identifier, "DO") == 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_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; akbasic_Value *result = NULL; akbasic_Value *out = NULL; akbasic_Environment *callenv = NULL; void *fnptr = NULL; PASS(errctx, akbasic_environment_get_function(obj->environment, expr->identifier, &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 arguments into the call's scope, evaluating each one in the caller's. * Passing is by value: assignment is what copies, so a structure argument * deep-copies and a pointer argument copies its reference. */ leafptr = (expr->right != NULL ? expr->right->right : NULL); argptr = (fndef->arglist != NULL ? fndef->arglist->right : NULL); while ( leafptr != NULL && argptr != NULL ) { PASS(errctx, akbasic_runtime_evaluate(obj, leafptr, &argvalue)); obj->environment = callenv; if ( argptr->leaftype == AKBASIC_LEAF_IDENTIFIER_STRUCT ) { PASS(errctx, bind_structure_parameter(obj, callenv, argptr, argvalue)); } else { PASS(errctx, akbasic_environment_assign(callenv, argptr, argvalue, &unused)); } obj->environment = targetenv; leafptr = leafptr->next; argptr = argptr->next; } 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; 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); } /* ------------------------------------------------------------ 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); 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; 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; 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; 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. 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; 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 ` 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. 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 && 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); /* * 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; 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) ) { 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_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); } /* * 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); }