/** * @file environment.c * @brief Implements the scope and per-line working state. */ #include #include #include #include #include #include akerr_ErrorContext *akbasic_environment_init(akbasic_Environment *obj, akbasic_Runtime *runtime, akbasic_Environment *parent) { PREPARE_ERROR(errctx); FAIL_ZERO_RETURN(errctx, (obj != NULL), AKERR_NULLPOINTER, "NULL environment in init"); FAIL_ZERO_RETURN(errctx, (runtime != NULL), AKERR_NULLPOINTER, "NULL runtime in environment init"); PASS(errctx, akbasic_symtab_init(&obj->variables, AKBASIC_MAX_VARIABLES)); PASS(errctx, akbasic_symtab_init(&obj->functions, AKBASIC_MAX_FUNCTIONS)); PASS(errctx, akbasic_symtab_init(&obj->labels, AKBASIC_MAX_LABELS)); obj->parent = parent; obj->runtime = runtime; obj->forNextVariable = NULL; obj->forStepLeaf = NULL; obj->forToLeaf = NULL; obj->loopFirstLine = 0; obj->loopExitLine = 0; obj->gosubReturnLine = 0; obj->readReturnLine = 0; obj->readIdentifierIdx = 0; obj->waitingForCommand[0] = '\0'; obj->errorToken = NULL; memset(obj->readIdentifierLeaves, 0, sizeof(obj->readIdentifierLeaves)); obj->readLeafPool.next = 0; obj->readLeafPool.capacity = AKBASIC_MAX_LEAVES; obj->readLeafPool.leaves = obj->readLeafStorage; PASS(errctx, akbasic_value_zero(&obj->forStepValue)); PASS(errctx, akbasic_value_zero(&obj->forToValue)); PASS(errctx, akbasic_value_zero(&obj->returnValue)); if ( obj->parent != NULL ) { obj->lineno = obj->parent->lineno; obj->nextline = obj->parent->nextline; } else { obj->lineno = 0; obj->nextline = 0; } obj->nextvalue = 0; PASS(errctx, akbasic_environment_zero_parser(obj)); SUCCEED_RETURN(errctx); } akerr_ErrorContext *akbasic_environment_zero(akbasic_Environment *obj) { PREPARE_ERROR(errctx); int i = 0; FAIL_ZERO_RETURN(errctx, (obj != NULL), AKERR_NULLPOINTER, "NULL environment in zero"); for ( i = 0; i < AKBASIC_MAX_VALUES; i++ ) { PASS(errctx, akbasic_value_init(&obj->values[i])); } obj->nextvalue = 0; SUCCEED_RETURN(errctx); } akerr_ErrorContext *akbasic_environment_zero_parser(akbasic_Environment *obj) { PREPARE_ERROR(errctx); int i = 0; FAIL_ZERO_RETURN(errctx, (obj != NULL), AKERR_NULLPOINTER, "NULL environment in zero_parser"); for ( i = 0; i < AKBASIC_MAX_LEAVES; i++ ) { PASS(errctx, akbasic_leaf_init(&obj->leaves[i], AKBASIC_LEAF_UNDEFINED)); } for ( i = 0; i < AKBASIC_MAX_TOKENS; i++ ) { PASS(errctx, akbasic_token_init(&obj->tokens[i])); } obj->curtoken = 0; obj->nexttoken = 0; obj->nextleaf = 0; SUCCEED_RETURN(errctx); } akerr_ErrorContext *akbasic_environment_new_value(akbasic_Environment *obj, akbasic_Value **dest) { PREPARE_ERROR(errctx); FAIL_ZERO_RETURN(errctx, (obj != NULL && dest != NULL), AKERR_NULLPOINTER, "NULL argument in new_value"); FAIL_ZERO_RETURN(errctx, (obj->nextvalue < AKBASIC_MAX_VALUES), AKBASIC_ERR_BOUNDS, "Maximum values per line reached"); *dest = &obj->values[obj->nextvalue]; obj->nextvalue += 1; SUCCEED_RETURN(errctx); } akerr_ErrorContext *akbasic_environment_new_leaf(akbasic_Environment *obj, akbasic_ASTLeaf **dest) { PREPARE_ERROR(errctx); FAIL_ZERO_RETURN(errctx, (obj != NULL && dest != NULL), AKERR_NULLPOINTER, "NULL argument in new_leaf"); FAIL_ZERO_RETURN(errctx, (obj->nextleaf < AKBASIC_MAX_LEAVES), AKBASIC_ERR_BOUNDS, "No more leaves available"); *dest = &obj->leaves[obj->nextleaf]; obj->nextleaf += 1; SUCCEED_RETURN(errctx); } akerr_ErrorContext *akbasic_environment_wait_for_command(akbasic_Environment *obj, const char *command) { PREPARE_ERROR(errctx); FAIL_ZERO_RETURN(errctx, (obj != NULL && command != NULL), AKERR_NULLPOINTER, "NULL argument in wait_for_command"); /* * The reference panics here. An interpreter library may not take the process * with it, so this raises instead -- but it is still a hard failure, because * two pending waits in one environment means the block structure is already * corrupt. */ FAIL_NONZERO_RETURN(errctx, (obj->waitingForCommand[0] != '\0'), AKBASIC_ERR_STATE, "Can't wait on multiple commands in the same environment : %s", obj->waitingForCommand); FAIL_ZERO_RETURN(errctx, (strlen(command) < sizeof(obj->waitingForCommand)), AKBASIC_ERR_BOUNDS, "Command name '%s' is too long to wait on", command); strncpy(obj->waitingForCommand, command, sizeof(obj->waitingForCommand) - 1); obj->waitingForCommand[sizeof(obj->waitingForCommand) - 1] = '\0'; SUCCEED_RETURN(errctx); } bool akbasic_environment_is_waiting_for_any(akbasic_Environment *obj) { if ( obj == NULL ) { return false; } if ( obj->waitingForCommand[0] != '\0' ) { return true; } return akbasic_environment_is_waiting_for_any(obj->parent); } bool akbasic_environment_is_waiting_for(akbasic_Environment *obj, const char *command) { if ( obj == NULL || command == NULL ) { return false; } if ( strcmp(obj->waitingForCommand, command) == 0 ) { return true; } return akbasic_environment_is_waiting_for(obj->parent, command); } akerr_ErrorContext *akbasic_environment_stop_waiting(akbasic_Environment *obj, const char *command) { PREPARE_ERROR(errctx); FAIL_ZERO_RETURN(errctx, (obj != NULL && command != NULL), AKERR_NULLPOINTER, "NULL argument in stop_waiting"); /* * The reference ignores `command` and clears unconditionally, which lets an * inner block clear an outer block's wait (TODO.md section 12 item 3). The * argument is honoured here only to the extent of walking to the environment * that is actually waiting for it -- clearing the wrong one outright would * change observable control flow, so the search stops at the first match and * a miss is silently tolerated, exactly as today. */ while ( obj != NULL ) { if ( strcmp(obj->waitingForCommand, command) == 0 ) { obj->waitingForCommand[0] = '\0'; SUCCEED_RETURN(errctx); } obj = obj->parent; } SUCCEED_RETURN(errctx); } akerr_ErrorContext *akbasic_environment_get_function(akbasic_Environment *obj, const char *fname, void **dest) { PREPARE_ERROR(errctx); char upper[AKBASIC_SYMTAB_MAX_KEY]; size_t i = 0; size_t len = 0; FAIL_ZERO_RETURN(errctx, (obj != NULL && fname != NULL && dest != NULL), AKERR_NULLPOINTER, "NULL argument in get_function"); len = strlen(fname); FAIL_ZERO_RETURN(errctx, (len < sizeof(upper)), AKERR_KEY, "Function '%s' is not defined", fname); for ( i = 0; i < len; i++ ) { char c = fname[i]; upper[i] = (char)((c >= 'a' && c <= 'z') ? (c - 'a' + 'A') : c); } upper[len] = '\0'; while ( obj != NULL ) { akerr_ErrorContext *found = akbasic_symtab_get(&obj->functions, upper, dest, NULL); if ( found == NULL ) { SUCCEED_RETURN(errctx); } found->handled = true; IGNORE(akerr_release_error(found)); obj = obj->parent; } FAIL_RETURN(errctx, AKERR_KEY, "Function '%s' is not defined", fname); } akerr_ErrorContext *akbasic_environment_get_label(akbasic_Environment *obj, const char *label, int64_t *dest) { PREPARE_ERROR(errctx); FAIL_ZERO_RETURN(errctx, (obj != NULL && label != NULL && dest != NULL), AKERR_NULLPOINTER, "NULL argument in get_label"); while ( obj != NULL ) { akerr_ErrorContext *found = akbasic_symtab_get(&obj->labels, label, NULL, dest); if ( found == NULL ) { SUCCEED_RETURN(errctx); } found->handled = true; IGNORE(akerr_release_error(found)); obj = obj->parent; } FAIL_RETURN(errctx, AKBASIC_ERR_UNDEFINED, "Unable to find or create label %s in environment", label); } akerr_ErrorContext *akbasic_environment_set_label(akbasic_Environment *obj, const char *label, int64_t value) { PREPARE_ERROR(errctx); FAIL_ZERO_RETURN(errctx, (obj != NULL && label != NULL), AKERR_NULLPOINTER, "NULL argument in set_label"); /* Only the top-level environment creates labels. */ while ( obj != NULL && obj->runtime->environment != obj ) { obj = obj->parent; } FAIL_ZERO_RETURN(errctx, (obj != NULL), AKBASIC_ERR_ENVIRONMENT, "Unable to create label in orphaned environment"); PASS(errctx, akbasic_symtab_set(&obj->labels, label, NULL, value)); SUCCEED_RETURN(errctx); } akerr_ErrorContext *akbasic_environment_get(akbasic_Environment *obj, const char *varname, akbasic_Variable **dest) { PREPARE_ERROR(errctx); akbasic_Environment *walk = NULL; akbasic_Variable *variable = NULL; int64_t sizes[1] = { 1 }; void *slot = NULL; FAIL_ZERO_RETURN(errctx, (obj != NULL && varname != NULL && dest != NULL), AKERR_NULLPOINTER, "NULL argument in environment get"); *dest = NULL; for ( walk = obj; walk != NULL; walk = walk->parent ) { akerr_ErrorContext *found = akbasic_symtab_get(&walk->variables, varname, &slot, NULL); if ( found == NULL ) { *dest = (akbasic_Variable *)slot; SUCCEED_RETURN(errctx); } found->handled = true; IGNORE(akerr_release_error(found)); } /* * Parents do not create variables for their children: only the currently * active environment auto-creates. A miss anywhere else returns NULL without * error, which the caller is expected to notice. */ if ( obj->runtime->environment != obj ) { SUCCEED_RETURN(errctx); } PASS(errctx, akbasic_runtime_new_variable(obj->runtime, &variable)); FAIL_ZERO_RETURN(errctx, (strlen(varname) < sizeof(variable->name)), AKBASIC_ERR_BOUNDS, "Variable name '%s' is too long", varname); strncpy(variable->name, varname, sizeof(variable->name) - 1); variable->name[sizeof(variable->name) - 1] = '\0'; variable->valuetype = AKBASIC_TYPE_UNDEFINED; variable->mutable_ = true; PASS(errctx, akbasic_variable_init(variable, &obj->runtime->valuepool, sizes, 1)); PASS(errctx, akbasic_symtab_set(&obj->variables, varname, variable, 0)); *dest = variable; SUCCEED_RETURN(errctx); } /* * Evaluate an lvalue's subscript list, if it has one, into `subscripts`. A bare * identifier yields the single subscript {0}, which is how a scalar is addressed * -- every variable is really a one-element array. */ static akerr_ErrorContext *collect_subscripts(akbasic_Environment *obj, akbasic_ASTLeaf *lval, int64_t *subscripts, int *count) { PREPARE_ERROR(errctx); akbasic_ASTLeaf *expr = NULL; akbasic_Value *tval = NULL; *count = 0; if ( lval->right != NULL && lval->right->leaftype == AKBASIC_LEAF_ARGUMENTLIST && lval->right->operator_ == AKBASIC_TOK_ARRAY_SUBSCRIPT ) { for ( expr = lval->right->right; expr != NULL; expr = expr->right ) { FAIL_ZERO_RETURN(errctx, (*count < AKBASIC_MAX_ARRAY_DEPTH), AKBASIC_ERR_BOUNDS, "More than %d array subscripts", AKBASIC_MAX_ARRAY_DEPTH); PASS(errctx, akbasic_runtime_evaluate(obj->runtime, expr, &tval)); FAIL_NONZERO_RETURN(errctx, (tval->valuetype != AKBASIC_TYPE_INTEGER), AKBASIC_ERR_TYPE, "Array dimensions must evaluate to integer (B)"); subscripts[*count] = tval->intval; *count += 1; } } if ( *count == 0 ) { subscripts[0] = 0; *count = 1; } SUCCEED_RETURN(errctx); } akerr_ErrorContext *akbasic_environment_assign(akbasic_Environment *obj, akbasic_ASTLeaf *lval, akbasic_Value *rval, akbasic_Value **dest) { PREPARE_ERROR(errctx); akbasic_Variable *variable = NULL; int64_t subscripts[AKBASIC_MAX_ARRAY_DEPTH]; int subscriptcount = 0; akbasic_Value *slot = NULL; FAIL_ZERO_RETURN(errctx, (obj != NULL && lval != NULL && rval != NULL && dest != NULL), AKERR_NULLPOINTER, "nil pointer"); PASS(errctx, akbasic_environment_get(obj, lval->identifier, &variable)); FAIL_ZERO_RETURN(errctx, (variable != NULL), AKBASIC_ERR_UNDEFINED, "Identifier %s is undefined", lval->identifier); PASS(errctx, collect_subscripts(obj, lval, subscripts, &subscriptcount)); /* * Resolve the slot before the type switch. The reference notes that moving * this below the switch corrupts the subscript list; here it is simply the * clearer order, and the returned pointer is what an assignment expression * evaluates to. */ PASS(errctx, akbasic_variable_get_subscript(variable, subscripts, subscriptcount, &slot)); switch ( lval->leaftype ) { case AKBASIC_LEAF_IDENTIFIER_INT: if ( rval->valuetype == AKBASIC_TYPE_INTEGER ) { PASS(errctx, akbasic_variable_set_integer(variable, rval->intval, subscripts, subscriptcount)); } else if ( rval->valuetype == AKBASIC_TYPE_FLOAT ) { PASS(errctx, akbasic_variable_set_integer(variable, (int64_t)rval->floatval, subscripts, subscriptcount)); } else { FAIL_RETURN(errctx, AKBASIC_ERR_TYPE, "Incompatible types in variable assignment"); } break; case AKBASIC_LEAF_IDENTIFIER_FLOAT: if ( rval->valuetype == AKBASIC_TYPE_INTEGER ) { PASS(errctx, akbasic_variable_set_float(variable, (double)rval->intval, subscripts, subscriptcount)); } else if ( rval->valuetype == AKBASIC_TYPE_FLOAT ) { PASS(errctx, akbasic_variable_set_float(variable, rval->floatval, subscripts, subscriptcount)); } else { FAIL_RETURN(errctx, AKBASIC_ERR_TYPE, "Incompatible types in variable assignment"); } break; case AKBASIC_LEAF_IDENTIFIER_STRING: FAIL_NONZERO_RETURN(errctx, (rval->valuetype != AKBASIC_TYPE_STRING), AKBASIC_ERR_TYPE, "Incompatible types in variable assignment"); PASS(errctx, akbasic_variable_set_string(variable, rval->stringval, subscripts, subscriptcount)); break; default: FAIL_RETURN(errctx, AKBASIC_ERR_TYPE, "Invalid assignment"); } variable->valuetype = rval->valuetype; *dest = slot; SUCCEED_RETURN(errctx); }