BASIC 7.0 has no records at all, so none of this is a port. The `@` suffix was not invented either: the Go reference reserved IDENTIFIER_STRUCT and never used it, and src/grammar.c rendered such a leaf as "NOT IMPLEMENTED" until now. Declaring the type is what buys the storage model. A TYPE states its fields, so an instance has a known slot count and is laid out exactly as an array is -- one contiguous run from the same value pool DIM already draws from, with field access as offset arithmetic. No new pool holds data; the only new table holds descriptors. A nested value flattens into its container's run, which is why LINE with two POINTs and a string is five slots rather than three. Each field takes its type from its own suffix, the same rule every other name here follows, so a field list needs no type column. An `@` field is the exception and has to name its type, because three primitive types fit in three suffix characters and N declared types do not fit in one. The declaration is prescanned before the program runs, like labels and DATA and for the same reason: it has to be in effect wherever control goes. Three passes, each for a case the one before cannot do -- names first so a field can refer to a type declared later, then field lists, then sizes by repeated resolution. What never resolves is a cycle of by-value containment, so "a TYPE cannot contain itself by value" is a diagnosis rather than an assumption, and the message says to use PTR TO instead. Assignment copies. That interception is the whole feature and it cannot live in akbasic_value_clone(), which copies one slot -- and one slot holds a *reference* to an instance rather than the instance, so going through it would alias. A structure is intercepted before that path and its slots are copied one at a time, walking the descriptor rather than memcpy-ing the run, because a pointer field must copy its reference where a value field must copy its slots. Two smaller things the work required. All three prescans now sit inside one ATTEMPT: a malformed declaration is the program's mistake, and it was printing a stack trace and taking the driver with it, which is the boundary goal 3 exists to draw. And a fresh variable's structtype is -1 rather than the 0 a memset leaves, because 0 is a valid type index and every new variable was claiming to be the first type declared. Co-Authored-By: Claude Opus 5 (1M context) <noreply@anthropic.com> Co-Authored-By: Andrew Kesterson <andrew@aklabs.net>
1010 lines
39 KiB
C
1010 lines
39 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;
|
|
PASS(errctx, akbasic_value_clone(result, &obj->environment->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);
|
|
}
|
|
|
|
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;
|
|
}
|
|
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->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_store_line(obj, obj->environment->lineno, 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);
|
|
}
|