/** * @file host.c * @brief Implements host structure binding and the conversions it needs. * * A host type joins the same table a `TYPE` declaration fills, so everything the * language already does with a structure works across the boundary with no * second set of rules. What differs is only where a field's bytes are. * * **The sharing is done with shadow slots.** A binding takes a run of value * slots from the same pool a `DIM`med record uses; a field read refreshes its * slot from host memory first, and a field write converts back and stores. So a * script always sees current values and its writes always land, and the rest of * the interpreter goes on seeing one storage model instead of two. * * **Every conversion refuses rather than truncates.** Writing 70000 into an * `int16_t` is an error naming the field, because a silent wrap is the failure * mode that gets found three frames later in somebody else's code. */ #include #include #include #include #include #include #include #include /** * @brief The BASIC type a host field presents as. * * Every integer width is an integer here, because BASIC has one integer type and * a 64-bit one at that. The width still matters -- it is what a write is range * checked against -- but it does not change what the script sees. */ static akbasic_Type basic_type_of(akbasic_HostFieldKind kind) { switch ( kind ) { case AKBASIC_HOSTFIELD_FLOAT: case AKBASIC_HOSTFIELD_DOUBLE: return AKBASIC_TYPE_FLOAT; case AKBASIC_HOSTFIELD_CSTRING: return AKBASIC_TYPE_STRING; case AKBASIC_HOSTFIELD_STRUCT: return AKBASIC_TYPE_STRUCT; default: return AKBASIC_TYPE_INTEGER; } } /** @brief The type suffix a field name must carry for the C type it describes. */ static char suffix_for(akbasic_HostFieldKind kind) { switch ( basic_type_of(kind) ) { case AKBASIC_TYPE_FLOAT: return '%'; case AKBASIC_TYPE_STRING: return '$'; case AKBASIC_TYPE_STRUCT: return '@'; default: return '#'; } } akerr_ErrorContext *akbasic_host_read_field(akbasic_Runtime *obj, akbasic_StructField *field, void *hostbase, akbasic_Value *dest) { PREPARE_ERROR(errctx); const char *at = (const char *)hostbase + field->hostoffset; char text[AKBASIC_MAX_STRING_LENGTH]; (void)obj; FAIL_ZERO_RETURN(errctx, (hostbase != NULL && dest != NULL), AKERR_NULLPOINTER, "NULL argument in host read"); PASS(errctx, akbasic_value_zero(dest)); switch ( field->hostkind ) { case AKBASIC_HOSTFIELD_INT8: dest->intval = *(const int8_t *)at; break; case AKBASIC_HOSTFIELD_INT16: dest->intval = *(const int16_t *)at; break; case AKBASIC_HOSTFIELD_INT32: dest->intval = *(const int32_t *)at; break; case AKBASIC_HOSTFIELD_INT64: dest->intval = *(const int64_t *)at; break; case AKBASIC_HOSTFIELD_UINT8: dest->intval = *(const uint8_t *)at; break; case AKBASIC_HOSTFIELD_UINT16: dest->intval = *(const uint16_t *)at; break; case AKBASIC_HOSTFIELD_UINT32: dest->intval = *(const uint32_t *)at; break; case AKBASIC_HOSTFIELD_BOOL: /* -1 and 0, the Commodore convention every condition here already uses. */ dest->intval = (*(const bool *)at ? AKBASIC_TRUE : AKBASIC_FALSE); break; case AKBASIC_HOSTFIELD_FLOAT: dest->floatval = (double)*(const float *)at; break; case AKBASIC_HOSTFIELD_DOUBLE: dest->floatval = *(const double *)at; break; case AKBASIC_HOSTFIELD_CSTRING: /* * Copied out rather than pointed at, and NUL-terminated even if the host * left it full: a BASIC string is inline and fixed, so there is nothing * to alias and nothing that can outlive the read. */ snprintf(text, sizeof(text), "%.*s", (int)field->hostwidth, at); snprintf(dest->stringval, sizeof(dest->stringval), "%s", text); break; default: FAIL_RETURN(errctx, AKBASIC_ERR_TYPE, "Host field %s cannot be read as a value", field->name); } dest->valuetype = basic_type_of(field->hostkind); SUCCEED_RETURN(errctx); } /** * @brief Convert a value back into the host's own representation, or refuse. * * The range checks are the reason this is not a memcpy. A host `int16_t` holds * -32768..32767 and a script that assigns 70000 has made a mistake -- wrapping * it silently would hand the game a number it never asked for and no way to * find out where it came from. */ akerr_ErrorContext *akbasic_host_write_field(akbasic_Runtime *obj, akbasic_StructField *field, void *hostbase, akbasic_Value *src) { PREPARE_ERROR(errctx); char *at = (char *)hostbase + field->hostoffset; int64_t n = 0; double d = 0.0; (void)obj; FAIL_ZERO_RETURN(errctx, (hostbase != NULL && src != NULL), AKERR_NULLPOINTER, "NULL argument in host write"); if ( basic_type_of(field->hostkind) == AKBASIC_TYPE_INTEGER ) { n = (src->valuetype == AKBASIC_TYPE_FLOAT ? (int64_t)src->floatval : src->intval); } else if ( basic_type_of(field->hostkind) == AKBASIC_TYPE_FLOAT ) { d = (src->valuetype == AKBASIC_TYPE_INTEGER ? (double)src->intval : src->floatval); } #define AKBASIC_HOST_RANGE(__lo, __hi) \ FAIL_ZERO_RETURN(errctx, (n >= (int64_t)(__lo) && n <= (int64_t)(__hi)), \ AKBASIC_ERR_VALUE, \ "%" PRId64 " does not fit in %s, which holds %" PRId64 \ " to %" PRId64, n, field->name, (int64_t)(__lo), (int64_t)(__hi)) switch ( field->hostkind ) { case AKBASIC_HOSTFIELD_INT8: AKBASIC_HOST_RANGE(INT8_MIN, INT8_MAX); *(int8_t *)at = (int8_t)n; break; case AKBASIC_HOSTFIELD_INT16: AKBASIC_HOST_RANGE(INT16_MIN, INT16_MAX); *(int16_t *)at = (int16_t)n; break; case AKBASIC_HOSTFIELD_INT32: AKBASIC_HOST_RANGE(INT32_MIN, INT32_MAX); *(int32_t *)at = (int32_t)n; break; case AKBASIC_HOSTFIELD_INT64: *(int64_t *)at = n; break; case AKBASIC_HOSTFIELD_UINT8: AKBASIC_HOST_RANGE(0, UINT8_MAX); *(uint8_t *)at = (uint8_t)n; break; case AKBASIC_HOSTFIELD_UINT16: AKBASIC_HOST_RANGE(0, UINT16_MAX); *(uint16_t *)at = (uint16_t)n; break; case AKBASIC_HOSTFIELD_UINT32: AKBASIC_HOST_RANGE(0, UINT32_MAX); *(uint32_t *)at = (uint32_t)n; break; case AKBASIC_HOSTFIELD_BOOL: /* Any nonzero is true, which is what AKBASIC_TRUE being -1 requires. */ *(bool *)at = (n != 0); break; case AKBASIC_HOSTFIELD_FLOAT: *(float *)at = (float)d; break; case AKBASIC_HOSTFIELD_DOUBLE: *(double *)at = d; break; case AKBASIC_HOSTFIELD_CSTRING: FAIL_ZERO_RETURN(errctx, (src->valuetype == AKBASIC_TYPE_STRING), AKBASIC_ERR_TYPE, "%s is a string field", field->name); /* * Refused rather than truncated, and the width is the host's: a * `char[32]` holds 31 characters and a script assigning 40 has lost * eight of them. BASIC strings have no width, so this is the one place * the two models genuinely disagree and the disagreement is reported. */ FAIL_ZERO_RETURN(errctx, (strlen(src->stringval) < field->hostwidth), AKBASIC_ERR_VALUE, "A string of %zu characters does not fit in %s, which holds %zu", strlen(src->stringval), field->name, field->hostwidth - 1); memset(at, 0, field->hostwidth); memcpy(at, src->stringval, strlen(src->stringval)); break; default: FAIL_RETURN(errctx, AKBASIC_ERR_TYPE, "Host field %s cannot be written from a value", field->name); } #undef AKBASIC_HOST_RANGE SUCCEED_RETURN(errctx); } akerr_ErrorContext *akbasic_host_refresh(akbasic_Runtime *obj, int typeindex, void *hostbase, akbasic_Value *slots) { PREPARE_ERROR(errctx); akbasic_StructType *type = NULL; int i = 0; FAIL_ZERO_RETURN(errctx, (obj != NULL && hostbase != NULL && slots != NULL), AKERR_NULLPOINTER, "NULL argument in host refresh"); type = &obj->structtypes.types[typeindex]; for ( i = 0; i < type->fieldcount; i++ ) { akbasic_StructField *field = &type->fields[i]; if ( field->kind == AKBASIC_FIELD_STRUCT ) { PASS(errctx, akbasic_host_refresh(obj, field->typeindex, (char *)hostbase + field->hostoffset, slots + field->offset)); continue; } PASS(errctx, akbasic_host_read_field(obj, field, hostbase, slots + field->offset)); } SUCCEED_RETURN(errctx); } /* ------------------------------------------------------------ the API --- */ akerr_ErrorContext *akbasic_host_register_type(akbasic_Runtime *obj, const akbasic_HostType *type) { PREPARE_ERROR(errctx); akbasic_StructType *dest = NULL; int existing = -1; int offset = 0; int i = 0; FAIL_ZERO_RETURN(errctx, (obj != NULL && type != NULL && type->name != NULL), AKERR_NULLPOINTER, "NULL argument in host register_type"); PASS(errctx, akbasic_structtype_find(&obj->structtypes, type->name, &existing)); FAIL_NONZERO_RETURN(errctx, (existing >= 0), AKBASIC_ERR_VALUE, "TYPE %s is already registered", type->name); FAIL_ZERO_RETURN(errctx, (obj->structtypes.count < AKBASIC_MAX_STRUCT_TYPES), AKBASIC_ERR_BOUNDS, "More than %d types", AKBASIC_MAX_STRUCT_TYPES); FAIL_ZERO_RETURN(errctx, (type->fieldcount > 0 && type->fieldcount <= AKBASIC_MAX_STRUCT_FIELDS), AKBASIC_ERR_BOUNDS, "%s declares %d fields, which is outside 1..%d", type->name, type->fieldcount, AKBASIC_MAX_STRUCT_FIELDS); dest = &obj->structtypes.types[obj->structtypes.count]; memset(dest, 0, sizeof(*dest)); snprintf(dest->name, sizeof(dest->name), "%s", type->name); dest->used = true; dest->ishost = true; dest->hostsize = type->size; dest->firstline = -1; dest->lastline = -1; for ( i = 0; i < type->fieldcount; i++ ) { const akbasic_HostField *src = &type->fields[i]; akbasic_StructField *field = &dest->fields[i]; size_t len = 0; FAIL_ZERO_RETURN(errctx, (src->name != NULL), AKERR_NULLPOINTER, "%s field %d has no name", type->name, i); len = strlen(src->name); /* * The suffix has to agree with the C type. A host that writes "HP%" over * an int32_t has said two different things about one field, and the * script would believe the suffix -- so the disagreement is refused here * rather than discovered as a wrong answer later. */ FAIL_ZERO_RETURN(errctx, (len >= 2 && src->name[len - 1] == suffix_for(src->kind)), AKBASIC_ERR_VALUE, "%s.%s must end in '%c' for the C type it describes", type->name, src->name, suffix_for(src->kind)); snprintf(field->name, sizeof(field->name), "%s", src->name); field->hostkind = src->kind; field->hostoffset = src->offset; field->hostwidth = src->width; field->valuetype = basic_type_of(src->kind); field->typeindex = -1; field->offset = offset; if ( src->kind == AKBASIC_HOSTFIELD_STRUCT ) { int nested = -1; FAIL_ZERO_RETURN(errctx, (src->typename_ != NULL), AKERR_NULLPOINTER, "%s.%s is a nested structure and must name its type", type->name, src->name); PASS(errctx, akbasic_structtype_find(&obj->structtypes, src->typename_, &nested)); FAIL_ZERO_RETURN(errctx, (nested >= 0), AKBASIC_ERR_UNDEFINED, "%s.%s names type %s, which is not registered", type->name, src->name, src->typename_); field->kind = AKBASIC_FIELD_STRUCT; field->typeindex = nested; field->slotcount = obj->structtypes.types[nested].slotcount; } else { field->kind = AKBASIC_FIELD_PRIMITIVE; field->slotcount = 1; } offset += field->slotcount; } dest->fieldcount = type->fieldcount; dest->slotcount = offset; obj->structtypes.count += 1; SUCCEED_RETURN(errctx); } akerr_ErrorContext *akbasic_host_bind(akbasic_Runtime *obj, const char *name, const char *typename_, void *instance) { PREPARE_ERROR(errctx); akbasic_Variable *variable = NULL; int64_t sizes[1] = { 1 }; size_t len = 0; int typeindex = -1; FAIL_ZERO_RETURN(errctx, (obj != NULL && name != NULL && typename_ != NULL && instance != NULL), AKERR_NULLPOINTER, "NULL argument in host bind"); len = strlen(name); FAIL_ZERO_RETURN(errctx, (len >= 2 && name[len - 1] == '@'), AKBASIC_ERR_VALUE, "A structure variable's name ends in '@', so \"%s\" cannot be bound", name); PASS(errctx, akbasic_structtype_find(&obj->structtypes, typename_, &typeindex)); FAIL_ZERO_RETURN(errctx, (typeindex >= 0), AKBASIC_ERR_UNDEFINED, "TYPE %s is not registered", typename_); FAIL_ZERO_RETURN(errctx, (obj->structtypes.types[typeindex].ishost), AKBASIC_ERR_TYPE, "TYPE %s was declared by the script, not registered by the host", typename_); /* * The outermost scope, for the reason akbasic_runtime_global() exists: a * binding made while a script is suspended would otherwise land in whatever * FOR or GOSUB body is active and die with it. */ PASS(errctx, akbasic_runtime_global(obj, name, &variable)); if ( variable->structtype < 0 ) { sizes[0] = 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 = false; } FAIL_ZERO_RETURN(errctx, (variable->structtype == typeindex), AKBASIC_ERR_TYPE, "%s is already bound to a different type", name); variable->hostbase = instance; PASS(errctx, akbasic_host_refresh(obj, typeindex, instance, variable->values)); SUCCEED_RETURN(errctx); } akerr_ErrorContext *akbasic_host_rebind(akbasic_Runtime *obj, const char *name, void *instance) { PREPARE_ERROR(errctx); akbasic_Variable *variable = NULL; FAIL_ZERO_RETURN(errctx, (obj != NULL && name != NULL && instance != NULL), AKERR_NULLPOINTER, "NULL argument in host rebind"); PASS(errctx, akbasic_runtime_global(obj, name, &variable)); FAIL_ZERO_RETURN(errctx, (variable->structtype >= 0 && variable->hostbase != NULL), AKBASIC_ERR_UNDEFINED, "%s is not bound to a host structure", name); variable->hostbase = instance; PASS(errctx, akbasic_host_refresh(obj, variable->structtype, instance, variable->values)); SUCCEED_RETURN(errctx); } akerr_ErrorContext *akbasic_host_unbind(akbasic_Runtime *obj, const char *name) { PREPARE_ERROR(errctx); akbasic_Variable *variable = NULL; FAIL_ZERO_RETURN(errctx, (obj != NULL && name != NULL), AKERR_NULLPOINTER, "NULL argument in host unbind"); PASS(errctx, akbasic_runtime_global(obj, name, &variable)); FAIL_ZERO_RETURN(errctx, (variable->structtype >= 0 && variable->hostbase != NULL), AKBASIC_ERR_UNDEFINED, "%s is not bound to a host structure", name); /* * The shadow slots keep whatever they last held, but the binding is gone -- * so a later read is refused by name rather than following a pointer into * storage the host may already have freed. That refusal is the whole reason * this entry point exists. */ variable->hostbase = NULL; variable->structtype = -1; SUCCEED_RETURN(errctx); }