A script written against LABEL and GOTO NAME never names a line number, so the numbers it had to carry were decoration. akbasic_runtime_load(), RUNSTREAM and DLOAD now file an unnumbered line one slot after the last one filed; a numbered line is filed under its number and moves the cursor, so the two mix. akbasic_runtime_file_line() is the one implementation of that rule, so the three paths cannot drift. The prompt is untouched. A line typed without a number is still direct mode and still runs now -- that is the only thing separating program text from a statement at a REPL, and it is why this is a loading feature. What this replaces was silent data loss: an unnumbered line was filed under the cursor unchanged, on top of the line before it. A blank line therefore erased whatever preceded it, and RUNSTREAM did not skip blank lines the way the other two paths did. That moves one golden file, and the reference had the same defect. language/arithmetic/integer.bas has four PRINT statements, an expectation with three values, and a trailing blank line that erased 40 PRINT 4 - 2 before the program ran. The expectation is now 4 4 2 2. tests/reference/README.md records the divergence and TODO.md section 5 item 63 says why. akbasic_SourceLine grows a `numbered` flag so an assigned number can be told from a written one. RENUMBER sets it on every line it touches; NEW, DELETE and DLOAD clear it. hadlinenumber moves to akbasic_scanner_scan(), so it always describes the line just scanned rather than only the REPL's. Two lines carrying the same written number still keep the last, as they always have. That is a separate decision. Co-Authored-By: Claude Opus 5 (1M context) <noreply@anthropic.com>
1029 lines
40 KiB
C
1029 lines
40 KiB
C
/**
|
|
* @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 <inttypes.h>
|
|
#include <stdio.h>
|
|
#include <stdlib.h>
|
|
#include <string.h>
|
|
|
|
#include <akerror.h>
|
|
#include <akstdlib.h>
|
|
|
|
#include <akbasic/error.h>
|
|
#include <akbasic/runtime.h>
|
|
#include <akbasic/scanner.h>
|
|
|
|
#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);
|
|
}
|