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