/** * @file runtime_housekeeping.c * @brief The housekeeping verbs: NEW, CLR, CONT, TRON, TROFF, SWAP and HELP. * * TODO.md section 4 group B. None of these is in the Go reference -- they are * on its own "What Isn't Implemented" list -- so what they mean here is a * decision rather than a transcription, and each decision is recorded at its * verb. Where a C128's answer needs machine state this interpreter does not * have, the verb does the part that means something and says so. * * None of them needs a device, and none is in the golden corpus's way: they all * act on interpreter state a program can see through PRINT. */ #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 Drop every variable and function, and hand their storage back. * * Shared by NEW and CLR, which differ only in whether the program text goes * too. The value pool is a bump allocator (see akbasic_ValuePool), so this is * the only place anything it handed out ever comes back -- re-initializing the * pool is what makes `CLR` in a loop viable where re-DIMming in one is not. */ static akerr_ErrorContext AKERR_NOIGNORE *clear_variables(akbasic_Runtime *obj) { PREPARE_ERROR(errctx); akbasic_Environment *root = NULL; int i = 0; for ( i = 0; i < AKBASIC_MAX_VARIABLES; i++ ) { obj->variables[i].used = false; } for ( i = 0; i < AKBASIC_MAX_FUNCTIONS; i++ ) { obj->functions[i].used = false; } PASS(errctx, akbasic_valuepool_init(&obj->valuepool)); /* * Unwind to the root before emptying its symbol tables. A CLR inside a * GOSUB would otherwise leave child environments holding pointers into the * variable pool it just released, and the parent chain is the only handle * on them. */ while ( obj->environment != NULL && obj->environment->parent != NULL ) { PASS(errctx, akbasic_runtime_prev_environment(obj)); } /* * That unwind may have released the environment an interrupt handler was * running in. Leaving the pointer behind would wedge interrupts off for the * rest of the session, since nothing would ever pop the environment it * compares against again. */ obj->handlerenv = NULL; root = obj->environment; FAIL_ZERO_RETURN(errctx, (root != NULL), AKERR_NULLPOINTER, "Runtime has no root environment"); PASS(errctx, akbasic_symtab_init(&root->variables, AKBASIC_MAX_VARIABLES)); PASS(errctx, akbasic_symtab_init(&root->functions, AKBASIC_MAX_FUNCTIONS)); /* * Put the reserved globals back. They were in the table this just emptied, * and the `TRAP` dispatch relies on never having to create them -- so a CLR * that left them gone would reopen item 33 for the rest of the session. */ PASS(errctx, akbasic_runtime_reserve_globals(obj)); SUCCEED_RETURN(errctx); } /* ----------------------------------------------------------------- NEW --- */ akerr_ErrorContext *akbasic_cmd_new(akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest) { PREPARE_ERROR(errctx); int64_t i = 0; (void)expr; (void)lval; (void)rval; FAIL_ZERO_RETURN(errctx, (obj != NULL && dest != NULL), AKERR_NULLPOINTER, "NULL argument in NEW"); for ( i = 0; i < AKBASIC_MAX_SOURCE_LINES; i++ ) { obj->source[i].code[0] = '\0'; obj->source[i].lineno = 0; obj->source[i].numbered = false; } PASS(errctx, clear_variables(obj)); PASS(errctx, akbasic_symtab_init(&obj->environment->labels, AKBASIC_MAX_LABELS)); /* A new program does not inherit the old one's open files. */ PASS(errctx, akbasic_disk_close_all(&obj->disk_state)); /* * Disarm everything. The handlers were lines of the program that has just * been deleted, so an interrupt left armed would send the *next* program * into whatever happens to be at that line number. */ for ( i = 0; i < AKBASIC_MAX_INTERRUPTS; i++ ) { PASS(errctx, akbasic_runtime_disarm_interrupt(obj, (akbasic_InterruptSource)i)); } /* * And the sprites go back to undefined. The patterns belonged to the program * that has just been deleted. The *device* still holds them -- there is no * verb that undefines a sprite and so no entry point to say so -- but every * one of them is hidden, which is the observable half. */ PASS(errctx, akbasic_sprite_state_init(&obj->sprite_state)); if ( obj->sprites != NULL && obj->sprites->show != NULL ) { for ( i = 0; i < AKBASIC_MAX_SPRITES; i++ ) { PASS(errctx, obj->sprites->show(obj->sprites, (int)i + 1, false)); } } /* * **Static geometry does go back to the device**, where a sprite pattern * cannot. There is an entry point that retires one, so leaving them would be * a choice rather than a limitation -- and the wrong choice: a wall is * invisible, so one left behind by a deleted program is an unexplainable * collision in the next. */ if ( obj->sprites != NULL && obj->sprites->solid != NULL ) { for ( i = 0; i < AKBASIC_MAX_SOLIDS; i++ ) { PASS(errctx, obj->sprites->solid(obj->sprites, (int)i + 1, false, 0.0, 0.0, 0.0, 0.0)); } } /* * And every widget comes down. Unlike a sprite there *is* an entry point * that undefines these, so this one is complete rather than half: a menu the * deleted program put up would otherwise sit on screen eating the cursor * keys, with nothing left running that knows how to retire it. */ PASS(errctx, akbasic_ui_state_init(&obj->ui_state)); if ( obj->ui != NULL && obj->ui->clear != NULL ) { PASS(errctx, obj->ui->clear(obj->ui)); } /* * The line counter goes home too. Without this a NEW typed at the REPL * leaves the next entered line filed under wherever the last program * stopped, which is a surprising place for a fresh program to start. */ obj->environment->lineno = 0; obj->environment->nextline = 0; obj->stopped = false; obj->stoppedline = 0; obj->errorline = 0; SUCCEED_TRUE(obj, dest); SUCCEED_RETURN(errctx); } /* ----------------------------------------------------------------- CLR --- */ akerr_ErrorContext *akbasic_cmd_clr(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 CLR"); /* * Variables and functions, not the program. A C128's CLR also closes open * files and empties the GOSUB and FOR stacks; the stacks *are* emptied here, * because unwinding to the root is how the variable pool is made safe to * release, and there are no open files to close -- DLOAD and DSAVE open, * transfer and close within the verb. */ PASS(errctx, clear_variables(obj)); SUCCEED_TRUE(obj, dest); SUCCEED_RETURN(errctx); } /* ------------------------------------------------------------ RENUMBER --- */ akerr_ErrorContext *akbasic_cmd_renumber(akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest) { PREPARE_ERROR(errctx); double args[3]; int count = 0; int64_t newstart = 10; int64_t increment = 10; int64_t oldstart = 0; (void)lval; (void)rval; FAIL_ZERO_RETURN(errctx, (obj != NULL && dest != NULL), AKERR_NULLPOINTER, "NULL argument in RENUMBER"); if ( expr != NULL && akbasic_leaf_first_argument(expr) != NULL ) { PASS(errctx, akbasic_args_numbers(obj, expr, "RENUMBER", args, 3, &count)); } if ( count >= 1 ) { newstart = (int64_t)args[0]; } if ( count >= 2 ) { increment = (int64_t)args[1]; } if ( count >= 3 ) { oldstart = (int64_t)args[2]; } PASS(errctx, akbasic_renumber(obj, newstart, increment, oldstart)); /* * The labels and the DATA items were filed against the old numbering, so * both have to be built again. akbasic_runtime_set_mode() does it on the way * into RUN, but a program renumbered and then CONTinued would otherwise * branch on a stale map. */ PASS(errctx, akbasic_runtime_scan_labels(obj)); PASS(errctx, akbasic_data_scan(obj)); obj->stopped = false; obj->stoppedline = 0; SUCCEED_TRUE(obj, dest); SUCCEED_RETURN(errctx); } /* ---------------------------------------------------------------- CONT --- */ akerr_ErrorContext *akbasic_cmd_cont(akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest) { PREPARE_ERROR(errctx); (void)expr; (void)lval; (void)rval; FAIL_ZERO_RETURN(errctx, (obj != NULL && dest != NULL), AKERR_NULLPOINTER, "NULL argument in CONT"); /* * Refused rather than treated as a RUN. "CAN'T CONTINUE" is what a C128 * says, and it says it for a reason: continuing a program that never * started would run it from line zero with whatever variables happened to be * lying about, which is not what anybody typing CONT wanted. */ FAIL_ZERO_RETURN(errctx, obj->stopped, AKBASIC_ERR_STATE, "CAN'T CONTINUE"); obj->environment->nextline = obj->stoppedline; obj->stopped = false; PASS(errctx, akbasic_runtime_set_mode(obj, AKBASIC_MODE_RUN)); SUCCEED_TRUE(obj, dest); SUCCEED_RETURN(errctx); } /* -------------------------------------------------------- TRON / TROFF --- */ akerr_ErrorContext *akbasic_cmd_tron(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 TRON"); obj->trace = true; SUCCEED_TRUE(obj, dest); SUCCEED_RETURN(errctx); } akerr_ErrorContext *akbasic_cmd_troff(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 TROFF"); obj->trace = false; SUCCEED_TRUE(obj, dest); SUCCEED_RETURN(errctx); } /* ---------------------------------------------------------------- SWAP --- */ akerr_ErrorContext *akbasic_cmd_swap(akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest) { PREPARE_ERROR(errctx); akbasic_ASTLeaf *first = NULL; akbasic_ASTLeaf *second = NULL; akbasic_Variable *a = NULL; akbasic_Variable *b = NULL; akbasic_Variable swap; char namea[AKBASIC_MAX_STRING_LENGTH]; char nameb[AKBASIC_MAX_STRING_LENGTH]; (void)lval; (void)rval; FAIL_ZERO_RETURN(errctx, (obj != NULL && expr != NULL && dest != NULL), AKERR_NULLPOINTER, "NULL argument in SWAP"); first = akbasic_leaf_first_argument(expr); second = (first != NULL ? first->next : NULL); FAIL_ZERO_RETURN(errctx, (first != NULL && second != NULL), AKBASIC_ERR_SYNTAX, "Expected SWAP VARIABLE, VARIABLE"); FAIL_ZERO_RETURN(errctx, (akbasic_leaf_is_identifier(first) && akbasic_leaf_is_identifier(second)), AKBASIC_ERR_SYNTAX, "Expected SWAP VARIABLE, VARIABLE"); /* * Refused across types, which BASIC 7.0 also does. A# and B$ hold different * things and swapping them would leave two variables whose names no longer * describe their contents -- and the type suffix is the only type * declaration this language has. */ FAIL_NONZERO_RETURN(errctx, (first->leaftype != second->leaftype), AKBASIC_ERR_TYPE, "SWAP needs two variables of the same type"); PASS(errctx, akbasic_environment_get(obj->environment, first->identifier, &a)); PASS(errctx, akbasic_environment_get(obj->environment, second->identifier, &b)); FAIL_ZERO_RETURN(errctx, (a != NULL && b != NULL), AKBASIC_ERR_UNDEFINED, "SWAP could not reach %s or %s", first->identifier, second->identifier); if ( a == b ) { /* SWAP A#, A# is legal and does nothing, rather than corrupting itself. */ SUCCEED_TRUE(obj, dest); SUCCEED_RETURN(errctx); } /* * The whole record except the name, so an array swaps its dimensions and its * storage pointer along with its contents -- SWAP is documented as exchanging * the *variables*, not their scalar values, and on a C128 it is O(1) for * exactly this reason. The names stay put: they are what the symbol table * points at. */ PASS(errctx, aksl_memcpy(namea, a->name, sizeof(namea))); PASS(errctx, aksl_memcpy(nameb, b->name, sizeof(nameb))); PASS(errctx, aksl_memcpy(&swap, a, sizeof(swap))); PASS(errctx, aksl_memcpy(a, b, sizeof(*a))); PASS(errctx, aksl_memcpy(b, &swap, sizeof(*b))); PASS(errctx, aksl_memcpy(a->name, namea, sizeof(a->name))); PASS(errctx, aksl_memcpy(b->name, nameb, sizeof(b->name))); /* * A scalar's storage is *inside* the record, so the pointer that came over * with it names the other variable's inline slot -- which now holds this * variable's own old value. Left alone, each side reads back what it started * with and SWAP silently does nothing. Rebind each to its own. */ if ( a->values == &b->inlinevalue ) { a->values = &a->inlinevalue; } if ( b->values == &a->inlinevalue ) { b->values = &b->inlinevalue; } SUCCEED_TRUE(obj, dest); SUCCEED_RETURN(errctx); } /* ---------------------------------------------------------------- HELP --- */ akerr_ErrorContext *akbasic_cmd_help(akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest) { PREPARE_ERROR(errctx); char line[AKBASIC_MAX_LINE_LENGTH * 2]; int written = 0; (void)expr; (void)lval; (void)rval; FAIL_ZERO_RETURN(errctx, (obj != NULL && dest != NULL), AKERR_NULLPOINTER, "NULL argument in HELP"); /* * A C128 re-lists the line the last error happened on and highlights the * part it choked on. The line is reproduced here; the highlight is not, * because the error is reported by the verb that raised it rather than by * something holding a token offset, so there is nothing that knows which * part to mark. Printing the line without pretending to know more is the * honest half of the verb. */ if ( obj->errorline == 0 || obj->source[obj->errorline].code[0] == '\0' ) { PASS(errctx, akbasic_runtime_println(obj, "NO ERROR TO HELP WITH")); SUCCEED_TRUE(obj, dest); SUCCEED_RETURN(errctx); } /* * aksl_snprintf treats truncation as an error, and this destination is twice * AKBASIC_MAX_LINE_LENGTH against a stored line that is at most one of them * plus a line number, so the fit is a property of the buffer rather than * something to check for. */ PASS(errctx, aksl_snprintf(&written, line, sizeof(line), "%" PRId64 " %s", obj->errorline, obj->source[obj->errorline].code)); PASS(errctx, akbasic_runtime_println(obj, line)); SUCCEED_TRUE(obj, dest); SUCCEED_RETURN(errctx); }