/** * @file runtime_commands.c * @brief The verb implementations. * * Ported from basicruntime_commands.go. Every handler has the signature the * dispatch table demands, and every one returns its result through `dest`. */ #include #include #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 ) akerr_ErrorContext *akbasic_cmd_let(akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest) { PREPARE_ERROR(errctx); (void)expr; (void)lval; (void)rval; /* * LET is not required in this dialect or in Commodore BASIC 7.0. Assignment * is part of expression evaluation, so there is nothing for LET to do. */ SUCCEED_TRUE(obj, dest); SUCCEED_RETURN(errctx); } akerr_ErrorContext *akbasic_cmd_def(akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest) { PREPARE_ERROR(errctx); (void)expr; (void)lval; (void)rval; /* The parse handler already installed the function. */ SUCCEED_TRUE(obj, dest); SUCCEED_RETURN(errctx); } akerr_ErrorContext *akbasic_cmd_print(akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest) { PREPARE_ERROR(errctx); char rendered[AKBASIC_MAX_STRING_LENGTH]; (void)lval; (void)rval; FAIL_ZERO_RETURN(errctx, (expr != NULL), AKERR_NULLPOINTER, "NIL leaf"); if ( expr->right == NULL ) { PASS(errctx, akbasic_runtime_println(obj, "")); SUCCEED_TRUE(obj, dest); SUCCEED_RETURN(errctx); } /* * PRINT USING: the parse handler leaves an argument list of exactly two -- * the format and the value -- where a plain PRINT leaves a single * expression. The list is the only thing that tells them apart. */ { akbasic_ASTLeaf *arg = akbasic_leaf_first_argument(expr); if ( arg != NULL && arg->next != NULL ) { akbasic_Value *format = NULL; akbasic_Value *value = NULL; char formatted[AKBASIC_MAX_STRING_LENGTH]; PASS(errctx, akbasic_runtime_evaluate(obj, arg, &format)); FAIL_NONZERO_RETURN(errctx, (format->valuetype != AKBASIC_TYPE_STRING), AKBASIC_ERR_TYPE, "PRINT USING expected a format string"); PASS(errctx, akbasic_runtime_evaluate(obj, arg->next, &value)); PASS(errctx, akbasic_format_using(&obj->format_state, format->stringval, value, formatted, sizeof(formatted))); PASS(errctx, akbasic_runtime_println(obj, formatted)); SUCCEED_TRUE(obj, dest); SUCCEED_RETURN(errctx); } } PASS(errctx, akbasic_runtime_evaluate(obj, expr->right, dest)); /* * A structure renders through the type table rather than through * akbasic_value_to_string(), which sees one slot and cannot know an instance * is a run of them. Split out here rather than pushed down into value.c, * because value.c deliberately knows nothing about the runtime. */ if ( (*dest)->valuetype == AKBASIC_TYPE_STRUCT || (*dest)->valuetype == AKBASIC_TYPE_POINTER ) { if ( (*dest)->structbase == NULL ) { snprintf(rendered, sizeof(rendered), "NOTHING"); } else { PASS(errctx, akbasic_struct_to_string(obj, (*dest)->structtype, (*dest)->structbase, 0, rendered, sizeof(rendered))); } } else { PASS(errctx, akbasic_value_to_string(*dest, rendered, sizeof(rendered))); } PASS(errctx, akbasic_runtime_println(obj, rendered)); SUCCEED_TRUE(obj, dest); SUCCEED_RETURN(errctx); } akerr_ErrorContext *akbasic_cmd_goto(akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest) { PREPARE_ERROR(errctx); akbasic_Value *target = NULL; (void)lval; (void)rval; FAIL_ZERO_RETURN(errctx, (expr != NULL && expr->right != NULL), AKERR_NULLPOINTER, "Expected GOTO (line number or label)"); PASS(errctx, akbasic_runtime_evaluate(obj, expr->right, &target)); FAIL_NONZERO_RETURN(errctx, (target->valuetype != AKBASIC_TYPE_INTEGER), AKBASIC_ERR_TYPE, "Expected integer"); obj->environment->nextline = target->intval; SUCCEED_TRUE(obj, dest); SUCCEED_RETURN(errctx); } akerr_ErrorContext *akbasic_cmd_gosub(akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest) { PREPARE_ERROR(errctx); akbasic_Value *target = NULL; int64_t returnline = 0; (void)lval; (void)rval; FAIL_ZERO_RETURN(errctx, (expr != NULL && expr->right != NULL), AKERR_NULLPOINTER, "Expected GOSUB (line number or label)"); PASS(errctx, akbasic_runtime_evaluate(obj, expr->right, &target)); FAIL_NONZERO_RETURN(errctx, (target->valuetype != AKBASIC_TYPE_INTEGER), AKBASIC_ERR_TYPE, "Expected integer"); returnline = obj->environment->lineno + 1; PASS(errctx, akbasic_runtime_new_environment(obj)); obj->environment->gosubReturnLine = returnline; obj->environment->nextline = target->intval; SUCCEED_TRUE(obj, dest); SUCCEED_RETURN(errctx); } akerr_ErrorContext *akbasic_cmd_return(akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest) { PREPARE_ERROR(errctx); akbasic_Value *result = NULL; (void)lval; (void)rval; /* * A RETURN reached while skipping forward to one is the end of a DEF body, * not a subroutine return. Stop waiting and carry on. */ if ( akbasic_environment_is_waiting_for(obj->environment, "RETURN") ) { PASS(errctx, akbasic_environment_stop_waiting(obj->environment, "RETURN")); SUCCEED_TRUE(obj, dest); SUCCEED_RETURN(errctx); } FAIL_ZERO_RETURN(errctx, (obj->environment->gosubReturnLine != 0), AKBASIC_ERR_STATE, "RETURN outside the context of GOSUB"); if ( expr != NULL && expr->right != NULL ) { PASS(errctx, akbasic_runtime_evaluate(obj, expr->right, &result)); } else { result = &obj->staticTrueValue; } FAIL_ZERO_RETURN(errctx, (obj->environment->parent != NULL), AKBASIC_ERR_ENVIRONMENT, "RETURN from an orphaned environment"); obj->environment->parent->nextline = obj->environment->gosubReturnLine; /* * Parked on the *parent*, not on this environment. * * This one is about to be popped and released, so a caller reading a result * out of it would be reading a pool slot that is free again -- safe only for * as long as nothing else acquires one, which is not a property worth * relying on. The parent is the caller, which is exactly who wants it, and * it is still there afterwards. */ PASS(errctx, akbasic_value_clone(result, &obj->environment->parent->returnValue)); /* * Leaving an interrupt handler re-arms interrupts. Compared by identity * rather than by a depth counter so that a GOSUB the handler itself makes * returns without re-arming: it is *this* environment that has to pop. */ if ( obj->environment == obj->handlerenv ) { obj->handlerenv = NULL; } PASS(errctx, akbasic_runtime_prev_environment(obj)); *dest = result; SUCCEED_RETURN(errctx); } akerr_ErrorContext *akbasic_cmd_stop(akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest) { 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); } akerr_ErrorContext *akbasic_cmd_quit(akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest) { PREPARE_ERROR(errctx); (void)expr; (void)lval; (void)rval; /* * Sets a mode and returns. Nothing in this library calls exit() -- the * driver's main() decides what quitting means, and an embedding game may * decide it means something else entirely. */ PASS(errctx, akbasic_runtime_set_mode(obj, AKBASIC_MODE_QUIT)); SUCCEED_TRUE(obj, dest); SUCCEED_RETURN(errctx); } akerr_ErrorContext *akbasic_cmd_run(akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest) { PREPARE_ERROR(errctx); 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)); FAIL_NONZERO_RETURN(errctx, (target->valuetype != AKBASIC_TYPE_INTEGER), AKBASIC_ERR_TYPE, "Expected RUN (line number)"); obj->environment->nextline = target->intval; } PASS(errctx, akbasic_runtime_set_mode(obj, AKBASIC_MODE_RUN)); SUCCEED_TRUE(obj, dest); SUCCEED_RETURN(errctx); } akerr_ErrorContext *akbasic_cmd_label(akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest) { PREPARE_ERROR(errctx); (void)lval; (void)rval; FAIL_ZERO_RETURN(errctx, (expr != NULL && expr->right != NULL), AKERR_NULLPOINTER, "Expected LABEL IDENTIFIER"); FAIL_ZERO_RETURN(errctx, akbasic_leaf_is_identifier(expr->right), AKBASIC_ERR_SYNTAX, "Expected identifier"); PASS(errctx, akbasic_environment_set_label(obj->environment, expr->right->identifier, obj->environment->lineno)); SUCCEED_TRUE(obj, dest); SUCCEED_RETURN(errctx); } akerr_ErrorContext *akbasic_cmd_auto(akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest) { PREPARE_ERROR(errctx); akbasic_Value *step = NULL; (void)lval; (void)rval; if ( expr == NULL || expr->right == NULL ) { obj->autoLineNumber = 0; SUCCEED_TRUE(obj, dest); SUCCEED_RETURN(errctx); } PASS(errctx, akbasic_runtime_evaluate(obj, expr->right, &step)); FAIL_NONZERO_RETURN(errctx, (step->valuetype != AKBASIC_TYPE_INTEGER), AKBASIC_ERR_TYPE, "Expected AUTO (integer)"); obj->autoLineNumber = step->intval; SUCCEED_TRUE(obj, dest); SUCCEED_RETURN(errctx); } /** * @brief `DIM NAME@ AS TYPE`, or `DIM NAME@ AS PTR TO TYPE`. * * A value takes one run of slots sized by the type. A pointer takes one slot, * whatever it ends up pointing at -- it holds a reference, and a reference is * one value wide however large the thing on the other end is. */ static akerr_ErrorContext *dim_structure(akbasic_Runtime *obj, akbasic_ASTLeaf *expr) { PREPARE_ERROR(errctx); akbasic_Variable *variable = NULL; int64_t sizes[1] = { 1 }; int typeindex = -1; bool ispointer = (expr->literal_int != 0); FAIL_ZERO_RETURN(errctx, (expr->right->leaftype == AKBASIC_LEAF_IDENTIFIER_STRUCT), AKBASIC_ERR_TYPE, "DIM ... AS declares a structure, so %s must end in @", expr->right->identifier); PASS(errctx, akbasic_structtype_find(&obj->structtypes, expr->literal_string, &typeindex)); FAIL_ZERO_RETURN(errctx, (typeindex >= 0), AKBASIC_ERR_UNDEFINED, "TYPE %s is not declared", expr->literal_string); PASS(errctx, akbasic_environment_get(obj->environment, expr->right->identifier, &variable)); FAIL_ZERO_RETURN(errctx, (variable != NULL), AKBASIC_ERR_UNDEFINED, "Unable to get variable for identifier %s", expr->right->identifier); /* * Re-DIMming a structure is refused rather than allowed to grow. The value * pool never frees, so a growing re-DIM abandons its old slots -- and a * pointer still aimed at them would go on reading the abandoned copy, which * is stale rather than wild but wrong either way. Nothing needs it. */ FAIL_NONZERO_RETURN(errctx, (variable->structtype >= 0), AKBASIC_ERR_STATE, "%s is already DIMmed as a structure and cannot be re-DIMmed", expr->right->identifier); 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_zero(&variable->values[0])); variable->values[0].valuetype = AKBASIC_TYPE_POINTER; variable->values[0].structtype = typeindex; variable->values[0].structbase = NULL; SUCCEED_RETURN(errctx); } /* * Give every slot the type its field declared, so a record that has just * been DIMmed reads as zeros rather than as undefined values. A program can * PRINT one before assigning anything, and `RECT(W#=0, H#=0)` is an answer * where `(UNDEFINED STRING REPRESENTATION FOR 0)` is a puzzle. */ PASS(errctx, akbasic_struct_init_slots(obj, typeindex, variable->values)); SUCCEED_RETURN(errctx); } akerr_ErrorContext *akbasic_cmd_dim(akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest) { PREPARE_ERROR(errctx); akbasic_Variable *variable = NULL; akbasic_ASTLeaf *walk = NULL; akbasic_Value *size = NULL; int64_t sizes[AKBASIC_MAX_ARRAY_DEPTH]; int sizecount = 0; (void)lval; (void)rval; FAIL_ZERO_RETURN(errctx, (expr != NULL && expr->right != NULL && akbasic_leaf_is_identifier(expr->right)), AKBASIC_ERR_SYNTAX, "Expected DIM IDENTIFIER(DIMENSIONS, ...)"); /* * `DIM P@ AS RECT` takes a run of slots sized by the type, which is the same * thing `DIM A#(10)` does and deliberately so: a declared TYPE has a known * slot count, so an instance is laid out exactly as an array is and needs no * pool of its own. */ if ( expr->literal_string[0] != '\0' ) { PASS(errctx, dim_structure(obj, expr)); SUCCEED_TRUE(obj, dest); SUCCEED_RETURN(errctx); } FAIL_ZERO_RETURN(errctx, (expr->right->expr != NULL && expr->right->expr->leaftype == AKBASIC_LEAF_ARGUMENTLIST && expr->right->expr->operator_ == AKBASIC_TOK_ARRAY_SUBSCRIPT), AKBASIC_ERR_SYNTAX, "Expected DIM IDENTIFIER(DIMENSIONS, ...)"); PASS(errctx, akbasic_environment_get(obj->environment, expr->right->identifier, &variable)); FAIL_ZERO_RETURN(errctx, (variable != NULL), AKBASIC_ERR_UNDEFINED, "Unable to get variable for identifier %s", expr->right->identifier); for ( walk = expr->right->expr->right; walk != NULL; walk = walk->next ) { FAIL_ZERO_RETURN(errctx, (sizecount < AKBASIC_MAX_ARRAY_DEPTH), AKBASIC_ERR_BOUNDS, "More than %d array dimensions", AKBASIC_MAX_ARRAY_DEPTH); PASS(errctx, akbasic_runtime_evaluate(obj, walk, &size)); FAIL_NONZERO_RETURN(errctx, (size->valuetype != AKBASIC_TYPE_INTEGER), AKBASIC_ERR_TYPE, "Array dimensions must evaluate to integer"); sizes[sizecount] = size->intval; sizecount += 1; } PASS(errctx, akbasic_variable_init(variable, &obj->valuepool, sizes, sizecount)); PASS(errctx, akbasic_variable_zero(variable)); SUCCEED_TRUE(obj, dest); SUCCEED_RETURN(errctx); } /* * POKE and PEEK write and read a single byte at a caller-supplied address. * * The pointer.bas golden case sets A# = 255 and expects PEEK(POINTER(A#)) to be * 255, which holds only on a little-endian machine: A# is an int64_t and the * low byte has to come first. Stated here rather than discovered later. */ akerr_ErrorContext *akbasic_cmd_poke(akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest) { PREPARE_ERROR(errctx); akbasic_ASTLeaf *arg = NULL; akbasic_Value *addrval = NULL; akbasic_Value *byteval = NULL; uint8_t *target = NULL; (void)lval; (void)rval; FAIL_ZERO_RETURN(errctx, (expr != NULL), AKERR_NULLPOINTER, "NIL leaf"); arg = akbasic_leaf_first_argument(expr); FAIL_ZERO_RETURN(errctx, (arg != NULL), AKBASIC_ERR_SYNTAX, "POKE expected INTEGER, INTEGER"); /* The address must be the live value, not a copy of it. */ obj->eval_clone_identifiers = false; ATTEMPT { CATCH(errctx, akbasic_runtime_evaluate(obj, arg, &addrval)); } CLEANUP { obj->eval_clone_identifiers = true; } PROCESS(errctx) { } FINISH(errctx, true); FAIL_NONZERO_RETURN(errctx, (addrval->valuetype != AKBASIC_TYPE_INTEGER), AKBASIC_ERR_TYPE, "POKE expected INTEGER, INTEGER"); FAIL_ZERO_RETURN(errctx, (arg->next != NULL && (arg->next->leaftype == AKBASIC_LEAF_LITERAL_INT || arg->next->leaftype == AKBASIC_LEAF_IDENTIFIER_INT)), AKBASIC_ERR_SYNTAX, "POKE expected INTEGER, INTEGER"); FAIL_ZERO_RETURN(errctx, (addrval->intval != 0), AKBASIC_ERR_VALUE, "POKE got NIL pointer or uninitialized variable"); PASS(errctx, akbasic_runtime_evaluate(obj, arg->next, &byteval)); target = (uint8_t *)(uintptr_t)addrval->intval; *target = (uint8_t)byteval->intval; SUCCEED_TRUE(obj, dest); SUCCEED_RETURN(errctx); } akerr_ErrorContext *akbasic_cmd_input(akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest) { PREPARE_ERROR(errctx); akbasic_ASTLeaf *identifier = NULL; akbasic_Value *prompt = NULL; akbasic_Value *entered = NULL; akbasic_Value *unused = NULL; char rendered[AKBASIC_MAX_STRING_LENGTH]; char buffer[AKBASIC_MAX_LINE_LENGTH]; long long converted = 0; bool eof = false; (void)lval; (void)rval; FAIL_ZERO_RETURN(errctx, (expr != NULL && expr->right != NULL), AKERR_NULLPOINTER, "Expected INPUT \"PROMPT\" IDENTIFIER"); identifier = expr->right; if ( identifier->left != NULL ) { PASS(errctx, akbasic_runtime_evaluate(obj, identifier->left, &prompt)); PASS(errctx, akbasic_value_to_string(prompt, rendered, sizeof(rendered))); PASS(errctx, akbasic_runtime_write(obj, rendered)); } PASS(errctx, obj->sink->readline(obj->sink, buffer, sizeof(buffer), &eof)); if ( eof ) { obj->inputEof = true; buffer[0] = '\0'; } PASS(errctx, akbasic_environment_new_value(obj->environment, &entered)); PASS(errctx, akbasic_value_zero(entered)); switch ( identifier->leaftype ) { case AKBASIC_LEAF_IDENTIFIER_INT: entered->valuetype = AKBASIC_TYPE_INTEGER; PASS(errctx, aksl_atoll(buffer, &converted)); entered->intval = (int64_t)converted; break; case AKBASIC_LEAF_IDENTIFIER_FLOAT: entered->valuetype = AKBASIC_TYPE_FLOAT; PASS(errctx, aksl_atof(buffer, &entered->floatval)); break; default: entered->valuetype = AKBASIC_TYPE_STRING; FAIL_ZERO_RETURN(errctx, (strlen(buffer) < AKBASIC_MAX_STRING_LENGTH), AKBASIC_ERR_VALUE, "Input line exceeds the %d character limit", AKBASIC_MAX_STRING_LENGTH - 1); strncpy(entered->stringval, buffer, AKBASIC_MAX_STRING_LENGTH - 1); entered->stringval[AKBASIC_MAX_STRING_LENGTH - 1] = '\0'; break; } PASS(errctx, akbasic_environment_assign(obj->environment, identifier, entered, &unused)); SUCCEED_TRUE(obj, dest); SUCCEED_RETURN(errctx); } /* LIST and DELETE share the range grammar: bare, n, -n, or n-n. */ static akerr_ErrorContext *parse_line_range(akbasic_Runtime *obj, akbasic_ASTLeaf *expr, int64_t *startidx, int64_t *endidx) { PREPARE_ERROR(errctx); akbasic_Value *value = NULL; *startidx = 0; *endidx = AKBASIC_MAX_SOURCE_LINES - 1; if ( expr == NULL || expr->right == NULL ) { SUCCEED_RETURN(errctx); } if ( expr->right->leaftype == AKBASIC_LEAF_BINARY && expr->right->operator_ == AKBASIC_TOK_MINUS ) { /* n-n: a subtraction leaf is how the expression parser sees a range. */ PASS(errctx, akbasic_runtime_evaluate(obj, expr->right->left, &value)); FAIL_NONZERO_RETURN(errctx, (value->valuetype != AKBASIC_TYPE_INTEGER), AKBASIC_ERR_TYPE, "Expected a line number range"); *startidx = value->intval; PASS(errctx, akbasic_runtime_evaluate(obj, expr->right->right, &value)); FAIL_NONZERO_RETURN(errctx, (value->valuetype != AKBASIC_TYPE_INTEGER), AKBASIC_ERR_TYPE, "Expected a line number range"); *endidx = value->intval; SUCCEED_RETURN(errctx); } if ( expr->right->leaftype == AKBASIC_LEAF_UNARY && expr->right->operator_ == AKBASIC_TOK_MINUS ) { /* -n: from the start through n. A unary leaf's operand is on .left. */ PASS(errctx, akbasic_runtime_evaluate(obj, expr->right->left, &value)); FAIL_NONZERO_RETURN(errctx, (value->valuetype != AKBASIC_TYPE_INTEGER), AKBASIC_ERR_TYPE, "Expected a line number range"); *endidx = value->intval; SUCCEED_RETURN(errctx); } /* n: from n to the end. */ PASS(errctx, akbasic_runtime_evaluate(obj, expr->right, &value)); FAIL_NONZERO_RETURN(errctx, (value->valuetype != AKBASIC_TYPE_INTEGER), AKBASIC_ERR_TYPE, "Expected a line number range"); *startidx = value->intval; SUCCEED_RETURN(errctx); } akerr_ErrorContext *akbasic_cmd_list(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]; int64_t startidx = 0; int64_t endidx = 0; int64_t i = 0; (void)lval; (void)rval; PASS(errctx, parse_line_range(obj, expr, &startidx, &endidx)); if ( startidx < 0 ) { startidx = 0; } if ( endidx >= AKBASIC_MAX_SOURCE_LINES ) { endidx = AKBASIC_MAX_SOURCE_LINES - 1; } for ( i = startidx; i <= endidx; i++ ) { if ( obj->source[i].code[0] == '\0' ) { continue; } snprintf(line, sizeof(line), "%" PRId64 " %s", i, obj->source[i].code); PASS(errctx, akbasic_runtime_println(obj, line)); } SUCCEED_TRUE(obj, dest); SUCCEED_RETURN(errctx); } akerr_ErrorContext *akbasic_cmd_delete(akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest) { PREPARE_ERROR(errctx); int64_t startidx = 0; int64_t endidx = 0; int64_t i = 0; (void)lval; (void)rval; PASS(errctx, parse_line_range(obj, expr, &startidx, &endidx)); if ( startidx < 0 ) { startidx = 0; } if ( endidx >= AKBASIC_MAX_SOURCE_LINES ) { endidx = AKBASIC_MAX_SOURCE_LINES - 1; } for ( i = startidx; i <= endidx; i++ ) { obj->source[i].code[0] = '\0'; obj->source[i].lineno = 0; obj->source[i].numbered = false; } SUCCEED_TRUE(obj, dest); SUCCEED_RETURN(errctx); } /* Resolve a DLOAD/DSAVE filename argument to a string. */ static akerr_ErrorContext *filename_argument(akbasic_Runtime *obj, akbasic_ASTLeaf *expr, char *dest, size_t len) { PREPARE_ERROR(errctx); akbasic_Value *value = NULL; FAIL_ZERO_RETURN(errctx, (expr != NULL && expr->right != NULL), AKBASIC_ERR_SYNTAX, "Expected a filename"); PASS(errctx, akbasic_runtime_evaluate(obj, expr->right, &value)); FAIL_NONZERO_RETURN(errctx, (value->valuetype != AKBASIC_TYPE_STRING), AKBASIC_ERR_TYPE, "Expected a filename string"); FAIL_ZERO_RETURN(errctx, (value->stringval[0] != '\0'), AKBASIC_ERR_VALUE, "Filename must not be empty"); FAIL_ZERO_RETURN(errctx, (strlen(value->stringval) < len), AKBASIC_ERR_BOUNDS, "Filename exceeds the %zu character limit", len - 1); strncpy(dest, value->stringval, len - 1); dest[len - 1] = '\0'; SUCCEED_RETURN(errctx); } akerr_ErrorContext *akbasic_cmd_dload(akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest) { PREPARE_ERROR(errctx); char filename[AKBASIC_MAX_STRING_LENGTH]; char buffer[AKBASIC_MAX_LINE_LENGTH]; char scanned[AKBASIC_MAX_LINE_LENGTH]; FILE *fp = NULL; size_t used = 0; int64_t i = 0; (void)lval; (void)rval; /* * aksl_fopen does not NULL-check pathname or mode and fopen(NULL, ...) is * undefined, so the name is validated here before it is handed over -- * deps/libakstdlib/TODO.md 2.2.2. */ PASS(errctx, filename_argument(obj, expr, filename, sizeof(filename))); /* DLOAD replaces the program in memory, so clear it before reading. */ 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; } obj->environment->lineno = 0; obj->environment->nextline = 0; ATTEMPT { CATCH(errctx, aksl_fopen(filename, "r", &fp)); while ( fgets(buffer, sizeof(buffer), fp) != NULL ) { used = strlen(buffer); while ( used > 0 && (buffer[used - 1] == '\n' || buffer[used - 1] == '\r') ) { buffer[used - 1] = '\0'; used -= 1; } if ( buffer[0] == '\0' ) { continue; } /* * PASS inside the loop, never CATCH: CATCH expands to a break, which * would leave this loop rather than the ATTEMPT and let the rest of * the block run with an error pending. */ PASS(errctx, akbasic_scanner_scan(obj, buffer, scanned, sizeof(scanned))); PASS(errctx, akbasic_runtime_file_line(obj, scanned)); } } CLEANUP { if ( fp != NULL ) { IGNORE(aksl_fclose(fp)); } } PROCESS(errctx) { } FINISH(errctx, true); /* * Abandon the rest of the line that ran this. Scanning the file above went * through the runtime's own scanner, so the tokens of the calling line are * gone and `hadlinenumber` and `environment->lineno` now describe the last * line of the *file*. Carrying on would parse whatever the scanner happens * to be holding and, in REPL mode, file the DLOAD command itself as program * text under that line number -- which silently overwrote the last line of * every program loaded this way. */ obj->skiprestofline = true; SUCCEED_TRUE(obj, dest); SUCCEED_RETURN(errctx); } akerr_ErrorContext *akbasic_cmd_dsave(akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest) { PREPARE_ERROR(errctx); char filename[AKBASIC_MAX_STRING_LENGTH]; char line[AKBASIC_MAX_LINE_LENGTH * 2]; FILE *fp = NULL; int64_t i = 0; int count = 0; size_t written = 0; (void)lval; (void)rval; PASS(errctx, filename_argument(obj, expr, filename, sizeof(filename))); ATTEMPT { CATCH(errctx, aksl_fopen(filename, "w", &fp)); for ( i = 0; i < AKBASIC_MAX_SOURCE_LINES; i++ ) { if ( obj->source[i].code[0] == '\0' ) { continue; } snprintf(line, sizeof(line), "%" PRId64 " %s\n", i, obj->source[i].code); /* * The written count is required by libakstdlib 0.2.0 and discarded * here on purpose: a short write is no longer something a caller has * to notice for itself, because that release made it an AKERR_IO * rather than a silent success. Before it, a DSAVE onto a full disk * reported nothing. */ PASS(errctx, aksl_fwrite(line, 1, strlen(line), fp, &written)); count += 1; } } CLEANUP { if ( fp != NULL ) { IGNORE(aksl_fclose(fp)); } } PROCESS(errctx) { } FINISH(errctx, true); SUCCEED_TRUE(obj, dest); SUCCEED_RETURN(errctx); } akerr_ErrorContext *akbasic_cmd_if(akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest) { PREPARE_ERROR(errctx); (void)obj; (void)expr; (void)lval; (void)rval; (void)dest; /* * Unreachable in practice: the IF parse handler produces a BRANCH leaf, and * evaluate() handles BRANCH directly. It exists so the table has an exec * handler for IF and a stray IF leaf produces a diagnosis rather than * "Unknown command". */ FAIL_RETURN(errctx, AKBASIC_ERR_STATE, "Malformed IF statement"); } /* * The loop condition, evaluated at the bottom of the structure. A negative step * means the loop runs while the counter is at or above the TO value; a positive * one, at or below. True means the loop is finished. */ static akerr_ErrorContext *evaluate_for_condition(akbasic_Runtime *obj, akbasic_Value *counter, bool *met) { PREPARE_ERROR(errctx); akbasic_Value zero; akbasic_Value scratch; akbasic_Value *truth = NULL; FAIL_ZERO_RETURN(errctx, (counter != NULL), AKERR_NULLPOINTER, "NIL pointer for rval"); PASS(errctx, akbasic_value_zero(&zero)); zero.valuetype = AKBASIC_TYPE_INTEGER; zero.intval = 0; PASS(errctx, akbasic_value_less_than(&obj->environment->forStepValue, &zero, &scratch, &truth)); if ( akbasic_value_is_true(truth) ) { PASS(errctx, akbasic_value_greater_than_equal(&obj->environment->forToValue, counter, &scratch, &truth)); } else { PASS(errctx, akbasic_value_less_than_equal(&obj->environment->forToValue, counter, &scratch, &truth)); } *met = akbasic_value_is_true(truth); SUCCEED_RETURN(errctx); } akerr_ErrorContext *akbasic_cmd_for(akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest) { PREPARE_ERROR(errctx); akbasic_Value *assignval = NULL; akbasic_Value *tmp = NULL; akbasic_Value *counter = NULL; int64_t zerosubscript[1] = { 0 }; bool met = false; (void)lval; (void)rval; FAIL_ZERO_RETURN(errctx, (obj->environment->forToLeaf != NULL && expr != NULL && expr->right != NULL), AKBASIC_ERR_STATE, "Expected FOR ... TO [STEP ...]"); FAIL_ZERO_RETURN(errctx, (expr->right->left != NULL && (expr->right->left->leaftype == AKBASIC_LEAF_IDENTIFIER_INT || expr->right->left->leaftype == AKBASIC_LEAF_IDENTIFIER_FLOAT || expr->right->left->leaftype == AKBASIC_LEAF_IDENTIFIER_STRING)), AKBASIC_ERR_SYNTAX, "Expected variable in FOR loop"); PASS(errctx, akbasic_runtime_evaluate(obj, expr->right, &assignval)); PASS(errctx, akbasic_environment_get(obj->environment, expr->right->left->identifier, &obj->environment->forNextVariable)); FAIL_ZERO_RETURN(errctx, (obj->environment->forNextVariable != NULL), AKBASIC_ERR_UNDEFINED, "Unable to get loop variable %s", expr->right->left->identifier); PASS(errctx, akbasic_variable_set_subscript(obj->environment->forNextVariable, assignval, zerosubscript, 1)); PASS(errctx, akbasic_runtime_evaluate(obj, obj->environment->forToLeaf, &tmp)); PASS(errctx, akbasic_value_clone(tmp, &obj->environment->forToValue)); PASS(errctx, akbasic_runtime_evaluate(obj, obj->environment->forStepLeaf, &tmp)); PASS(errctx, akbasic_value_clone(tmp, &obj->environment->forStepValue)); obj->environment->forToLeaf = NULL; obj->environment->forStepLeaf = NULL; PASS(errctx, akbasic_variable_get_subscript(obj->environment->forNextVariable, zerosubscript, 1, &counter)); PASS(errctx, evaluate_for_condition(obj, counter, &met)); if ( met ) { /* Zero iterations: skip the body entirely by waiting for the NEXT. */ PASS(errctx, akbasic_environment_wait_for_command(obj->environment, "NEXT")); } SUCCEED_TRUE(obj, dest); SUCCEED_RETURN(errctx); } akerr_ErrorContext *akbasic_cmd_next(akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest) { PREPARE_ERROR(errctx); akbasic_Variable *nextvar = NULL; akbasic_Value *counter = NULL; akbasic_Value *updated = NULL; akbasic_Value scratch; int64_t zerosubscript[1] = { 0 }; bool met = false; (void)lval; (void)rval; FAIL_ZERO_RETURN(errctx, (obj->environment->forNextVariable != NULL), AKBASIC_ERR_STATE, "NEXT outside the context of FOR"); FAIL_ZERO_RETURN(errctx, (expr != NULL && expr->right != NULL), AKBASIC_ERR_SYNTAX, "Expected NEXT IDENTIFIER"); FAIL_ZERO_RETURN(errctx, (expr->right->leaftype == AKBASIC_LEAF_IDENTIFIER_INT || expr->right->leaftype == AKBASIC_LEAF_IDENTIFIER_FLOAT), AKBASIC_ERR_TYPE, "FOR ... NEXT only valid over INT and FLOAT types"); obj->environment->loopExitLine = obj->environment->lineno + 1; /* * An EXIT sent us here. The loop is over whatever the counter says, and it * is over for *this* loop -- EXIT leaves the innermost one, and the wait it * armed is on the innermost environment, so the first NEXT reached is the * right one whether or not it names the same variable. */ if ( obj->environment->exiting ) { obj->environment->exiting = false; PASS(errctx, akbasic_environment_stop_waiting(obj->environment, "NEXT")); FAIL_ZERO_RETURN(errctx, (obj->environment->parent != NULL), AKBASIC_ERR_ENVIRONMENT, "NEXT in an orphaned environment"); obj->environment->parent->nextline = obj->environment->loopExitLine; PASS(errctx, akbasic_runtime_prev_environment(obj)); *dest = &obj->staticFalseValue; SUCCEED_RETURN(errctx); } /* * A NEXT for someone else's loop variable: this environment is done, hand * the line back to the parent and pop. That is how nested loops unwind. */ if ( strcmp(expr->right->identifier, obj->environment->forNextVariable->name) != 0 ) { FAIL_ZERO_RETURN(errctx, (obj->environment->parent != NULL), AKBASIC_ERR_ENVIRONMENT, "NEXT in an orphaned environment"); obj->environment->parent->nextline = obj->environment->nextline; PASS(errctx, akbasic_runtime_prev_environment(obj)); *dest = &obj->staticFalseValue; SUCCEED_RETURN(errctx); } PASS(errctx, akbasic_environment_get(obj->environment, expr->right->identifier, &nextvar)); FAIL_ZERO_RETURN(errctx, (nextvar != NULL), AKBASIC_ERR_UNDEFINED, "Unable to get loop variable %s", expr->right->identifier); PASS(errctx, akbasic_variable_get_subscript(nextvar, zerosubscript, 1, &counter)); PASS(errctx, evaluate_for_condition(obj, counter, &met)); PASS(errctx, akbasic_environment_stop_waiting(obj->environment, "NEXT")); if ( met ) { if ( obj->environment->parent != NULL ) { obj->environment->parent->nextline = obj->environment->nextline; PASS(errctx, akbasic_runtime_prev_environment(obj)); } SUCCEED_TRUE(obj, dest); SUCCEED_RETURN(errctx); } /* * Advance the counter, then store it. math_plus clones like every other * operator, so the sum lands in `scratch` and this is what puts it back in * the variable. The reference relied on math_plus mutating the counter in * place instead, which meant `A# + 1` anywhere in a program could modify * `A#` -- TODO.md section 6 item 4. */ PASS(errctx, akbasic_value_math_plus(counter, &obj->environment->forStepValue, &scratch, &updated)); PASS(errctx, akbasic_variable_set_subscript(nextvar, updated, zerosubscript, 1)); obj->environment->nextline = obj->environment->loopFirstLine; SUCCEED_TRUE(obj, dest); SUCCEED_RETURN(errctx); } akerr_ErrorContext *akbasic_cmd_exit(akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest) { PREPARE_ERROR(errctx); (void)expr; (void)lval; (void)rval; /* * EXIT leaves whichever kind of loop it is standing in, so which verb it * skips forward to depends on that: NEXT for a FOR, LOOP for a DO. */ FAIL_NONZERO_RETURN(errctx, (obj->environment->forToValue.valuetype == AKBASIC_TYPE_UNDEFINED && !obj->environment->isDoLoop), AKBASIC_ERR_STATE, "EXIT outside the context of FOR or DO"); FAIL_ZERO_RETURN(errctx, (obj->environment->parent != NULL), AKBASIC_ERR_ENVIRONMENT, "EXIT in an orphaned environment"); /* * Skip forward to the loop's NEXT rather than jumping past it. The reference * jumps to loopExitLine, which is only ever written by NEXT itself -- so an * EXIT on the first pass through the loop, which is the ordinary case, jumps * to line 0 and restarts the program. Each restart enters FOR again and * takes another environment and another variable, so what a reader sees is * "Maximum runtime variables reached" reported against the FOR. * * The wait does the work instead: nothing between here and the NEXT * executes, the NEXT sees `exiting` and pops rather than looping, and * neither this verb nor that one has to know where the loop ends. */ obj->environment->exiting = true; PASS(errctx, akbasic_environment_wait_for_command(obj->environment, (obj->environment->isDoLoop ? "LOOP" : "NEXT"))); SUCCEED_TRUE(obj, dest); SUCCEED_RETURN(errctx); } akerr_ErrorContext *akbasic_cmd_read(akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest) { PREPARE_ERROR(errctx); akbasic_Environment *env = obj->environment; akbasic_ASTLeaf *identifier = NULL; akbasic_ASTLeaf assign; akbasic_ASTLeaf literal; akbasic_Value value; akbasic_Value *unused = NULL; int i = 0; (void)expr; (void)lval; (void)rval; /* * READ now reads. The reference records its identifiers, sets the scope * waiting for a DATA verb and lets execution skip forward until one turns up * -- which never finds a DATA line written *above* the READ, and leaves * nothing for RESTORE to reset. Every DATA item is pre-scanned into one list * before the program runs (see akbasic_data_scan), and this walks a cursor * along it. TODO.md section 6. */ for ( i = 0; i < AKBASIC_MAX_LEAVES; i++ ) { identifier = env->readIdentifierLeaves[i]; if ( identifier == NULL ) { break; } PASS(errctx, akbasic_data_next(obj, akbasic_leaf_identifier_type(identifier), &value)); /* * Build the assignment by hand rather than through the parser: the * identifier leaf is a stored copy and the value came from the item * list, so there is no source text to re-parse. */ PASS(errctx, akbasic_leaf_init(&literal, AKBASIC_LEAF_LITERAL_INT)); if ( value.valuetype == AKBASIC_TYPE_STRING ) { literal.leaftype = AKBASIC_LEAF_LITERAL_STRING; snprintf(literal.literal_string, sizeof(literal.literal_string), "%s", value.stringval); } else if ( value.valuetype == AKBASIC_TYPE_FLOAT ) { literal.leaftype = AKBASIC_LEAF_LITERAL_FLOAT; literal.literal_float = value.floatval; } else { literal.literal_int = value.intval; } PASS(errctx, akbasic_leaf_init(&assign, AKBASIC_LEAF_BINARY)); assign.left = identifier; assign.right = &literal; assign.operator_ = AKBASIC_TOK_ASSIGNMENT; PASS(errctx, akbasic_runtime_evaluate(obj, &assign, &unused)); } env->readIdentifierIdx = 0; SUCCEED_TRUE(obj, dest); SUCCEED_RETURN(errctx); } akerr_ErrorContext *akbasic_cmd_restore(akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest) { PREPARE_ERROR(errctx); akbasic_Value *target = NULL; int64_t line = 0; int i = 0; (void)lval; (void)rval; FAIL_ZERO_RETURN(errctx, (obj != NULL && dest != NULL), AKERR_NULLPOINTER, "NULL argument in RESTORE"); if ( expr == NULL || expr->right == NULL ) { /* Bare RESTORE goes back to the first item, which is what a C128 does. */ obj->data_state.cursor = 0; SUCCEED_TRUE(obj, dest); SUCCEED_RETURN(errctx); } PASS(errctx, akbasic_runtime_evaluate(obj, expr->right, &target)); FAIL_NONZERO_RETURN(errctx, (target->valuetype != AKBASIC_TYPE_INTEGER), AKBASIC_ERR_TYPE, "RESTORE expected a line number or a label"); line = target->intval; /* * The first item at or after that line. "At or after" rather than "on", * because RESTORE 100 in a program whose DATA is on line 110 should find it * -- a program names the line it wants to start reading *from*. */ for ( i = 0; i < obj->data_state.count; i++ ) { if ( obj->data_state.items[i].lineno >= line ) { obj->data_state.cursor = i; SUCCEED_TRUE(obj, dest); SUCCEED_RETURN(errctx); } } /* Nothing at or after it: the next READ is out of data, which is honest. */ obj->data_state.cursor = obj->data_state.count; SUCCEED_TRUE(obj, dest); SUCCEED_RETURN(errctx); } akerr_ErrorContext *akbasic_cmd_data(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 DATA"); /* * Nothing to do. DATA is declaration, not execution: every item was * collected into the item list before the program started, so reaching the * statement means walking past it. The reference did the assigning here, * which is why READ had to skip forward to find one. */ SUCCEED_TRUE(obj, dest); SUCCEED_RETURN(errctx); }