diff --git a/CMakeLists.txt b/CMakeLists.txt index 369c8cc..fe350a6 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -130,6 +130,7 @@ set(AKBASIC_SOURCES src/runtime_commands.c src/runtime_functions.c src/runtime_graphics.c + src/runtime_housekeeping.c src/runtime_input.c src/scanner.c src/sink_stdio.c @@ -239,6 +240,7 @@ set(AKBASIC_TESTS grammar_leaves graphics_verbs hostvars + housekeeping_verbs input_verbs numeric_contract parser_commands diff --git a/TODO.md b/TODO.md index cfb9843..0611ab7 100644 --- a/TODO.md +++ b/TODO.md @@ -543,7 +543,8 @@ Order by what unblocks the most, and by what does not need `libakgl` to grow fir | Group | Verbs | Blocked on | |---|---|---| | A. Structure | `DO`, `LOOP`, `WHILE`, `UNTIL`, `ON`, `BEGIN`, `BEND`, `END` | nothing — reuses `waitingForCommand` | -| B. Housekeeping | `NEW`, `CLR`, `CONT`, `RESTORE`, `RENUMBER`, `SWAP`, `TRON`, `TROFF`, `HELP` | nothing | +| ~~B. Housekeeping~~ | ~~`NEW`, `CLR`, `CONT`, `SWAP`, `TRON`, `TROFF`, `HELP`~~ | **done** — `src/runtime_housekeeping.c`, `tests/housekeeping_verbs.c` | +| B′. Housekeeping, deferred | `RESTORE`, `RENUMBER` | neither is small; see below | | C. Errors | `TRAP`, `RESUME`, `ER`, `ERR` | needs a BASIC-visible error object | | D. Strings/format | `USING`, `PUDEF`, `WIDTH`, `CHAR` | nothing | | E. Console | `WINDOW`, `KEY`, `SLEEP`, `WAIT`, `TI` | the sink, or the clock `akbasic_runtime_settime()` now carries | @@ -555,6 +556,24 @@ Order by what unblocks the most, and by what does not need `libakgl` to grow fir | ~~E′. Console input~~ | ~~`GET`, `GETKEY`, `SCNCLR`~~ | **done** — `src/runtime_input.c`, `tests/input_verbs.c` | | J. Machine | `SYS`, `FETCH`, `STASH`, `POKE`/`PEEK` variants | nothing | +**`RESTORE` and `RENUMBER` are deferred, and neither is a small job.** + +- **`RESTORE` needs a DATA pointer, and there isn't one.** `READ` does not read: it declares + that the *next* `DATA` line reached in execution order should fill its identifiers, and skips + forward until one turns up (`akbasic_cmd_read`, ported faithfully). There is no cursor into a + list of `DATA` items, so there is nothing for `RESTORE` to reset. Implementing it honestly + means implementing the pointer, which is worth doing on its own merits, because the current + arrangement has a defect the corpus does not catch: **a `DATA` line that appears *before* its + `READ` is never found**, so `10 DATA 1,2` / `20 READ A#` runs off the end of the program in + silence, and a second `READ` re-reads the same line rather than continuing. The fix is a + pre-scan of every `DATA` statement into a flat list plus a read cursor, at which point + `RESTORE [line]` is three lines. Its own commit, with the golden cases the change would need. +- **`RENUMBER` has to rewrite references or it is worse than useless.** Moving lines is easy — + source is filed under its line number in `source[]`. Rewriting every `GOTO`, `GOSUB`, `THEN`, + `ELSE`, `RUN` and `LIST` target to match is the job, and doing it on source text means + distinguishing a line number from a digit inside a string literal. Refusing it is better than + a `RENUMBER` that silently breaks every branch in the program. + `LOCATE` used to appear in both E and G. It belongs to G alone: in BASIC 7.0 `LOCATE` moves the *graphics* pixel cursor that `DRAW` starts from, and the text cursor verb is `CHAR`, which is already in group D. diff --git a/include/akbasic/runtime.h b/include/akbasic/runtime.h index 4d0de97..415e418 100644 --- a/include/akbasic/runtime.h +++ b/include/akbasic/runtime.h @@ -139,6 +139,28 @@ typedef struct akbasic_Runtime */ bool skiprestofline; + /* + * TRON/TROFF. When set, every line prints its number in brackets before it + * runs, inline and with no newline, which is what a C128 does: a traced + * program's output reads `[10][20]HELLO`. + */ + bool trace; + + /* + * CONT's two pieces. `stopped` says a STOP actually happened, so CONT can + * refuse rather than silently starting a program that was never running; + * `stoppedline` is where to pick up, taken before STOP hands control back to + * the REPL and the environment's line counters move on. + */ + bool stopped; + int64_t stoppedline; + + /* + * The line the last BASIC-visible error was reported on, and 0 if there has + * not been one. HELP re-displays it, which is the whole of what HELP does. + */ + int64_t errorline; + /* REPL line assembly */ char userline[AKBASIC_MAX_LINE_LENGTH]; diff --git a/src/runtime.c b/src/runtime.c index 771fa96..826ad11 100644 --- a/src/runtime.c +++ b/src/runtime.c @@ -253,6 +253,9 @@ akerr_ErrorContext *akbasic_runtime_error(akbasic_Runtime *obj, akbasic_ErrorCla FAIL_ZERO_RETURN(errctx, (obj != NULL && message != NULL), AKERR_NULLPOINTER, "NULL argument in runtime error"); 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 -- @@ -779,6 +782,17 @@ akerr_ErrorContext *akbasic_runtime_process_line_run(akbasic_Runtime *obj) 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; @@ -929,9 +943,21 @@ akerr_ErrorContext *akbasic_runtime_step(akbasic_Runtime *obj) * 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); } diff --git a/src/runtime_commands.c b/src/runtime_commands.c index e723624..61d1315 100644 --- a/src/runtime_commands.c +++ b/src/runtime_commands.c @@ -141,6 +141,12 @@ akerr_ErrorContext *akbasic_cmd_stop(akbasic_Runtime *obj, akbasic_ASTLeaf *expr PREPARE_ERROR(errctx); (void)expr; (void)lval; (void)rval; + /* + * Where CONT will pick up, taken here because the REPL is about to start + * moving the line counters for whatever gets typed at it. + */ + obj->stoppedline = obj->environment->nextline; + obj->stopped = true; PASS(errctx, akbasic_runtime_set_mode(obj, AKBASIC_MODE_REPL)); SUCCEED_TRUE(obj, dest); SUCCEED_RETURN(errctx); @@ -167,6 +173,8 @@ akerr_ErrorContext *akbasic_cmd_run(akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *target = NULL; (void)lval; (void)rval; + /* A fresh RUN is not something CONT may resume into. */ + obj->stopped = false; obj->environment->nextline = 0; if ( expr != NULL && expr->right != NULL ) { PASS(errctx, akbasic_runtime_evaluate(obj, expr->right, &target)); diff --git a/src/runtime_housekeeping.c b/src/runtime_housekeeping.c new file mode 100644 index 0000000..1e57777 --- /dev/null +++ b/src/runtime_housekeeping.c @@ -0,0 +1,261 @@ +/** + * @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; + obj->functions[i].environment = NULL; + } + 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)); + } + 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)); + 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; + } + PASS(errctx, clear_variables(obj)); + PASS(errctx, akbasic_symtab_init(&obj->environment->labels, AKBASIC_MAX_LABELS)); + + /* + * 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); +} + +/* ---------------------------------------------------------------- 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. + */ + memcpy(namea, a->name, sizeof(namea)); + memcpy(nameb, b->name, sizeof(nameb)); + memcpy(&swap, a, sizeof(swap)); + memcpy(a, b, sizeof(*a)); + memcpy(b, &swap, sizeof(*b)); + memcpy(a->name, namea, sizeof(a->name)); + memcpy(b->name, nameb, sizeof(b->name)); + + 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]; + + (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); + } + snprintf(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); +} diff --git a/src/verbs.c b/src/verbs.c index 73b23fa..3c74e05 100644 --- a/src/verbs.c +++ b/src/verbs.c @@ -40,7 +40,9 @@ static const akbasic_Verb VERBS[] = { { "BOX", AKBASIC_TOK_COMMAND, -1, akbasic_parse_arglist, akbasic_cmd_box }, { "CHR", AKBASIC_TOK_FUNCTION, 1, NULL, akbasic_fn_chr }, { "CIRCLE", AKBASIC_TOK_COMMAND, -1, akbasic_parse_arglist, akbasic_cmd_circle }, + { "CLR", AKBASIC_TOK_COMMAND, -1, NULL, akbasic_cmd_clr }, { "COLOR", AKBASIC_TOK_COMMAND, -1, akbasic_parse_arglist, akbasic_cmd_color }, + { "CONT", AKBASIC_TOK_COMMAND_IMMEDIATE, -1, NULL, akbasic_cmd_cont }, { "COS", AKBASIC_TOK_FUNCTION, 1, NULL, akbasic_fn_cos }, { "DATA", AKBASIC_TOK_COMMAND, -1, akbasic_parse_data, akbasic_cmd_data }, { "DEF", AKBASIC_TOK_COMMAND, -1, akbasic_parse_def, akbasic_cmd_def }, @@ -60,6 +62,7 @@ static const akbasic_Verb VERBS[] = { { "GOTO", AKBASIC_TOK_COMMAND, -1, NULL, akbasic_cmd_goto }, { "GRAPHIC", AKBASIC_TOK_COMMAND, -1, akbasic_parse_arglist, akbasic_cmd_graphic }, { "GSHAPE", AKBASIC_TOK_COMMAND, -1, akbasic_parse_arglist, akbasic_cmd_gshape }, + { "HELP", AKBASIC_TOK_COMMAND_IMMEDIATE, -1, NULL, akbasic_cmd_help }, { "HEX", AKBASIC_TOK_FUNCTION, 1, NULL, akbasic_fn_hex }, { "IF", AKBASIC_TOK_COMMAND, -1, akbasic_parse_if, akbasic_cmd_if }, { "INPUT", AKBASIC_TOK_COMMAND, -1, akbasic_parse_input, akbasic_cmd_input }, @@ -73,6 +76,7 @@ static const akbasic_Verb VERBS[] = { { "LOG", AKBASIC_TOK_FUNCTION, 1, NULL, akbasic_fn_log }, { "MID", AKBASIC_TOK_FUNCTION, 3, NULL, akbasic_fn_mid }, { "MOD", AKBASIC_TOK_FUNCTION, 2, NULL, akbasic_fn_mod }, + { "NEW", AKBASIC_TOK_COMMAND_IMMEDIATE, -1, NULL, akbasic_cmd_new }, { "NEXT", AKBASIC_TOK_COMMAND, -1, NULL, akbasic_cmd_next }, { "NOT", AKBASIC_TOK_NOT, -1, NULL, NULL }, { "OR", AKBASIC_TOK_OR, -1, NULL, NULL }, @@ -102,10 +106,13 @@ static const akbasic_Verb VERBS[] = { { "STEP", AKBASIC_TOK_COMMAND, -1, NULL, NULL }, { "STOP", AKBASIC_TOK_COMMAND, -1, NULL, akbasic_cmd_stop }, { "STR", AKBASIC_TOK_FUNCTION, 1, NULL, akbasic_fn_str }, + { "SWAP", AKBASIC_TOK_COMMAND, -1, akbasic_parse_arglist, akbasic_cmd_swap }, { "TAN", AKBASIC_TOK_FUNCTION, 1, NULL, akbasic_fn_tan }, { "TEMPO", AKBASIC_TOK_COMMAND, -1, akbasic_parse_arglist, akbasic_cmd_tempo }, { "THEN", AKBASIC_TOK_COMMAND, -1, NULL, NULL }, { "TO", AKBASIC_TOK_COMMAND, -1, NULL, NULL }, + { "TROFF", AKBASIC_TOK_COMMAND, -1, NULL, akbasic_cmd_troff }, + { "TRON", AKBASIC_TOK_COMMAND, -1, NULL, akbasic_cmd_tron }, { "VAL", AKBASIC_TOK_FUNCTION, 1, NULL, akbasic_fn_val }, { "VOL", AKBASIC_TOK_COMMAND, -1, akbasic_parse_arglist, akbasic_cmd_vol }, { "XOR", AKBASIC_TOK_FUNCTION, 2, NULL, akbasic_fn_xor }, diff --git a/src/verbs.h b/src/verbs.h index 0bdfe71..fa447d8 100644 --- a/src/verbs.h +++ b/src/verbs.h @@ -28,6 +28,15 @@ akerr_ErrorContext AKERR_NOIGNORE *akbasic_parse_let(struct akbasic_Parser *pars akerr_ErrorContext AKERR_NOIGNORE *akbasic_parse_poke(struct akbasic_Parser *parser, akbasic_ASTLeaf **dest); akerr_ErrorContext AKERR_NOIGNORE *akbasic_parse_read(struct akbasic_Parser *parser, akbasic_ASTLeaf **dest); +/* Verb handlers -- src/runtime_housekeeping.c */ +akerr_ErrorContext AKERR_NOIGNORE *akbasic_cmd_clr(struct akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest); +akerr_ErrorContext AKERR_NOIGNORE *akbasic_cmd_cont(struct akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest); +akerr_ErrorContext AKERR_NOIGNORE *akbasic_cmd_help(struct akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest); +akerr_ErrorContext AKERR_NOIGNORE *akbasic_cmd_new(struct akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest); +akerr_ErrorContext AKERR_NOIGNORE *akbasic_cmd_swap(struct akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest); +akerr_ErrorContext AKERR_NOIGNORE *akbasic_cmd_troff(struct akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest); +akerr_ErrorContext AKERR_NOIGNORE *akbasic_cmd_tron(struct akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest); + /* Verb handlers -- src/runtime_commands.c */ akerr_ErrorContext AKERR_NOIGNORE *akbasic_cmd_auto(struct akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest); akerr_ErrorContext AKERR_NOIGNORE *akbasic_cmd_data(struct akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest); diff --git a/tests/housekeeping_verbs.c b/tests/housekeeping_verbs.c new file mode 100644 index 0000000..e5860a5 --- /dev/null +++ b/tests/housekeeping_verbs.c @@ -0,0 +1,271 @@ +/** + * @file housekeeping_verbs.c + * @brief Tests the group B verbs: NEW, CLR, CONT, TRON, TROFF, SWAP and HELP. + * + * The golden case at tests/language/housekeeping/verbs.bas covers what a running + * program can see of these. What is here is the rest: the refusals, the two + * verbs that only mean anything at a REPL prompt (CONT and HELP), and the state + * a program cannot PRINT. + */ + +#include "harness.h" + +/** @brief Run a program to completion in RUN mode, from a string. */ +static akerr_ErrorContext AKERR_NOIGNORE *run_program(const char *source) +{ + PREPARE_ERROR(errctx); + + PASS(errctx, akbasic_runtime_load(&HARNESS_RUNTIME, source)); + PASS(errctx, akbasic_runtime_start(&HARNESS_RUNTIME, AKBASIC_MODE_RUN)); + PASS(errctx, akbasic_runtime_run(&HARNESS_RUNTIME, 0)); + SUCCEED_RETURN(errctx); +} + +/** @brief Evaluate one immediate line against the current runtime state. */ +static akerr_ErrorContext AKERR_NOIGNORE *immediate(const char *line) +{ + PREPARE_ERROR(errctx); + akbasic_ASTLeaf *leaf = NULL; + akbasic_Value *out = NULL; + + PASS(errctx, akbasic_environment_zero(HARNESS_RUNTIME.environment)); + PASS(errctx, harness_parse(line, &leaf)); + PASS(errctx, akbasic_runtime_evaluate(&HARNESS_RUNTIME, leaf, &out)); + SUCCEED_RETURN(errctx); +} + +/** @brief NEW empties the program *and* the variables; CLR keeps the program. */ +static akerr_ErrorContext AKERR_NOIGNORE *test_new_and_clr(void) +{ + PREPARE_ERROR(errctx); + + TEST_REQUIRE_OK(harness_start(NULL)); + PASS(errctx, akbasic_runtime_load(&HARNESS_RUNTIME, "10 PRINT \"KEPT\"\n")); + PASS(errctx, immediate("A# = 5")); + + PASS(errctx, immediate("CLR")); + TEST_REQUIRE_STR(HARNESS_RUNTIME.source[10].code, "PRINT \"KEPT\""); + PASS(errctx, immediate("PRINT A#")); + TEST_REQUIRE_STR(HARNESS_OUTPUT, "0\n"); + + PASS(errctx, immediate("NEW")); + TEST_REQUIRE_STR(HARNESS_RUNTIME.source[10].code, ""); + TEST_REQUIRE_INT(HARNESS_RUNTIME.environment->lineno, 0); + TEST_REQUIRE_INT(HARNESS_RUNTIME.environment->nextline, 0); + + harness_stop(); + SUCCEED_RETURN(errctx); +} + +/** + * @brief CLR releases the value pool, so an array can be re-DIMmed indefinitely. + * + * The pool is a bump allocator and re-DIMming larger abandons the old slice + * (see akbasic_ValuePool), so a program that grows an array in a loop exhausts + * it. CLR is the only thing that hands the storage back, which makes this the + * assertion that says CLR did something rather than merely appearing to. + */ +static akerr_ErrorContext AKERR_NOIGNORE *test_clr_reclaims_storage(void) +{ + PREPARE_ERROR(errctx); + int i = 0; + + TEST_REQUIRE_OK(harness_start(NULL)); + + /* Without CLR this runs out; the loop count is well past the pool's size. */ + for ( i = 0; i < 40; i++ ) { + PASS(errctx, immediate("DIM Z#(200)")); + PASS(errctx, immediate("CLR")); + } + TEST_REQUIRE_INT(HARNESS_RUNTIME.valuepool.next, 0); + + harness_stop(); + SUCCEED_RETURN(errctx); +} + +/** @brief CONT refuses when nothing stopped, and resumes when something did. */ +static akerr_ErrorContext AKERR_NOIGNORE *test_cont(void) +{ + PREPARE_ERROR(errctx); + akbasic_ASTLeaf *leaf = NULL; + akbasic_Value *out = NULL; + + TEST_REQUIRE_OK(harness_start(NULL)); + + /* Nothing has run, so there is nothing to continue. */ + TEST_REQUIRE_OK(akbasic_environment_zero(HARNESS_RUNTIME.environment)); + TEST_REQUIRE_OK(harness_parse("CONT", &leaf)); + TEST_REQUIRE_STATUS(akbasic_runtime_evaluate(&HARNESS_RUNTIME, leaf, &out), + AKBASIC_ERR_STATE); + + /* A STOP part-way through, and then a CONT that finishes the program. */ + PASS(errctx, run_program("10 PRINT \"BEFORE\"\n" + "20 STOP\n" + "30 PRINT \"AFTER\"\n")); + TEST_REQUIRE_STR(HARNESS_OUTPUT, "BEFORE\nREADY\n"); + TEST_REQUIRE(HARNESS_RUNTIME.stopped, "STOP should have armed CONT"); + + PASS(errctx, immediate("CONT")); + PASS(errctx, akbasic_runtime_run(&HARNESS_RUNTIME, 0)); + /* + * The READY is STOP's, not the end of the program's: akbasic_runtime_start() + * in RUN mode sets run_finished_mode to QUIT, so a program that runs off its + * own end stops rather than dropping to a prompt. + */ + TEST_REQUIRE_STR(HARNESS_OUTPUT, "BEFORE\nREADY\nAFTER\n"); + TEST_REQUIRE(!HARNESS_RUNTIME.stopped, "CONT should have disarmed itself"); + + /* And a second CONT has nothing left to resume. */ + TEST_REQUIRE_OK(akbasic_environment_zero(HARNESS_RUNTIME.environment)); + TEST_REQUIRE_OK(harness_parse("CONT", &leaf)); + TEST_REQUIRE_STATUS(akbasic_runtime_evaluate(&HARNESS_RUNTIME, leaf, &out), + AKBASIC_ERR_STATE); + + harness_stop(); + SUCCEED_RETURN(errctx); +} + +/** @brief A RUN takes the CONT away: the program is starting over, not resuming. */ +static akerr_ErrorContext AKERR_NOIGNORE *test_run_disarms_cont(void) +{ + PREPARE_ERROR(errctx); + + TEST_REQUIRE_OK(harness_start(NULL)); + PASS(errctx, run_program("10 STOP\n")); + TEST_REQUIRE(HARNESS_RUNTIME.stopped, "STOP should have armed CONT"); + + PASS(errctx, immediate("RUN")); + TEST_REQUIRE(!HARNESS_RUNTIME.stopped, "RUN should have disarmed CONT"); + + harness_stop(); + SUCCEED_RETURN(errctx); +} + +/** @brief SWAP refuses what it cannot exchange, and tolerates the identity case. */ +static akerr_ErrorContext AKERR_NOIGNORE *test_swap_refusals(void) +{ + PREPARE_ERROR(errctx); + akbasic_ASTLeaf *leaf = NULL; + akbasic_Value *out = NULL; + + TEST_REQUIRE_OK(harness_start(NULL)); + PASS(errctx, immediate("A# = 1")); + PASS(errctx, immediate("S$ = \"X\"")); + + /* Different types: the suffix is the only type declaration there is. */ + TEST_REQUIRE_OK(akbasic_environment_zero(HARNESS_RUNTIME.environment)); + TEST_REQUIRE_OK(harness_parse("SWAP A#, S$", &leaf)); + TEST_REQUIRE_STATUS(akbasic_runtime_evaluate(&HARNESS_RUNTIME, leaf, &out), + AKBASIC_ERR_TYPE); + + /* Not a variable. */ + TEST_REQUIRE_OK(akbasic_environment_zero(HARNESS_RUNTIME.environment)); + TEST_REQUIRE_OK(harness_parse("SWAP A#, 5", &leaf)); + TEST_REQUIRE_STATUS(akbasic_runtime_evaluate(&HARNESS_RUNTIME, leaf, &out), + AKBASIC_ERR_SYNTAX); + + /* Only one of them. */ + TEST_REQUIRE_OK(akbasic_environment_zero(HARNESS_RUNTIME.environment)); + TEST_REQUIRE_OK(harness_parse("SWAP A#", &leaf)); + TEST_REQUIRE_STATUS(akbasic_runtime_evaluate(&HARNESS_RUNTIME, leaf, &out), + AKBASIC_ERR_SYNTAX); + + /* A variable with itself is legal and leaves it alone, rather than corrupting it. */ + PASS(errctx, immediate("SWAP A#, A#")); + PASS(errctx, immediate("PRINT A#")); + TEST_REQUIRE_STR(HARNESS_OUTPUT, "1\n"); + + harness_stop(); + SUCCEED_RETURN(errctx); +} + +/** @brief HELP re-lists the line the last error happened on, and says so when there is none. */ +static akerr_ErrorContext AKERR_NOIGNORE *test_help(void) +{ + PREPARE_ERROR(errctx); + + TEST_REQUIRE_OK(harness_start(NULL)); + PASS(errctx, immediate("HELP")); + TEST_REQUIRE_STR(HARNESS_OUTPUT, "NO ERROR TO HELP WITH\n"); + + /* An out-of-bounds read on line 20, then HELP. */ + TEST_REQUIRE_OK(harness_start(NULL)); + PASS(errctx, run_program("10 DIM Q#(2)\n" + "20 PRINT Q#(9)\n" + "30 PRINT \"UNREACHED\"\n")); + TEST_REQUIRE_INT(HARNESS_RUNTIME.errorline, 20); + PASS(errctx, immediate("HELP")); + TEST_REQUIRE(strstr(HARNESS_OUTPUT, "20 PRINT Q#(9)") != NULL, + "HELP should re-list the line the error happened on, got: %s", HARNESS_OUTPUT); + + harness_stop(); + SUCCEED_RETURN(errctx); +} + +/** @brief TRON and TROFF move one flag, and the flag is what the run loop reads. */ +static akerr_ErrorContext AKERR_NOIGNORE *test_trace_flag(void) +{ + PREPARE_ERROR(errctx); + + TEST_REQUIRE_OK(harness_start(NULL)); + TEST_REQUIRE(!HARNESS_RUNTIME.trace, "tracing starts off"); + PASS(errctx, immediate("TRON")); + TEST_REQUIRE(HARNESS_RUNTIME.trace, "TRON turns tracing on"); + PASS(errctx, immediate("TROFF")); + TEST_REQUIRE(!HARNESS_RUNTIME.trace, "TROFF turns tracing off"); + + harness_stop(); + SUCCEED_RETURN(errctx); +} + +/** + * @brief An interactive session that errors and then ends does not spin. + * + * Not a group B verb, but found while testing them and fixed alongside: the + * runtime's error class is deliberately sticky, and with run_finished_mode REPL + * that meant every later step re-entered REPL mode and printed READY again -- + * overwriting the QUIT that end of input had just set. A session that hit one + * runtime error printed READY forever instead of exiting. + */ +static akerr_ErrorContext AKERR_NOIGNORE *test_repl_stops_after_an_error(void) +{ + PREPARE_ERROR(errctx); + int steps = 0; + + TEST_REQUIRE_OK(harness_start("10 PRINT NOSUCHTHING\nRUN\n")); + PASS(errctx, akbasic_runtime_start(&HARNESS_RUNTIME, AKBASIC_MODE_REPL)); + + /* Bounded, so a regression fails this test rather than hanging the suite. */ + while ( steps < 64 && HARNESS_RUNTIME.mode != AKBASIC_MODE_QUIT ) { + PASS(errctx, akbasic_runtime_run(&HARNESS_RUNTIME, 1)); + steps += 1; + } + TEST_REQUIRE_INT(HARNESS_RUNTIME.mode, AKBASIC_MODE_QUIT); + TEST_REQUIRE(steps < 64, "the REPL should quit at end of input, not spin"); + + harness_stop(); + SUCCEED_RETURN(errctx); +} + +int main(void) +{ + PREPARE_ERROR(errctx); + + ATTEMPT { + CATCH(errctx, test_new_and_clr()); + CATCH(errctx, test_clr_reclaims_storage()); + CATCH(errctx, test_cont()); + CATCH(errctx, test_run_disarms_cont()); + CATCH(errctx, test_swap_refusals()); + CATCH(errctx, test_help()); + CATCH(errctx, test_trace_flag()); + CATCH(errctx, test_repl_stops_after_an_error()); + } CLEANUP { + } PROCESS(errctx) { + } HANDLE_DEFAULT(errctx) { + LOG_ERROR_WITH_MESSAGE(errctx, "housekeeping verb test failed"); + akbasic_test_failures += 1; + } FINISH_NORETURN(errctx); + + return akbasic_test_failures; +} diff --git a/tests/language/housekeeping/verbs.bas b/tests/language/housekeeping/verbs.bas new file mode 100644 index 0000000..6cd67f6 --- /dev/null +++ b/tests/language/housekeeping/verbs.bas @@ -0,0 +1,22 @@ +10 REM Group B: the housekeeping verbs. None of these is in the Go reference -- +20 REM they are on its own unimplemented list -- so what each one means here is +30 REM a decision, recorded in src/runtime_housekeeping.c beside the verb. +40 A# = 1 : B# = 2 +50 PRINT A# : PRINT B# +60 SWAP A#, B# +70 PRINT A# : PRINT B# +80 REM SWAP exchanges the variables, so an array goes with its dimensions. +90 DIM P#(3) +100 DIM Q#(3) +110 P#(2) = 7 : Q#(2) = 9 +120 SWAP P#, Q# +130 PRINT P#(2) : PRINT Q#(2) +140 REM TRON prints each line number inline before the line runs, as a C128 does. +150 TRON +160 PRINT "TRACED" +170 TROFF +180 PRINT "NOT TRACED" +190 REM CLR drops the variables and keeps the program. +200 CLR +210 PRINT A# +220 PRINT "STILL RUNNING" diff --git a/tests/language/housekeeping/verbs.txt b/tests/language/housekeeping/verbs.txt new file mode 100644 index 0000000..4888d3f --- /dev/null +++ b/tests/language/housekeeping/verbs.txt @@ -0,0 +1,10 @@ +1 +2 +2 +1 +9 +7 +[160]TRACED +[170]NOT TRACED +0 +STILL RUNNING