From 631c70ce7d6f3b1b4c2d7bfe0b963adcffe9bb76 Mon Sep 17 00:00:00 2001 From: Andrew Kesterson Date: Sat, 1 Aug 2026 11:56:04 -0400 Subject: [PATCH] Share a host program's own C structures with a script A BASIC TYPE and a host C struct are the same thing seen from two sides, so both go in one type table and everything the language already does with a structure works across the boundary with no second set of rules. The host describes its struct once as a table of field descriptors and binds an instance: akbasic_host_bind(&SCRIPT, "FOE@", "ENEMY", &GOBLIN); after which `FOE@.HP# = FOE@.HP# - 10` decrements GOBLIN.hp in place, with no marshalling step the host has to remember to run. The sharing is done with shadow slots: a binding takes a run from the same value pool a DIMmed record uses, a field read refreshes its slot from host memory first, and a write converts back and stores. So the script always sees current values and its writes always land, while the rest of the interpreter goes on seeing one storage model instead of two. AKBASIC_HOST_FIELD takes the offset and the width from the same member, which is the only reason it is a macro: writing offsetof and sizeof out by hand is two chances to name the wrong member and no way to notice. A field name's suffix must agree with the C type it describes, refused at registration -- a host writing "HP%" over an int32_t has said two different things about one field and the script would believe the suffix. Conversion refuses rather than truncates. 200 into an int8_t, 70000 into an int16_t, -1 into a uint8_t and thirteen characters into a char[8] are each an error naming the field, because a silent wrap is found three frames later in code that did nothing wrong. Each width is tested separately, since a range check is exactly the thing that is right for int32_t and wrong for int8_t when only one of them is covered. The language's own distinction turns out to be the one a host needs, so there is one API rather than two: assignment copies and gives a script a private snapshot, POINT shares and lets it change the game, and which one happened is visible in the listing. Two things the work required. The prescan runs again on every RUN and used to wipe the whole type table, unregistering the host's types the first time a script ran; it now keeps what the host registered and drops only what the script declared. And akbasic_runtime_start() did not rewind, which cost nothing while a host started a script once and cost everything to a host running one per enemy -- the second start began past the end and silently did nothing. Co-Authored-By: Claude Opus 5 (1M context) --- CMakeLists.txt | 4 +- examples/hoststruct.c | 138 +++++++++++++ include/akbasic/host.h | 175 +++++++++++++++++ include/akbasic/structtype.h | 30 ++- include/akbasic/types.h | 7 + include/akbasic/variable.h | 1 + src/environment.c | 13 +- src/host.c | 363 +++++++++++++++++++++++++++++++++++ src/runtime.c | 27 +++ src/runtime_struct.c | 29 ++- src/structtype.c | 21 +- src/value.c | 2 + tests/hoststruct.c | 265 +++++++++++++++++++++++++ 13 files changed, 1068 insertions(+), 7 deletions(-) create mode 100644 examples/hoststruct.c create mode 100644 include/akbasic/host.h create mode 100644 src/host.c create mode 100644 tests/hoststruct.c diff --git a/CMakeLists.txt b/CMakeLists.txt index adc2ae5..46f7f95 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -145,6 +145,7 @@ set(AKBASIC_SOURCES src/sink_stdio.c src/sink_tee.c src/sprite_tables.c + src/host.c src/structtype.c src/symtab.c src/value.c @@ -239,7 +240,7 @@ akbasic_instrument(basic) # The embedding example. It is built by default and registered as a test so the # code README.md quotes cannot rot: a signature change breaks the build. if(AKBASIC_BUILD_EXAMPLES) - foreach(_example IN ITEMS embed hostvars) + foreach(_example IN ITEMS embed hostvars hoststruct) add_executable(akbasic_example_${_example} examples/${_example}.c) target_compile_options(akbasic_example_${_example} PRIVATE -Wall -Wextra) target_link_libraries(akbasic_example_${_example} PRIVATE akbasic) @@ -277,6 +278,7 @@ set(AKBASIC_TESTS format_verbs grammar_leaves graphics_verbs + hoststruct hostvars housekeeping_verbs input_verbs diff --git a/examples/hoststruct.c b/examples/hoststruct.c new file mode 100644 index 0000000..2b1fbb6 --- /dev/null +++ b/examples/hoststruct.c @@ -0,0 +1,138 @@ +/** + * @file hoststruct.c + * @brief Sharing a game's own C structures with a script. + * + * This is the code in docs/15-structures.md's "Sharing a structure with a host" + * section, kept here so it is compiled and run by every build rather than + * rotting in a document. + * + * **The thing worth noticing is that there is no marshalling step.** The host + * describes its struct once and binds an instance; the script then reads and + * writes the game's real memory. `FOE@.HP# = FOE@.HP# - 10` decrements + * `GOBLIN.hp` in place. + * + * The second thing worth noticing is that the language's own distinction -- + * assignment copies, `POINT` shares -- turns out to be exactly the distinction + * a host needs, so there is only one API and which one a script used is visible + * in the listing. + */ + +#include +#include +#include +#include +#include + +#include + +#include +#include +#include +#include + +/* ------------------------------------------------------------ the game --- */ + +/** @brief The game's own struct. Nothing about it is akbasic's business. */ +typedef struct +{ + char name[32]; + int32_t hp; + float x; + float y; + bool hostile; +} game_Enemy; + +static game_Enemy GOBLIN = { "GOBLIN", 30, 10.0f, 20.0f, true }; +static game_Enemy TROLL = { "TROLL", 80, 50.0f, 60.0f, true }; + +/* + * The description akbasic needs: one row per field, with the BASIC name and its + * suffix, the C representation, and where it sits. AKBASIC_HOST_FIELD takes the + * offset and the width from the member itself, so the two cannot drift apart -- + * writing them out by hand is two chances to name the wrong member and no way to + * notice. + */ +static const akbasic_HostField ENEMY_FIELDS[] = { + /* struct member BASIC name C representation */ + AKBASIC_HOST_FIELD( game_Enemy, name, "NAME$", AKBASIC_HOSTFIELD_CSTRING ), + AKBASIC_HOST_FIELD( game_Enemy, hp, "HP#", AKBASIC_HOSTFIELD_INT32 ), + AKBASIC_HOST_FIELD( game_Enemy, x, "X%", AKBASIC_HOSTFIELD_FLOAT ), + AKBASIC_HOST_FIELD( game_Enemy, y, "Y%", AKBASIC_HOSTFIELD_FLOAT ), + AKBASIC_HOST_FIELD( game_Enemy, hostile, "HOSTILE#", AKBASIC_HOSTFIELD_BOOL ) +}; + +static const akbasic_HostType ENEMY_TYPE = { + "ENEMY", sizeof(game_Enemy), ENEMY_FIELDS, 5 +}; + +/* ------------------------------------------------------ the interpreter --- */ + +static akbasic_Runtime SCRIPT; +static akbasic_TextSink SINK; +static akbasic_StdioSink SINKSTATE; + +/* + * A script written against one name. The host points that name at each enemy in + * turn, which is what akbasic_host_rebind() is for -- one script, one binding, + * however many enemies. + */ +static const char *PROGRAM = + "10 PRINT FOE@.NAME$ + \" HAS \" + FOE@.HP#\n" + "20 FOE@.HP# = FOE@.HP# - 10\n" + "30 PRINT \" AFTER THE HIT: \" + FOE@.HP#\n"; + +static akerr_ErrorContext AKERR_NOIGNORE *run_against(game_Enemy *enemy) +{ + PREPARE_ERROR(errctx); + + PASS(errctx, akbasic_host_rebind(&SCRIPT, "FOE@", enemy)); + PASS(errctx, akbasic_runtime_start(&SCRIPT, AKBASIC_MODE_RUN)); + PASS(errctx, akbasic_runtime_run(&SCRIPT, 0)); + SUCCEED_RETURN(errctx); +} + +int main(void) +{ + PREPARE_ERROR(errctx); + int rc = 0; + + ATTEMPT { + CATCH(errctx, akbasic_error_register()); + CATCH(errctx, akbasic_sink_init_stdio(&SINK, &SINKSTATE, stdout, NULL)); + CATCH(errctx, akbasic_runtime_init(&SCRIPT, &SINK)); + + /* + * Register the type, then bind an instance. The descriptor is borrowed + * rather than copied, which is why it is `static const` -- it has to + * outlive the runtime. + */ + CATCH(errctx, akbasic_host_register_type(&SCRIPT, &ENEMY_TYPE)); + CATCH(errctx, akbasic_host_bind(&SCRIPT, "FOE@", "ENEMY", &GOBLIN)); + CATCH(errctx, akbasic_runtime_load(&SCRIPT, PROGRAM)); + + CATCH(errctx, run_against(&GOBLIN)); + CATCH(errctx, run_against(&TROLL)); + + /* + * And the game's own structs have changed. No marshalling step, no copy + * to write back -- the script was reading and writing these all along. + */ + printf("host sees GOBLIN.hp = %d\n", GOBLIN.hp); + printf("host sees TROLL.hp = %d\n", TROLL.hp); + + /* + * Unbind before the storage would go away. A binding is the only pointer + * this interpreter holds that it did not allocate, so this is the one + * lifetime a host has to think about -- and after it, a script reading + * the name is refused by name rather than reading freed memory. + */ + CATCH(errctx, akbasic_host_unbind(&SCRIPT, "FOE@")); + } CLEANUP { + } PROCESS(errctx) { + } HANDLE_DEFAULT(errctx) { + LOG_ERROR_WITH_MESSAGE(errctx, "host structure example failed"); + rc = 1; + } FINISH_NORETURN(errctx); + + return rc; +} diff --git a/include/akbasic/host.h b/include/akbasic/host.h new file mode 100644 index 0000000..c2d8273 --- /dev/null +++ b/include/akbasic/host.h @@ -0,0 +1,175 @@ +/** + * @file host.h + * @brief Sharing a host program's own C structures with a script. + * + * A BASIC `TYPE` and a host C struct are the same thing seen from two sides, so + * both live in one type table and everything the language already does -- + * copy on assign, `PTR TO`, `.` and `->` -- works across the boundary with no + * second set of rules. + * + * The host describes its struct once as a table of field descriptors and binds + * an instance to a name. A script then reads and writes the game's real memory: + * + * ``` + * FOE@.HP# = FOE@.HP# - 10 + * ``` + * + * decrements the host's `hp` in place, with no marshalling step the host has to + * remember to run. + * + * **How the sharing works.** A binding takes a shadow run of value slots from + * the same pool a `DIM`med record uses, and every field read refreshes its slot + * from host memory while every write converts back and stores. So the script + * always sees current values and its writes always land, without the + * interpreter having to hold two storage models for one language. + * + * **Conversion refuses rather than truncates.** Writing 70000 into an `int16_t` + * field or 40 characters into a `char[32]` is an error naming the field, not a + * silent wrap. Two conversions are lossy and say so in the documentation: a host + * `float` round-trips through BASIC's doubles, and a `CSTRING` has a width BASIC + * strings do not. + * + * **This is the one place akbasic holds a pointer it did not allocate.** + * Everything else is pool-bounded and diagnosable. See akbasic_host_bind(). + */ + +#ifndef _AKBASIC_HOST_H_ +#define _AKBASIC_HOST_H_ + +#include + +#include + +#include + +struct akbasic_Runtime; + +/** @brief How a host field is represented in C, which is what says how to convert it. */ +typedef enum +{ + AKBASIC_HOSTFIELD_INT8 = 0, + AKBASIC_HOSTFIELD_INT16, + AKBASIC_HOSTFIELD_INT32, + AKBASIC_HOSTFIELD_INT64, + AKBASIC_HOSTFIELD_UINT8, + AKBASIC_HOSTFIELD_UINT16, + AKBASIC_HOSTFIELD_UINT32, + AKBASIC_HOSTFIELD_BOOL, + AKBASIC_HOSTFIELD_FLOAT, /* C float; BASIC floats are double */ + AKBASIC_HOSTFIELD_DOUBLE, + AKBASIC_HOSTFIELD_CSTRING, /* fixed char[]; `width` is its size */ + AKBASIC_HOSTFIELD_STRUCT /* nested host struct; `typename_` names it */ +} akbasic_HostFieldKind; + +/** @brief One field of a host structure, in BASIC terms and in C terms. */ +typedef struct +{ + const char *name; /** BASIC field name, suffix included */ + akbasic_HostFieldKind kind; + size_t offset; /** offsetof() within the host struct */ + size_t width; /** sizeof() the member; CSTRING needs it */ + const char *typename_; /** for STRUCT, the registered type name */ +} akbasic_HostField; + +/** @brief A host structure type: a name, a size, and its fields. */ +typedef struct +{ + const char *name; /** BASIC type name, no suffix */ + size_t size; /** sizeof() the host struct */ + const akbasic_HostField *fields; + int fieldcount; +} akbasic_HostType; + +/** + * @brief Build a field descriptor from the member itself. + * + * Takes the offset and the width from the same member, so the two cannot drift + * apart -- writing them out by hand is two chances to name the wrong member and + * no way to notice. That is the only reason this is a macro. + */ +#define AKBASIC_HOST_FIELD(__struct, __member, __name, __kind) \ + { (__name), (__kind), offsetof(__struct, __member), \ + sizeof(((__struct *)0)->__member), NULL } + +/** @brief The same, for a field that is itself a registered host structure. */ +#define AKBASIC_HOST_FIELD_STRUCT(__struct, __member, __name, __type) \ + { (__name), AKBASIC_HOSTFIELD_STRUCT, offsetof(__struct, __member), \ + sizeof(((__struct *)0)->__member), (__type) } + +/** + * @brief Register a host structure type under its BASIC name. + * + * The descriptor is **borrowed, not copied**: it must outlive the runtime, which + * is why every example makes it `static const`. + * + * Registering before the script is loaded is the normal case. A host type and a + * `TYPE` the script declares share one namespace, so a script cannot declare a + * type the host already registered -- and would be refused if it tried. + * + * @param obj Object to initialize, inspect, or modify. + * @param type The host's description of its own struct. + * @return `NULL` on success, otherwise an error context owned by the caller. + * @throws AKERR_NULLPOINTER When either argument is NULL. + * @throws AKBASIC_ERR_VALUE When a field name carries no type suffix, a nested + * type is not registered, or the name is already taken. + * @throws AKBASIC_ERR_BOUNDS When the type table or a field list is full. + */ +akerr_ErrorContext AKERR_NOIGNORE *akbasic_host_register_type(struct akbasic_Runtime *obj, const akbasic_HostType *type); + +/** + * @brief Bind one instance of a registered host type to a script variable. + * + * Creates the variable in the script's *outermost* scope, for the reason + * akbasic_runtime_global() exists: a binding made during a suspended run would + * otherwise land in whatever `FOR` or `GOSUB` body happens to be active and die + * with it. + * + * **`instance` is borrowed and never copied.** It must outlive the binding. A + * struct on a stack frame that returns, or one the host frees, leaves the script + * reading freed memory -- and this is the only way to get a wild pointer into an + * interpreter that otherwise cannot produce one. Bind globals or arena objects, + * and call akbasic_host_unbind() before the storage goes. + * + * @param obj Object to initialize, inspect, or modify. + * @param name Script variable name, `@`-suffixed. + * @param typename_ A type registered by akbasic_host_register_type(). + * @param instance The host's struct. Borrowed; must outlive the binding. + * @return `NULL` on success, otherwise an error context owned by the caller. + * @throws AKERR_NULLPOINTER When any argument is NULL. + * @throws AKBASIC_ERR_UNDEFINED When `typename_` is not registered. + * @throws AKBASIC_ERR_VALUE When `name` does not end in `@`. + */ +akerr_ErrorContext AKERR_NOIGNORE *akbasic_host_bind(struct akbasic_Runtime *obj, const char *name, const char *typename_, void *instance); + +/** + * @brief Point an existing binding at a different instance of the same type. + * + * The per-frame call. A host iterating its enemies rebinds one name rather than + * creating eight, which keeps the binding flat and lets one script be written + * against `FOE@` and run once per enemy. + * + * @param obj Object to initialize, inspect, or modify. + * @param name A name already bound by akbasic_host_bind(). + * @param instance The host's struct. Borrowed; must outlive the binding. + * @return `NULL` on success, otherwise an error context owned by the caller. + * @throws AKERR_NULLPOINTER When any argument is NULL. + * @throws AKBASIC_ERR_UNDEFINED When `name` is not bound. + */ +akerr_ErrorContext AKERR_NOIGNORE *akbasic_host_rebind(struct akbasic_Runtime *obj, const char *name, void *instance); + +/** + * @brief Break a binding, leaving the name pointing at nothing. + * + * Call it before the instance's storage goes away. After this a script reading + * that name is refused by name rather than reading freed memory, which is the + * difference between a diagnosable script error and undefined behaviour. + * + * @param obj Object to initialize, inspect, or modify. + * @param name A name already bound by akbasic_host_bind(). + * @return `NULL` on success, otherwise an error context owned by the caller. + * @throws AKERR_NULLPOINTER When either argument is NULL. + * @throws AKBASIC_ERR_UNDEFINED When `name` is not bound. + */ +akerr_ErrorContext AKERR_NOIGNORE *akbasic_host_unbind(struct akbasic_Runtime *obj, const char *name); + +#endif // _AKBASIC_HOST_H_ diff --git a/include/akbasic/structtype.h b/include/akbasic/structtype.h index f2f7ece..b67fb71 100644 --- a/include/akbasic/structtype.h +++ b/include/akbasic/structtype.h @@ -26,6 +26,7 @@ #include #include +#include #include struct akbasic_Runtime; @@ -47,6 +48,14 @@ typedef struct int typeindex; /** for STRUCT and POINTER */ int offset; /** slots from the start of the instance */ int slotcount; /** slots this field occupies */ + /* + * Where this field's bytes live in the *host's* struct, when the type came + * from akbasic_host_register_type(). Unused for a type the script declared, + * whose fields are value slots and have no other representation. + */ + akbasic_HostFieldKind hostkind; + size_t hostoffset; + size_t hostwidth; } akbasic_StructField; /** @@ -66,6 +75,14 @@ typedef struct int64_t firstline; int64_t lastline; bool used; + /* + * True when the host described this type rather than the script declaring + * it. The difference is only in where a field's bytes are; everything the + * language does with a structure is the same either way, which is the point + * of putting both in one table. + */ + bool ishost; + size_t hostsize; } akbasic_StructType; /** @brief Every `TYPE` a program declared. Lives on the runtime. */ @@ -169,7 +186,7 @@ akerr_ErrorContext AKERR_NOIGNORE *akbasic_struct_copy(struct akbasic_Runtime *o * Enforces the strict-pointer rule on the way: `.` requires a structure on its * left and `->` requires a pointer, and neither stands in for the other. */ -akerr_ErrorContext AKERR_NOIGNORE *akbasic_struct_resolve(struct akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_StructField **fielddest, akbasic_Value **slotdest); +akerr_ErrorContext AKERR_NOIGNORE *akbasic_struct_resolve(struct akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_StructField **fielddest, akbasic_Value **slotdest, void **hostdest); /** @brief Evaluate a field access to the value it yields. */ akerr_ErrorContext AKERR_NOIGNORE *akbasic_struct_evaluate_field(struct akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value **dest); @@ -186,4 +203,15 @@ akerr_ErrorContext AKERR_NOIGNORE *akbasic_struct_init_slots(struct akbasic_Runt /** @brief Render an instance the way PRINT does, bounded by depth. */ akerr_ErrorContext AKERR_NOIGNORE *akbasic_struct_to_string(struct akbasic_Runtime *obj, int typeindex, akbasic_Value *base, int depth, char *dest, size_t len); +/* ------------------------------------ host-backed instances (src/host.c) --- */ + +/** @brief Read one host field into a value, converting from its C type. */ +akerr_ErrorContext AKERR_NOIGNORE *akbasic_host_read_field(struct akbasic_Runtime *obj, akbasic_StructField *field, void *hostbase, akbasic_Value *dest); + +/** @brief Write a value back into one host field, refusing what will not fit. */ +akerr_ErrorContext AKERR_NOIGNORE *akbasic_host_write_field(struct akbasic_Runtime *obj, akbasic_StructField *field, void *hostbase, akbasic_Value *src); + +/** @brief Refresh a binding's whole shadow run from the host's struct. */ +akerr_ErrorContext AKERR_NOIGNORE *akbasic_host_refresh(struct akbasic_Runtime *obj, int typeindex, void *hostbase, akbasic_Value *slots); + #endif // _AKBASIC_STRUCTTYPE_H_ diff --git a/include/akbasic/types.h b/include/akbasic/types.h index c86bbbc..507699a 100644 --- a/include/akbasic/types.h +++ b/include/akbasic/types.h @@ -112,6 +112,13 @@ typedef struct akbasic_Value */ int structtype; /* index into the type table, -1 for none */ struct akbasic_Value *structbase; /* first slot of the instance */ + /* + * The host's own struct, when this describes a host binding. The slots above + * are then a *shadow*: a read refreshes one from here and a write converts + * back into here, so a script sees current values and its writes land, with + * one storage model instead of two. + */ + void *hostbase; } akbasic_Value; #endif // _AKBASIC_TYPES_H_ diff --git a/include/akbasic/variable.h b/include/akbasic/variable.h index fdcca84..bfc9dd8 100644 --- a/include/akbasic/variable.h +++ b/include/akbasic/variable.h @@ -34,6 +34,7 @@ typedef struct */ int structtype; /** type index, -1 when not a structure */ bool ispointer; /** declared PTR TO rather than a value */ + void *hostbase; /** the host's struct, for a binding */ } akbasic_Variable; /** diff --git a/src/environment.c b/src/environment.c index 82d4a15..d92a675 100644 --- a/src/environment.c +++ b/src/environment.c @@ -372,8 +372,9 @@ static akerr_ErrorContext *assign_field(akbasic_Environment *obj, akbasic_ASTLea PREPARE_ERROR(errctx); akbasic_StructField *field = NULL; akbasic_Value *slot = NULL; + void *hostbase = NULL; - PASS(errctx, akbasic_struct_resolve(obj->runtime, lval, &field, &slot)); + PASS(errctx, akbasic_struct_resolve(obj->runtime, lval, &field, &slot, &hostbase)); switch ( field->kind ) { case AKBASIC_FIELD_STRUCT: @@ -413,6 +414,16 @@ static akerr_ErrorContext *assign_field(akbasic_Environment *obj, akbasic_ASTLea PASS(errctx, akbasic_value_clone(rval, slot)); break; } + /* + * And straight back into the host's own memory, so `FOE@.HP# = 0` changes + * the game's enemy rather than a copy of it. The conversion refuses what + * will not fit -- an int16_t field handed 70000 is an error naming the + * field, because a silent wrap is found three frames later in code that did + * nothing wrong. + */ + if ( hostbase != NULL && field->kind == AKBASIC_FIELD_PRIMITIVE ) { + PASS(errctx, akbasic_host_write_field(obj->runtime, field, hostbase, slot)); + } *dest = slot; SUCCEED_RETURN(errctx); } diff --git a/src/host.c b/src/host.c new file mode 100644 index 0000000..7d89808 --- /dev/null +++ b/src/host.c @@ -0,0 +1,363 @@ +/** + * @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); +} diff --git a/src/runtime.c b/src/runtime.c index a056ee5..2cb0612 100644 --- a/src/runtime.c +++ b/src/runtime.c @@ -480,10 +480,22 @@ static akerr_ErrorContext *evaluate_identifier(akbasic_Runtime *obj, akbasic_AST PASS(errctx, akbasic_environment_new_value(obj->environment, ©)); PASS(errctx, akbasic_struct_describe(obj, variable->structtype, slot, variable->ispointer, copy)); + /* + * A host binding carries its instance along, so a field read can go to + * the game's memory rather than to the shadow slot. Refreshed here too, + * so `B@ = FOE@` copies what the game holds now rather than what it held + * when the binding was made. + */ + if ( variable->hostbase != NULL ) { + copy->hostbase = variable->hostbase; + PASS(errctx, akbasic_host_refresh(obj, variable->structtype, + variable->hostbase, slot)); + } if ( variable->ispointer ) { /* A pointer variable holds its reference in its own slot. */ copy->structtype = slot->structtype; copy->structbase = slot->structbase; + copy->hostbase = slot->hostbase; } *dest = copy; SUCCEED_RETURN(errctx); @@ -1285,6 +1297,21 @@ akerr_ErrorContext *akbasic_runtime_start(akbasic_Runtime *obj, int mode) FAIL_ZERO_RETURN(errctx, (obj != NULL), AKERR_NULLPOINTER, "NULL runtime in start"); obj->run_finished_mode = (mode == AKBASIC_MODE_REPL ? AKBASIC_MODE_REPL : AKBASIC_MODE_QUIT); + /* + * Start means start, so a run begins at the first line and is not something + * CONT may resume into -- the same two lines `RUN` has always set. + * + * It was missing here, which cost nothing while a host started a script + * once: `nextline` is already 0 the first time. It costs a host that runs a + * script *again* everything, because the second start began past the end and + * silently did nothing. A game rebinding a structure per enemy and running + * one script over each of them is exactly that shape, which is how this was + * found. + */ + if ( mode == AKBASIC_MODE_RUN && obj->environment != NULL ) { + obj->environment->nextline = 0; + obj->stopped = false; + } PASS(errctx, akbasic_runtime_set_mode(obj, mode)); SUCCEED_RETURN(errctx); } diff --git a/src/runtime_struct.c b/src/runtime_struct.c index 068ab17..24304aa 100644 --- a/src/runtime_struct.c +++ b/src/runtime_struct.c @@ -94,7 +94,8 @@ akerr_ErrorContext *akbasic_struct_copy(akbasic_Runtime *obj, int typeindex, * name at all. */ akerr_ErrorContext *akbasic_struct_resolve(akbasic_Runtime *obj, akbasic_ASTLeaf *expr, - akbasic_StructField **fielddest, akbasic_Value **slotdest) + akbasic_StructField **fielddest, akbasic_Value **slotdest, + void **hostdest) { PREPARE_ERROR(errctx); akbasic_Value *basevalue = NULL; @@ -136,6 +137,9 @@ akerr_ErrorContext *akbasic_struct_resolve(akbasic_Runtime *obj, akbasic_ASTLeaf if ( fielddest != NULL ) { *fielddest = field; } + if ( hostdest != NULL ) { + *hostdest = basevalue->hostbase; + } *slotdest = slot; SUCCEED_RETURN(errctx); } @@ -146,8 +150,9 @@ akerr_ErrorContext *akbasic_struct_evaluate_field(akbasic_Runtime *obj, akbasic_ akbasic_StructField *field = NULL; akbasic_Value *slot = NULL; akbasic_Value *out = NULL; + void *hostbase = NULL; - PASS(errctx, akbasic_struct_resolve(obj, expr, &field, &slot)); + PASS(errctx, akbasic_struct_resolve(obj, expr, &field, &slot, &hostbase)); /* * A nested structure evaluates to a description of where it lives, not to a @@ -158,9 +163,20 @@ akerr_ErrorContext *akbasic_struct_evaluate_field(akbasic_Runtime *obj, akbasic_ if ( field->kind == AKBASIC_FIELD_STRUCT ) { PASS(errctx, akbasic_environment_new_value(obj->environment, &out)); PASS(errctx, akbasic_struct_describe(obj, field->typeindex, slot, false, out)); + if ( hostbase != NULL ) { + out->hostbase = (char *)hostbase + field->hostoffset; + } *dest = out; SUCCEED_RETURN(errctx); } + /* + * A host-backed field is read from the host's memory every time, not from + * the shadow slot -- the game may have moved it since the script last + * looked, and "shared" has to mean shared in both directions. + */ + if ( hostbase != NULL ) { + PASS(errctx, akbasic_host_read_field(obj, field, hostbase, slot)); + } *dest = slot; SUCCEED_RETURN(errctx); } @@ -275,7 +291,7 @@ static akerr_ErrorContext *pointer_slot(akbasic_Runtime *obj, akbasic_ASTLeaf *l FAIL_ZERO_RETURN(errctx, (leaf != NULL), AKERR_NULLPOINTER, "NULL leaf in pointer_slot"); if ( leaf->leaftype == AKBASIC_LEAF_FIELD ) { - PASS(errctx, akbasic_struct_resolve(obj, leaf, &field, &slot)); + PASS(errctx, akbasic_struct_resolve(obj, leaf, &field, &slot, NULL)); FAIL_ZERO_RETURN(errctx, (field->kind == AKBASIC_FIELD_POINTER), AKBASIC_ERR_TYPE, "%s is not a pointer; only a field declared PTR TO can be POINTed", field->name); @@ -338,6 +354,13 @@ akerr_ErrorContext *akbasic_cmd_point(akbasic_Runtime *obj, akbasic_ASTLeaf *exp slot->valuetype = AKBASIC_TYPE_POINTER; slot->structtype = target->structtype; slot->structbase = target->structbase; + /* + * And the host instance, when there is one. Without it a pointer aimed at a + * host binding would write the shadow slot and stop there -- the script + * would see its own change and the game would not, which is the one outcome + * worse than refusing outright. + */ + slot->hostbase = target->hostbase; SUCCEED_TRUE(obj, dest); SUCCEED_RETURN(errctx); } diff --git a/src/structtype.c b/src/structtype.c index 61666f6..b47371c 100644 --- a/src/structtype.c +++ b/src/structtype.c @@ -425,7 +425,26 @@ akerr_ErrorContext *akbasic_structtype_scan(akbasic_Runtime *obj) FAIL_ZERO_RETURN(errctx, (obj != NULL), AKERR_NULLPOINTER, "NULL runtime in structtype scan"); table = &obj->structtypes; - PASS(errctx, akbasic_structtype_table_init(table)); + + /* + * Drop what the *script* declared and keep what the *host* registered. + * + * This prescan runs again on every RUN, so wiping the table outright would + * unregister a host's types the first time a script was run -- and the host + * registered them before loading anything, with no way to know it had to do + * it again. Host types are registered before a program exists, so they are + * always a prefix; truncating to that prefix keeps every index a field + * already recorded pointing at the same type. + */ + for ( t = 0; t < table->count; t++ ) { + if ( !table->types[t].ishost ) { + break; + } + } + for ( i = t; i < table->count; i++ ) { + memset(&table->types[i], 0, sizeof(table->types[i])); + } + table->count = t; PASS(errctx, scan_names(obj)); diff --git a/src/value.c b/src/value.c index 66930ce..09ce6a4 100644 --- a/src/value.c +++ b/src/value.c @@ -186,6 +186,7 @@ akerr_ErrorContext *akbasic_value_zero(akbasic_Value *obj) obj->boolvalue = AKBASIC_FALSE; obj->structtype = -1; obj->structbase = NULL; + obj->hostbase = NULL; SUCCEED_RETURN(errctx); } @@ -214,6 +215,7 @@ akerr_ErrorContext *akbasic_value_clone(akbasic_Value *self, akbasic_Value *dest */ dest->structtype = self->structtype; dest->structbase = self->structbase; + dest->hostbase = self->hostbase; /* mutable_ is deliberately not copied: the reference's clone() does not. */ SUCCEED_RETURN(errctx); } diff --git a/tests/hoststruct.c b/tests/hoststruct.c new file mode 100644 index 0000000..1ff0d8b --- /dev/null +++ b/tests/hoststruct.c @@ -0,0 +1,265 @@ +/** + * @file hoststruct.c + * @brief Tests sharing a host C struct with a script. + * + * The assertions that matter are the ones about *conversion*, because that is + * the boundary where the two type systems disagree and where a silent answer + * would be worst. A range check that quietly wraps is found three frames later + * in code that did nothing wrong, so every refusal is asserted individually. + * + * The sharing itself is asserted in both directions: what the script sees when + * the host changes its struct underneath, and what the host sees when the script + * writes. + */ + +#include +#include +#include +#include + +#include +#include +#include + +#include "harness.h" +#include "testutil.h" + +typedef struct +{ + char name[8]; + int8_t tiny; + int16_t small; + int32_t hp; + uint8_t level; + float x; + double weight; + bool hostile; +} test_Enemy; + +static const akbasic_HostField ENEMY_FIELDS[] = { + /* struct member BASIC name C representation */ + AKBASIC_HOST_FIELD( test_Enemy, name, "NAME$", AKBASIC_HOSTFIELD_CSTRING ), + AKBASIC_HOST_FIELD( test_Enemy, tiny, "TINY#", AKBASIC_HOSTFIELD_INT8 ), + AKBASIC_HOST_FIELD( test_Enemy, small, "SMALL#", AKBASIC_HOSTFIELD_INT16 ), + AKBASIC_HOST_FIELD( test_Enemy, hp, "HP#", AKBASIC_HOSTFIELD_INT32 ), + AKBASIC_HOST_FIELD( test_Enemy, level, "LEVEL#", AKBASIC_HOSTFIELD_UINT8 ), + AKBASIC_HOST_FIELD( test_Enemy, x, "X%", AKBASIC_HOSTFIELD_FLOAT ), + AKBASIC_HOST_FIELD( test_Enemy, weight, "WEIGHT%", AKBASIC_HOSTFIELD_DOUBLE ), + AKBASIC_HOST_FIELD( test_Enemy, hostile, "HOSTILE#", AKBASIC_HOSTFIELD_BOOL ) +}; + +static const akbasic_HostType ENEMY_TYPE = { + "ENEMY", sizeof(test_Enemy), ENEMY_FIELDS, 8 +}; + +static test_Enemy ENEMY; + +/** @brief A fresh runtime with ENEMY registered and bound to FOE@. */ +static akerr_ErrorContext AKERR_NOIGNORE *bind_and_run(const char *program) +{ + PREPARE_ERROR(errctx); + + memset(&ENEMY, 0, sizeof(ENEMY)); + snprintf(ENEMY.name, sizeof(ENEMY.name), "GOBLIN"); + ENEMY.tiny = 1; + ENEMY.small = 2; + ENEMY.hp = 30; + ENEMY.level = 3; + ENEMY.x = 1.5f; + ENEMY.weight = 2.25; + ENEMY.hostile = true; + + PASS(errctx, harness_start(NULL)); + PASS(errctx, akbasic_host_register_type(&HARNESS_RUNTIME, &ENEMY_TYPE)); + PASS(errctx, akbasic_host_bind(&HARNESS_RUNTIME, "FOE@", "ENEMY", &ENEMY)); + PASS(errctx, akbasic_runtime_load(&HARNESS_RUNTIME, program)); + PASS(errctx, akbasic_runtime_start(&HARNESS_RUNTIME, AKBASIC_MODE_RUN)); + PASS(errctx, akbasic_runtime_run(&HARNESS_RUNTIME, 4000)); + SUCCEED_RETURN(errctx); +} + +/** @brief Every C representation reaches the script as the right BASIC value. */ +static void test_reads(void) +{ + TEST_REQUIRE_OK(bind_and_run("10 PRINT FOE@.NAME$\n" + "20 PRINT FOE@.TINY#\n" + "30 PRINT FOE@.SMALL#\n" + "40 PRINT FOE@.HP#\n" + "50 PRINT FOE@.LEVEL#\n" + "60 PRINT FOE@.WEIGHT%\n" + "70 PRINT FOE@.HOSTILE#\n")); + /* A bool reads as -1, the Commodore convention every condition already uses. */ + TEST_REQUIRE_STR(HARNESS_OUTPUT, "GOBLIN\n1\n2\n30\n3\n2.250000\n-1\n"); + harness_stop(); +} + +/** @brief A write reaches the host's own struct, with no step in between. */ +static void test_writes_reach_the_host(void) +{ + TEST_REQUIRE_OK(bind_and_run("10 FOE@.HP# = FOE@.HP# - 10\n" + "20 FOE@.NAME$ = \"ORC\"\n" + "30 FOE@.HOSTILE# = 0\n" + "40 FOE@.WEIGHT% = 9.5\n")); + TEST_REQUIRE_INT(ENEMY.hp, 20); + TEST_REQUIRE_STR(ENEMY.name, "ORC"); + TEST_REQUIRE(ENEMY.hostile == false, "a zero should have cleared the host's bool"); + TEST_REQUIRE_FEQ(ENEMY.weight, 9.5); + harness_stop(); +} + +/** + * @brief The script sees what the host holds *now*, not a snapshot. + * + * The half of "shared" that a copy-in binding would get wrong: the game moves + * its own data between statements and the script has to see it. + */ +static void test_host_changes_are_visible(void) +{ + TEST_REQUIRE_OK(bind_and_run("10 PRINT FOE@.HP#\n")); + TEST_REQUIRE_STR(HARNESS_OUTPUT, "30\n"); + harness_stop(); + + /* Change it behind the script's back, then run again. */ + TEST_REQUIRE_OK(harness_start(NULL)); + memset(&ENEMY, 0, sizeof(ENEMY)); + ENEMY.hp = 30; + TEST_REQUIRE_OK(akbasic_host_register_type(&HARNESS_RUNTIME, &ENEMY_TYPE)); + TEST_REQUIRE_OK(akbasic_host_bind(&HARNESS_RUNTIME, "FOE@", "ENEMY", &ENEMY)); + TEST_REQUIRE_OK(akbasic_runtime_load(&HARNESS_RUNTIME, "10 PRINT FOE@.HP#\n")); + ENEMY.hp = 77; + TEST_REQUIRE_OK(akbasic_runtime_start(&HARNESS_RUNTIME, AKBASIC_MODE_RUN)); + TEST_REQUIRE_OK(akbasic_runtime_run(&HARNESS_RUNTIME, 4000)); + TEST_REQUIRE_STR(HARNESS_OUTPUT, "77\n"); + harness_stop(); +} + +/** + * @brief A value that will not fit is refused, by field, rather than wrapped. + * + * One case per width, because a range check is exactly the sort of thing that is + * right for `int32_t` and wrong for `int8_t` when only one of them is tested. + */ +static void test_conversion_refuses_rather_than_truncates(void) +{ + static const char *CASES[] = { + "10 FOE@.TINY# = 200\n", /* int8_t */ + "10 FOE@.SMALL# = 70000\n", /* int16_t */ + "10 FOE@.LEVEL# = -1\n", /* uint8_t */ + "10 FOE@.NAME$ = \"MUCH TOO LONG\"\n" /* char[8] */ + }; + size_t i = 0; + + for ( i = 0; i < sizeof(CASES) / sizeof(CASES[0]); i++ ) { + TEST_REQUIRE_OK(bind_and_run(CASES[i])); + TEST_REQUIRE(strstr(HARNESS_OUTPUT, "does not fit") != NULL, + "case %zu should be refused rather than truncated, got \"%s\"", + i, HARNESS_OUTPUT); + harness_stop(); + } + + /* And the host's struct is untouched by a refused write. */ + TEST_REQUIRE_OK(bind_and_run("10 FOE@.TINY# = 200\n")); + TEST_REQUIRE_INT(ENEMY.tiny, 1); + harness_stop(); +} + +/** + * @brief Copy still copies, and POINT still shares -- across the boundary too. + * + * The reason there is one API rather than two: the language's own distinction + * turns out to be exactly the one a host needs, so which one a script used is + * visible in the listing. + */ +static void test_copy_versus_point(void) +{ + TEST_REQUIRE_OK(bind_and_run("10 TYPE MINE\n" + "20 HP#\n" + "30 END TYPE\n" + "40 DIM SNAP@ AS MINE\n" + "50 SNAP@.HP# = FOE@.HP#\n" + "60 SNAP@.HP# = 0\n" + "70 PRINT FOE@.HP#\n")); + /* The snapshot moved; the game did not. */ + TEST_REQUIRE_STR(HARNESS_OUTPUT, "30\n"); + TEST_REQUIRE_INT(ENEMY.hp, 30); + harness_stop(); + + TEST_REQUIRE_OK(bind_and_run("10 DIM LIVE@ AS PTR TO ENEMY\n" + "20 POINT LIVE@ AT FOE@\n" + "30 LIVE@->HP# = 5\n")); + TEST_REQUIRE_INT(ENEMY.hp, 5); + harness_stop(); +} + +/** @brief A suffix that disagrees with the C type is refused at registration. */ +static void test_suffix_must_match_the_c_type(void) +{ + static const akbasic_HostField WRONG[] = { + AKBASIC_HOST_FIELD( test_Enemy, hp, "HP%", AKBASIC_HOSTFIELD_INT32 ) + }; + static const akbasic_HostType WRONG_TYPE = { "WRONGT", sizeof(test_Enemy), WRONG, 1 }; + akerr_ErrorContext *raised = NULL; + + TEST_REQUIRE_OK(harness_start(NULL)); + raised = akbasic_host_register_type(&HARNESS_RUNTIME, &WRONG_TYPE); + TEST_REQUIRE(raised != NULL, "a float suffix over an int32_t must be refused"); + TEST_REQUIRE_INT(raised->status, AKBASIC_ERR_VALUE); + test_discard_error(raised); + harness_stop(); +} + +/** + * @brief After unbinding, the name is refused rather than read. + * + * The whole reason the entry point exists: a binding is the only pointer this + * interpreter holds that it did not allocate, so a host has to be able to take + * it back before the storage goes. + */ +static void test_unbind_refuses_later_reads(void) +{ + TEST_REQUIRE_OK(harness_start(NULL)); + memset(&ENEMY, 0, sizeof(ENEMY)); + ENEMY.hp = 30; + TEST_REQUIRE_OK(akbasic_host_register_type(&HARNESS_RUNTIME, &ENEMY_TYPE)); + TEST_REQUIRE_OK(akbasic_host_bind(&HARNESS_RUNTIME, "FOE@", "ENEMY", &ENEMY)); + TEST_REQUIRE_OK(akbasic_host_unbind(&HARNESS_RUNTIME, "FOE@")); + TEST_REQUIRE_OK(akbasic_runtime_load(&HARNESS_RUNTIME, "10 PRINT FOE@.HP#\n")); + TEST_REQUIRE_OK(akbasic_runtime_start(&HARNESS_RUNTIME, AKBASIC_MODE_RUN)); + TEST_REQUIRE_OK(akbasic_runtime_run(&HARNESS_RUNTIME, 4000)); + TEST_REQUIRE(strstr(HARNESS_OUTPUT, "ERROR") != NULL, + "reading an unbound name should be refused, got \"%s\"", HARNESS_OUTPUT); + harness_stop(); +} + +/** @brief A binding survives the prescan, which runs again on every RUN. */ +static void test_registration_survives_a_rerun(void) +{ + TEST_REQUIRE_OK(bind_and_run("10 PRINT FOE@.HP#\n")); + TEST_REQUIRE_STR(HARNESS_OUTPUT, "30\n"); + TEST_REQUIRE_OK(akbasic_runtime_start(&HARNESS_RUNTIME, AKBASIC_MODE_RUN)); + TEST_REQUIRE_OK(akbasic_runtime_run(&HARNESS_RUNTIME, 4000)); + /* + * The prescan clears what the *script* declared and keeps what the *host* + * registered. Wiping the table outright unregistered the host's types the + * first time a script ran, with no way for the host to know it had to + * register them again. + */ + TEST_REQUIRE_STR(HARNESS_OUTPUT, "30\n30\n"); + harness_stop(); +} + +int main(void) +{ + TEST_REQUIRE_OK(akbasic_error_register()); + + test_reads(); + test_writes_reach_the_host(); + test_host_changes_are_visible(); + test_conversion_refuses_rather_than_truncates(); + test_copy_versus_point(); + test_suffix_must_match_the_c_type(); + test_unbind_refuses_later_reads(); + test_registration_survives_a_rerun(); + + return akbasic_test_failures; +}