Files
akbasic/src/runtime_commands.c
Tachikoma b434be1901 Port onto libakstdlib 2b79aca and convert the eight bool predicates
akbasic's src/ now calls libakstdlib 313 times and raw libc 7 -- 2.2%
bypassed, against 86.4% on the same tree before this. The submodule bump
669b2b3 -> 2b79aca needed no source change of its own: the release is
drop-in for what akbasic already used.

Seven of the eight sites the earlier port left on raw libc change their own
signature rather than swallowing an error, per andrew's ruling on
libakstdlib#38. word_is, the is_waiting_for pair, the scanner's is_at_end,
peek, peek_next and match_next_char, format.c's overflow, and sink_akgl's
scroll/newline/putchar_at/echo_line/edit_key chain all return an
akerr_ErrorContext * and hand the answer back through an out parameter.
is_waiting_for and is_waiting_for_any are a public header change; every
call site that used one as a term in a condition hoists it into a
statement first.

verb_compare is the eighth and stays on strcmp. bsearch(3) fixes the
comparator's signature, so there is no out parameter to report through --
which is what libakstdlib#38 concluded. It carries a comment saying so and
saying why the bypass is safe there.

Six snprintf sites stay raw because they want truncation as an answer
rather than an error, and aksl_snprintf cannot express that until
libakstdlib#34 hands the required length back. Each of the six says so at
the site. Two of them, in host.c, are a latent defect rather than a
decision: a host type name over 31 characters truncates silently and two
sharing a prefix then collide, where structtype.c refuses the same case.

DLOAD leaked a file descriptor. Its read loop sat inside an ATTEMPT and the
PASS in it returned past CLEANUP, so a scan error left the file open.
Hoisting the loop into its own helper to convert fgets fixes it.

Refs libakstdlib#26, libakstdlib#38

Co-Authored-By: Claude Opus 5 (1M context) <noreply@anthropic.com>
2026-08-03 21:23:32 -04:00

1109 lines
42 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 <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 ) {
PASS(errctx, aksl_strcpy(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;
bool waiting = false;
(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.
*/
PASS(errctx, akbasic_environment_is_waiting_for(obj->environment, "RETURN", &waiting));
if ( waiting ) {
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;
size_t len = 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;
PASS(errctx, aksl_strlen(buffer, &len));
FAIL_ZERO_RETURN(errctx, (len < AKBASIC_MAX_STRING_LENGTH), AKBASIC_ERR_VALUE,
"Input line exceeds the %d character limit", AKBASIC_MAX_STRING_LENGTH - 1);
/* aksl_strcpy always terminates, so the explicit terminator is gone. */
PASS(errctx, aksl_strcpy(entered->stringval, sizeof(entered->stringval), buffer));
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;
int written = 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;
}
PASS(errctx, aksl_snprintf(&written, 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;
size_t namelen = 0;
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");
PASS(errctx, aksl_strlen(value->stringval, &namelen));
FAIL_ZERO_RETURN(errctx, (namelen < len), AKBASIC_ERR_BOUNDS,
"Filename exceeds the %zu character limit", len - 1);
/* aksl_strcpy always terminates, so the explicit terminator is gone. */
PASS(errctx, aksl_strcpy(dest, len, value->stringval));
SUCCEED_RETURN(errctx);
}
/**
* @brief Read one line, reporting end of stream rather than raising it.
*
* aksl_fgets raises AKERR_EOF where fgets(3) returned NULL, so the end of an
* ordinary file arrives as an error and has to be handled. It is handled here,
* in a function whose ATTEMPT block contains no loop at all, because a CATCH
* inside a loop expands to a break that leaves the loop rather than the
* ATTEMPT. The caller reads @p eof instead.
*/
static akerr_ErrorContext *dload_read_line(FILE *fp, char *buffer, size_t len, bool *eof)
{
PREPARE_ERROR(errctx);
size_t used = 0;
*eof = false;
ATTEMPT {
CATCH(errctx, aksl_fgets(buffer, len, fp, &used));
} CLEANUP {
} PROCESS(errctx) {
} HANDLE(errctx, AKERR_EOF) {
*eof = true;
used = 0;
} FINISH(errctx, true);
while ( used > 0 && (buffer[used - 1] == '\n' || buffer[used - 1] == '\r') ) {
buffer[used - 1] = '\0';
used -= 1;
}
SUCCEED_RETURN(errctx);
}
/**
* @brief Read a whole program in, one line at a time.
*
* Hoisted out of akbasic_cmd_dload()'s ATTEMPT block because a loop inside one
* can use neither CATCH -- which breaks the loop -- nor PASS, which returns
* past CLEANUP and leaves the file open. Out here PASS is correct, and the
* caller CATCHes this one call.
*/
static akerr_ErrorContext *dload_read_program(akbasic_Runtime *obj, FILE *fp,
char *buffer, size_t buflen,
char *scanned, size_t scanlen)
{
PREPARE_ERROR(errctx);
bool eof = false;
for ( ;; ) {
PASS(errctx, dload_read_line(fp, buffer, buflen, &eof));
if ( eof ) {
break;
}
if ( buffer[0] == '\0' ) {
continue;
}
PASS(errctx, akbasic_scanner_scan(obj, buffer, scanned, scanlen));
PASS(errctx, akbasic_runtime_file_line(obj, scanned));
}
SUCCEED_RETURN(errctx);
}
/**
* @brief Write every stored line out, numbered.
*
* Hoisted out of akbasic_cmd_dsave()'s ATTEMPT block for the same reason
* dload_read_program() is.
*/
static akerr_ErrorContext *dsave_write_program(akbasic_Runtime *obj, FILE *fp, char *line, size_t len)
{
PREPARE_ERROR(errctx);
size_t written = 0;
int64_t i = 0;
int count = 0;
for ( i = 0; i < AKBASIC_MAX_SOURCE_LINES; i++ ) {
if ( obj->source[i].code[0] == '\0' ) {
continue;
}
/*
* aksl_snprintf's count is the length it wrote, and it treats
* truncation as an error rather than reporting a length it did not
* write -- so it is what goes to fwrite, and the strlen that used to
* recompute it is gone.
*/
PASS(errctx, aksl_snprintf(&count, line, len, "%" 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, (size_t)count, fp, &written));
}
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;
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 --
* libakstdlib's UPGRADING.md.
*/
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));
/*
* The read is one CATCH of one call, because the loop it used to be
* lives in dload_read_program() now: inside this block a loop can use
* neither CATCH nor PASS without either escaping the loop or returning
* past the fclose below.
*/
CATCH(errctx, dload_read_program(obj, fp, buffer, sizeof(buffer),
scanned, sizeof(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;
(void)lval; (void)rval;
PASS(errctx, filename_argument(obj, expr, filename, sizeof(filename)));
ATTEMPT {
CATCH(errctx, aksl_fopen(filename, "w", &fp));
CATCH(errctx, dsave_write_program(obj, fp, line, sizeof(line)));
} 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 };
int cmp = 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.
*/
PASS(errctx, aksl_strcmp(expr->right->identifier,
obj->environment->forNextVariable->name, &cmp));
if ( cmp != 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;
PASS(errctx, aksl_strcpy(literal.literal_string, sizeof(literal.literal_string),
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);
}