diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml index 4a027ed..40ba102 100644 --- a/.github/workflows/ci.yml +++ b/.github/workflows/ci.yml @@ -30,6 +30,9 @@ jobs: - name: Compiler tests run: bash tests/run_compiler_tests.sh + - name: Cross-language (FFI) test + run: bash tests/run_ffi_test.sh + dos-cross-compile: runs-on: ubuntu-latest steps: diff --git a/docs/getting-started.md b/docs/getting-started.md index ce44d91..656aaf6 100644 --- a/docs/getting-started.md +++ b/docs/getting-started.md @@ -229,8 +229,67 @@ gfortran driver.f90 greet.o -L./build -lgwrt -lm -lpthread -lpulse-simple The BASIC code shares the `gw` interpreter state with `libgwrt`, so a single binary runs at most one BASIC program at a time. Calling BASIC -from C / Fortran is always safe; calling C / Fortran from BASIC needs -the foreign-function-declaration extension on the roadmap (Level 2). +from C / Fortran is always safe; calling C / Fortran *from* BASIC uses +the `'$EXTERN` pragma described next. + +### Foreign Functions from BASIC (`'$EXTERN`) + +A `'$EXTERN` pragma declares a C function that compiled BASIC can call +directly. It is written as an apostrophe comment, so the interpreter +ignores it while the compiler picks it up: + +```basic +10 '$EXTERN Cmul(DOUBLE, DOUBLE) AS DOUBLE +20 '$EXTERN Greet(STRING) AS STRING +30 '$EXTERN Getn AS INTEGER +40 PRINT Cmul(2.5, 4) +50 PRINT Greet("World") +60 PRINT Getn +``` + +Type mapping at the boundary: + +| BASIC type | C type | +|------------|---------------| +| `INTEGER` | `int16_t` | +| `SINGLE` | `float` | +| `DOUBLE` | `double` | +| `STRING` | `const char *` (NUL-terminated) | + +The C side supplies the symbols at link time: + +```c +#include +int16_t Getn(void) { return 42; } +double Cmul(double a, double b) { return a * b; } +const char *Greet(const char *who) { + static char buf[128]; + snprintf(buf, sizeof buf, "Hello, %s!", who); + return buf; /* callee owns the buffer; BASIC copies it */ +} +``` + +Build and link as in the `--emit-obj` example above: + +```bash +build/gwbasic-compile --emit-obj --runtime . demo.bas # -> demo.o +gcc -c lib.c -o lib.o +gcc demo.o lib.o -L./build -lgwrt -lm -lpthread -lpulse-simple -o demo +``` + +Notes and constraints: + +- The function name is matched case-insensitively at the call site (BASIC + convention) but emitted as the C symbol with the **case written in the + pragma**, so `Cmul` calls C's `Cmul`, not `cmul`. +- Names must be BASIC-legal identifiers (letters and digits) because the + call site is tokenized as ordinary BASIC. To call a C function whose + name contains underscores or other characters (e.g. `sqlite3_open`), + write a thin C wrapper with a BASIC-legal name. +- String arguments cross as `const char *` (the compiler converts and frees + a temporary copy); a `STRING` return value is copied into the BASIC + string pool and the callee retains ownership of its own buffer. +- For Fortran callees, declare the routine `bind(c)` with a matching name. ## Building for DOS / FreeDOS diff --git a/docs/roadmap.md b/docs/roadmap.md index a79ed0b..9ca7e31 100644 --- a/docs/roadmap.md +++ b/docs/roadmap.md @@ -91,97 +91,45 @@ Cross-compiles to DOS using OpenWatcom V2. Two targets: Tested on FreeDOS 1.4 via QEMU. -## Next Up - -### Compiler Optimization Flags -- **`--inline-arrays`** -- emit direct array indexing for statically-DIMmed arrays - instead of runtime `gwrt_array_elem()` lookup -- **`-O0` through `-O3`** -- compiler-level optimization tiers mapping to different - sets of codegen optimizations (constant folding, dead code elimination, FOR - step=1 elision, fast-path expressions) - -### Cross-Language Linking - -Three levels of integration with C and Fortran. Level 1 is implemented; -Level 2 is the natural follow-up; Level 3 is deferred unless a concrete -use case appears. - -- **Level 1 -- Link BASIC objects into a larger C/Fortran project (done)** - -- `gwbasic-compile prog.bas --emit-obj --main-name=run_basic` produces - `prog.o` with the entry point renamed. The host project links it - alongside its own objects against `libgwrt`. From Fortran, declare - the entry with `bind(c)`. - -- **Level 2 -- Foreign function declarations from BASIC**: extend the - language with a `'$EXTERN NAME(ARGS) AS TYPE` pragma (or a new - `EXTERNAL` statement) so BASIC code can call C functions directly. - Type mapping: `INTEGER` <-> `int16_t`, `SINGLE` <-> `float`, - `DOUBLE` <-> `double`, `STRING` <-> `char *` (NUL-terminated, owned - by `gw_str_to_cstr`) or `gw_string_t` for richer interop. Fortran - callees must use `bind(c)`; legacy F77/F90 mangling out of scope -- - users write a thin C shim instead. - -- **Level 3 (deferred) -- Embed individual BASIC SUBs/FUNCTIONs as - C-callable functions**. Compile each labeled SUB or DEF FN to a - separate C function with a stable signature; emit a header so C - drivers can call them. Useful when BASIC is the configuration / - rule-engine language for a larger application. Bigger scope: - needs export annotations, header generation, and a way to share - state between calls. Defer until a specific use case appears. - -### IDE Integration -- **VS Code extension** -- syntax highlighting (TextMate grammar), snippets, - run/debug tasks, integrated terminal runner -- **JetBrains plugin (IntelliJ/CLion)** -- syntax highlighting, code completion, - run configurations, debugger integration (breakpoints via `STOP`, variable - inspection), structure view (line number outline) - -### Formatted I/O Extensions - -Beyond the existing `PRINT` / `PRINT USING` / `PRINT#`, expose two -formatted-I/O styles familiar from neighbouring languages. Both write -through the existing HAL output path so they work in interactive mode -and in compiled binaries. - -- **FORTRAN-style `WRITE`** -- `WRITE (#unit, "(format-spec)") args` - with Fortran format-spec language: `I5`, `F8.3`, `E12.4`, `A`, `X`, - `/` (newline), repeat counts, slashes, parenthesized groups. Useful - for porting numerical code; Fortran formats are denser than - PRINT USING. -- **C-style `PRINTF`** -- `PRINTF format$, arg, arg, ...` accepting C's - `%d` / `%f` / `%e` / `%g` / `%s` / `%c` / `%x` / `%o` / width / precision - / flags. Cheaper to learn for users coming from C / Python. Goes to - stdout; `FPRINTF #unit, ...` for file output. - -Both share an underlying formatter (probably a C function in -`libgwrt`) that the codegen calls directly; the interpreter tokenizes -and dispatches the same way. - -### Numerical / Data Standard Library - -Substantial scope -- treat as a separate sub-project, possibly a -companion repo. All three modules build on top of GW-BASIC arrays -(or new dynamically-typed buffers via DEF SEG / virtual memory). -Likely written partly in BASIC and partly in C for the inner loops. - -- **NumPy-style array module** -- `NDARRAY` type with shape, dtype, - broadcasting; element-wise ops (`+`, `*`, `SIN`, `EXP`); reductions - (`SUM`, `MIN`, `MAX`, `MEAN`); slicing; basic linear algebra (`MATMUL`, - `INV`, `EIG`). The existing single-typed BASIC arrays are a starting - point; the new module needs a proper shape/dtype descriptor. -- **DataFrame module (pandas-like)** -- column-oriented table with - named columns and heterogeneous dtypes; CSV / TSV load and save; - filter, sort, group-by, aggregate, join. Builds on the array - module. -- **Plotting module (matplotlib-like)** -- high-level wrappers - (`PLOT x, y`, `SCATTER`, `BAR`, `HIST`) with axes, labels, legend, - title. Backend: existing CGA / Sixel rendering for terminals; PNG - output via stb_image_write or libpng for files; SVG as a third - backend that needs no library. Output format selectable - (`SET BACKEND` or per-call argument). - -Each module wants its own design pass before implementation; the -sketches above are the rough shapes. +### Cross-Language Linking (Levels 1 & 2) + +- **Level 1 (v0.17.0)** -- `gwbasic-compile prog.bas --emit-obj + --main-name=run_basic` produces `prog.o` with a renamed entry point, so a + host C/Fortran project can link BASIC objects alongside its own against + `libgwrt`. From Fortran, declare the entry with `bind(c)`. +- **Level 2 -- `'$EXTERN` FFI pragma** -- `'$EXTERN NAME(ARGTYPES) AS RET` + declares a C function callable from compiled BASIC, with INTEGER/SINGLE/ + DOUBLE/STRING ⇄ C type coercion at the boundary. Case-preserving C symbol, + BASIC-legal call name. See *Foreign Functions from BASIC* in + getting-started.md; test at `tests/run_ffi_test.sh`. Arbitrary-C-symbol + aliasing and string-result comparison are follow-ups (git-bug). + +Level 3 (export BASIC routines as C-callable) remains deferred -- see git-bug. + +## Planned + +Actionable planned work is tracked in **git-bug** (`git-bug bug`), grouped +by priority/theme labels rather than duplicated here. Release and outreach +items (FreeDOS package, Show HN writeup, etc.) live in git-bug only; this +file keeps the shipped-feature history and the known limitations. Current +dev highlights: + +| Theme | Item | git-bug | Priority | +|-------|------|---------|----------| +| compiler | `$EXTERN` follow-ups -- aliasing, INSTR/WRITE dispatch, validation | `8329647` | P2 | +| compiler | `--inline-arrays` direct array indexing | `e6d977c` | P2 | +| compiler | `-O0..-O3` codegen optimization tiers | `fecc17f` | P2 | +| compiler | Level 3 -- export BASIC SUBs/FUNCs as C-callable (deferred) | `1b7d59c` | P2 | +| language | FORTRAN-style `WRITE` formatted I/O | `a6e99af` | P2 | +| language | C-style `PRINTF` / `FPRINTF` | `cd8750c` | P2 | +| ide | VS Code extension (+ JetBrains follow-up) | `32a637c` | P2 | +| stdlib | Numerical/Data stdlib -- NDArray + DataFrame + Plotting (sub-project) | `55a9d14` | P2 | + +Recently shipped: Level 2 `'$EXTERN` FFI pragma (`56b96e0`, closed). + +Run `git-bug bug show ` for the full design notes on any item. The +numerical/data stdlib (`55a9d14`) is the main enabler for the +Jupyter-kernel data-analysis use case. ## Known Limitations diff --git a/include/analysis.h b/include/analysis.h index 1af25a8..57ef7d8 100644 --- a/include/analysis.h +++ b/include/analysis.h @@ -11,6 +11,10 @@ #define MAX_DATA 4096 #define MAX_GOSUB_RET 1024 +#define MAX_EXTERNS 64 +#define MAX_EXTERN_ARGS 8 +#define EXTERN_NAME_MAX 32 + typedef struct { uint16_t line_num; bool is_target; /* referenced by GOTO/GOSUB/etc. */ @@ -18,6 +22,16 @@ typedef struct { int data_start; /* index into data pool */ } line_info_t; +/* A C function declared via the '$EXTERN NAME(ARGS) AS RET pragma. + * name is stored case-preserving (emitted as the C symbol); matching + * against BASIC call sites is case-insensitive. */ +typedef struct { + char name[EXTERN_NAME_MAX]; + gw_valtype_t ret_type; + gw_valtype_t arg_types[MAX_EXTERN_ARGS]; + int argc; +} extern_func_t; + typedef struct { char name[2]; gw_valtype_t type; @@ -42,6 +56,9 @@ typedef struct { int data_line_count; gw_valtype_t def_type[26]; /* from DEFINT/DEFSNG/DEFDBL/DEFSTR */ + + extern_func_t externs[MAX_EXTERNS]; /* '$EXTERN FFI declarations */ + int extern_count; } analysis_t; /* Run analysis pass over the loaded program */ @@ -56,6 +73,9 @@ int analysis_add_var(analysis_t *a, const char name[2], gw_valtype_t type); /* Check if a line number is a jump target */ bool analysis_is_target(analysis_t *a, uint16_t line_num); +/* Find a declared extern function by name (case-insensitive), or NULL */ +const extern_func_t *analysis_find_extern(analysis_t *a, const char *name); + /* Emit static analysis warnings to stderr */ void analysis_warnings(analysis_t *a); diff --git a/src/analysis.c b/src/analysis.c index 704c1dc..b75db8c 100644 --- a/src/analysis.c +++ b/src/analysis.c @@ -54,6 +54,112 @@ static bool is_letter(uint8_t ch) return (ch >= 'A' && ch <= 'Z') || (ch >= 'a' && ch <= 'z'); } +/* ---- '$EXTERN FFI pragma support ---- */ + +/* Case-insensitive match of keyword kw at the start of s. */ +static bool ci_starts(const char *s, const char *kw) +{ + for (; *kw; s++, kw++) + if (toupper((unsigned char)*s) != toupper((unsigned char)*kw)) + return false; + return true; +} + +/* Read an identifier-like word from *pp (letters only), uppercase into buf. */ +static int read_word(const char **pp, char *buf, int max) +{ + const char *p = *pp; + int i = 0; + while (*p == ' ') p++; + while (is_letter((uint8_t)*p) && i < max - 1) + buf[i++] = (char)toupper((unsigned char)*p++); + while (is_letter((uint8_t)*p)) p++; /* drain overflow so *pp lands past the word */ + buf[i] = 0; + *pp = p; + return i; +} + +/* Map a BASIC type keyword to a value type, or (gw_valtype_t)0 if unknown. */ +static gw_valtype_t parse_type_word(const char *w) +{ + if (!strcmp(w, "INTEGER") || !strcmp(w, "INT")) return VT_INT; + if (!strcmp(w, "SINGLE")) return VT_SNG; + if (!strcmp(w, "DOUBLE")) return VT_DBL; + if (!strcmp(w, "STRING") || !strcmp(w, "STR")) return VT_STR; + return (gw_valtype_t)0; +} + +/* Parse a '$EXTERN NAME(T1, T2, ...) AS RET pragma body (the raw comment + * text, starting at "$EXTERN") and register the function. */ +static void parse_extern_pragma(analysis_t *a, const char *text) +{ + if (a->extern_count >= MAX_EXTERNS) + return; + const char *p = text + 7; /* skip "$EXTERN" */ + extern_func_t ef; + memset(&ef, 0, sizeof(ef)); + ef.ret_type = VT_SNG; /* default if no AS clause */ + + /* Function name (case-preserving). Restricted to BASIC-legal identifier + * characters (letters and digits) because the call site is tokenized as + * ordinary BASIC; a C symbol with other characters needs a thin wrapper. */ + while (*p == ' ') p++; + int i = 0; + while ((is_letter((uint8_t)*p) || (*p >= '0' && *p <= '9')) + && i < EXTERN_NAME_MAX - 1) + ef.name[i++] = *p++; + while (is_letter((uint8_t)*p) || (*p >= '0' && *p <= '9')) + p++; /* drain overflow so the arg/return parse below stays in sync */ + ef.name[i] = 0; + if (i == 0) + return; + + /* Optional argument list. */ + while (*p == ' ') p++; + if (*p == '(') { + p++; + while (*p == ' ') p++; + if (*p != ')') { + do { + if (*p == ',') p++; + char w[16]; + read_word(&p, w, sizeof(w)); + gw_valtype_t t = parse_type_word(w); + if (t && ef.argc < MAX_EXTERN_ARGS) + ef.arg_types[ef.argc++] = t; + while (*p == ' ') p++; + } while (*p == ','); + } + if (*p == ')') p++; + } + + /* Optional "AS RET" clause. */ + while (*p == ' ') p++; + if (ci_starts(p, "AS")) { + p += 2; + char w[16]; + read_word(&p, w, sizeof(w)); + gw_valtype_t t = parse_type_word(w); + if (t) ef.ret_type = t; + } + + a->externs[a->extern_count++] = ef; +} + +const extern_func_t *analysis_find_extern(analysis_t *a, const char *name) +{ + for (int i = 0; i < a->extern_count; i++) { + const char *s = a->externs[i].name, *q = name; + while (*s && *q && + toupper((unsigned char)*s) == toupper((unsigned char)*q)) { + s++; q++; + } + if (*s == 0 && *q == 0) + return &a->externs[i]; + } + return NULL; +} + /* Add a GOTO/GOSUB target line number */ static void add_target(analysis_t *a, uint16_t line_num) { @@ -291,12 +397,28 @@ static void scan_tokens(analysis_t *a, uint8_t *tokens, int len, uint16_t line_n /* Variable reference */ if (is_letter(tok)) { char name[2] = {(char)toupper(tok), 0}; + char full[EXTERN_NAME_MAX]; + int fi = 0; + full[fi++] = (char)toupper(tok); p++; if (p < end && (is_letter(*p) || (*p >= '0' && *p <= '9'))) { name[1] = (char)toupper(*p); + if (fi < EXTERN_NAME_MAX - 1) full[fi++] = (char)toupper(*p); p++; - while (p < end && (is_letter(*p) || (*p >= '0' && *p <= '9'))) + while (p < end && (is_letter(*p) || (*p >= '0' && *p <= '9'))) { + if (fi < EXTERN_NAME_MAX - 1) full[fi++] = (char)toupper(*p); + p++; + } + } + full[fi] = 0; + /* A declared extern is a function call, not a variable — don't add + * it to the census. Its argument expressions are scanned normally + * by the surrounding loop. */ + if (analysis_find_extern(a, full)) { + if (p < end && (*p == '$' || *p == '%' || *p == '!' || *p == '#')) p++; + assign_ctx = false; + continue; } uint8_t suffix = (p < end) ? *p : 0; if (suffix == '$' || suffix == '%' || suffix == '!' || suffix == '#') @@ -390,6 +512,28 @@ void analysis_run(analysis_t *a) } } + /* Pass 0b: collect '$EXTERN FFI pragmas. These are standalone + * apostrophe/REM comment lines (`'$EXTERN NAME(ARGS) AS RET`), so the + * interpreter ignores them while the compiler registers them. Must run + * before Pass 1 so use-sites aren't mistaken for array variables. */ + for (program_line_t *line = gw.prog_head; line; line = line->next) { + uint8_t *p = line->tokens; + if (line->len <= 0 || (p[0] != TOK_REM && p[0] != TOK_SQUOTE)) + continue; + uint8_t *end = line->tokens + line->len; + p++; + while (p < end && *p == ' ') p++; + if (p < end && *p == '$') { + char buf[256]; + int bi = 0; + while (p < end && *p && bi < (int)sizeof(buf) - 1) + buf[bi++] = (char)*p++; + buf[bi] = 0; + if (ci_starts(buf, "$EXTERN")) + parse_extern_pragma(a, buf); + } + } + /* Pass 1: collect line numbers and scan tokens */ for (program_line_t *line = gw.prog_head; line; line = line->next) { if (a->line_count >= MAX_LINES) break; diff --git a/src/codegen.c b/src/codegen.c index 61df750..da34662 100644 --- a/src/codegen.c +++ b/src/codegen.c @@ -89,6 +89,31 @@ static const char *c_type(gw_valtype_t t) } } +/* C type at the FFI boundary: STRING crosses as a C string, not gw_string_t. */ +static const char *c_ffi_type(gw_valtype_t t) +{ + return (t == VT_STR) ? "const char *" : c_type(t); +} + +/* Peek the full identifier at the token cursor into buf (uppercased, type + * suffix excluded) WITHOUT advancing tp. Returns the cursor position just + * past the identifier and any trailing type-suffix character — assign it to + * tp to consume. Used to recognise multi-char '$EXTERN function names that + * parse_var() would otherwise truncate to two significant characters. */ +static uint8_t *peek_full_ident(char *buf, int max) +{ + uint8_t *p = tp; + int i = 0; + if (is_letter(*p)) { + while ((is_letter(*p) || (*p >= '0' && *p <= '9')) && i < max - 1) + buf[i++] = (char)toupper(*p++); + while (is_letter(*p) || (*p >= '0' && *p <= '9')) p++; + } + buf[i] = 0; + if (*p == '$' || *p == '%' || *p == '!' || *p == '#') p++; + return p; +} + /* Emit a 2-char name as a C string literal: "AB" or "A" */ static void emit_name_str(const char name[2]) { @@ -154,6 +179,7 @@ static gw_valtype_t parse_var(char name_out[2]) /* Forward declarations */ static void emit_str_expr(void); static void emit_num_expr(void); +static void emit_extern_call(const extern_func_t *ef); static int op_prec(uint8_t tok) { @@ -659,6 +685,28 @@ static void emit_atom(void) return; } + /* Extern (FFI) function call — must be checked before parse_var(), which + * would truncate the name to two significant characters. */ + if (is_letter(tok)) { + char fname[EXTERN_NAME_MAX]; + peek_full_ident(fname, sizeof fname); + const extern_func_t *ef = analysis_find_extern(ana, fname); + if (ef) { + if (ef->ret_type != VT_STR) { + emit_extern_call(ef); + } else { + /* string-returning extern in a numeric context: consume the + * call so the stream stays in sync, emit a numeric zero */ + FILE *orig = out; char *junk = NULL; size_t js = 0; + out = open_memstream(&junk, &js); + emit_extern_call(ef); + fclose(out); out = orig; free(junk); + EMIT("0 /* string extern in num ctx */"); + } + return; + } + } + /* Variable or array element */ if (is_letter(tok)) { char name[2]; @@ -1208,6 +1256,26 @@ static void emit_str_atom(void) return; } + /* Extern (FFI) function call returning a string. */ + if (is_letter(tok)) { + char fname[EXTERN_NAME_MAX]; + peek_full_ident(fname, sizeof fname); + const extern_func_t *ef = analysis_find_extern(ana, fname); + if (ef) { + if (ef->ret_type == VT_STR) { + emit_extern_call(ef); + } else { + /* numeric extern in a string context: consume + empty string */ + FILE *orig = out; char *junk = NULL; size_t js = 0; + out = open_memstream(&junk, &js); + emit_extern_call(ef); + fclose(out); out = orig; free(junk); + EMIT("gw_str_from_cstr(\"\") /* numeric extern in str ctx */"); + } + return; + } + } + /* String variable or array element */ if (is_letter(tok)) { char name[2]; @@ -1294,6 +1362,79 @@ static void emit_stmt(void); /* Peek at the next expression to guess its result type. * Only returns VT_INT for pure integer atoms (no operators). * For anything involving operators, returns the variable/constant type. */ +/* Emit a call to a declared '$EXTERN C function. tp is positioned at the + * function name; this consumes the name and a parenthesised argument list, + * emitting a GCC statement-expression that coerces each argument to its + * declared C type, calls the function, frees any temporary C strings, and + * yields the result. String arguments cross as NUL-terminated char*; a + * string return is copied into the BASIC string pool (the callee owns its + * returned buffer — it is not freed here). */ +static void emit_extern_call(const extern_func_t *ef) +{ + char namebuf[EXTERN_NAME_MAX]; + tp = peek_full_ident(namebuf, sizeof namebuf); /* consume name + suffix */ + skip_spaces(); + + char *argbuf[MAX_EXTERN_ARGS]; + gw_valtype_t argt[MAX_EXTERN_ARGS]; + int n = 0; /* args actually passed (capped at MAX_EXTERN_ARGS) */ + int total = 0; /* args seen in the source call */ + if (cur() == '(') { + advance(); + if (cur() != ')') { + do { + if (total > 0 && cur() == ',') advance(); + gw_valtype_t at = (total < ef->argc) ? ef->arg_types[total] : VT_SNG; + FILE *orig = out; char *b = NULL; size_t sz = 0; + out = open_memstream(&b, &sz); + if (at == VT_STR) emit_str_expr(); + else emit_num_expr(); + fclose(out); out = orig; + /* Always consume every argument so the token stream stays in + * sync; only the first MAX_EXTERN_ARGS are passed through. */ + if (n < MAX_EXTERN_ARGS) { argbuf[n] = b; argt[n] = at; n++; } + else free(b); + total++; + } while (cur() == ','); + } + if (cur() == ')') advance(); + } + if (total != ef->argc) + fprintf(stderr, "warning: line %u: extern %s called with %d argument(s)," + " declared with %d\n", emit_line, ef->name, total, ef->argc); + + EMIT("({ "); + for (int i = 0; i < n; i++) { + if (argt[i] == VT_STR) + EMIT("gw_string_t _s%d = (%s); char *_a%d = gw_str_to_cstr(&_s%d);" + " gw_str_free(&_s%d); ", i, argbuf[i], i, i, i); + else + EMIT("%s _a%d = (%s)(%s); ", + c_ffi_type(argt[i]), i, c_ffi_type(argt[i]), argbuf[i]); + free(argbuf[i]); + } + if (ef->ret_type == VT_STR) + EMIT("const char *_r = %s(", ef->name); + else + EMIT("%s _r = %s(", c_ffi_type(ef->ret_type), ef->name); + for (int i = 0; i < n; i++) { if (i) EMIT(", "); EMIT("_a%d", i); } + EMIT("); "); + if (ef->ret_type == VT_STR) { + /* Copy the result into the string pool BEFORE freeing the C-string arg + * temporaries — a callee may legitimately return (a pointer into) one + * of its char* arguments (e.g. an in-place trim), so freeing first + * would be a use-after-free. */ + EMIT("gw_string_t _ret = gw_str_from_cstr(_r ? _r : \"\"); "); + for (int i = 0; i < n; i++) + if (argt[i] == VT_STR) EMIT("free(_a%d); ", i); + EMIT("_ret; })"); + } else { + for (int i = 0; i < n; i++) + if (argt[i] == VT_STR) EMIT("free(_a%d); ", i); + EMIT("_r; })"); + } +} + static gw_valtype_t peek_expr_type(void) { uint8_t *save = tp; @@ -1302,6 +1443,10 @@ static gw_valtype_t peek_expr_type(void) /* Variable — check suffix (most important case) */ if (is_letter(tok)) { + char fname[EXTERN_NAME_MAX]; + peek_full_ident(fname, sizeof fname); + const extern_func_t *ef = analysis_find_extern(ana, fname); + if (ef) { tp = save; return ef->ret_type; } char name[2]; gw_valtype_t type = parse_var(name); tp = save; @@ -1490,11 +1635,18 @@ static void emit_print(void) uint8_t tok = cur(); bool is_str = (tok == '"' || tok == TOK_STRINGS); if (is_letter(tok)) { - uint8_t *save = tp; - char name[2]; - gw_valtype_t type = parse_var(name); - tp = save; - is_str = (type == VT_STR); + char fname[EXTERN_NAME_MAX]; + peek_full_ident(fname, sizeof fname); + const extern_func_t *ef = analysis_find_extern(ana, fname); + if (ef) { + is_str = (ef->ret_type == VT_STR); + } else { + uint8_t *save = tp; + char name[2]; + gw_valtype_t type = parse_var(name); + tp = save; + is_str = (type == VT_STR); + } } if (tok == TOK_PREFIX_FF) { uint8_t func = tp[1]; @@ -2757,6 +2909,25 @@ void codegen_emit(FILE *f, analysis_t *a, const codegen_opts_t *opts) EMIT("#include \n"); EMIT("#include \n\n"); + /* Foreign-function prototypes from '$EXTERN pragmas (Level 2 + * cross-language linking). The host project supplies these symbols at + * link time. */ + for (int i = 0; i < a->extern_count; i++) { + extern_func_t *e = &a->externs[i]; + EMIT("extern %s %s(", c_ffi_type(e->ret_type), e->name); + if (e->argc == 0) { + EMIT("void"); + } else { + for (int k = 0; k < e->argc; k++) { + if (k) EMIT(", "); + EMIT("%s", c_ffi_type(e->arg_types[k])); + } + } + EMIT(");\n"); + } + if (a->extern_count > 0) + EMIT("\n"); + /* Variable declarations */ for (int i = 0; i < a->var_count; i++) { EMIT("static %s ", c_type(a->vars[i].type)); diff --git a/tests/ffi/expected.txt b/tests/ffi/expected.txt new file mode 100644 index 0000000..49183c0 --- /dev/null +++ b/tests/ffi/expected.txt @@ -0,0 +1,6 @@ +sum= 7 +hyp= 5 +Hello, World! +Hello, BASIC! +getn= 42 +HELLO diff --git a/tests/ffi/extern_demo.bas b/tests/ffi/extern_demo.bas new file mode 100644 index 0000000..68e7fb3 --- /dev/null +++ b/tests/ffi/extern_demo.bas @@ -0,0 +1,13 @@ +10 '$EXTERN Cadd(INTEGER, INTEGER) AS INTEGER +20 '$EXTERN Chypot(DOUBLE, DOUBLE) AS DOUBLE +30 '$EXTERN Greet(STRING) AS STRING +40 '$EXTERN Getn AS INTEGER +50 '$EXTERN Upcase(STRING) AS STRING +60 PRINT "sum="; Cadd(3, 4) +70 PRINT "hyp="; Chypot(3, 4) +80 A$ = "World" +90 PRINT Greet(A$) +100 PRINT Greet("BASIC") +110 PRINT "getn="; Getn +120 PRINT Upcase("hello") +130 END diff --git a/tests/ffi/extern_lib.c b/tests/ffi/extern_lib.c new file mode 100644 index 0000000..b9e29b7 --- /dev/null +++ b/tests/ffi/extern_lib.c @@ -0,0 +1,26 @@ +/* C functions called from extern_demo.bas via '$EXTERN pragmas. */ +#include +#include +#include +#include + +int16_t Cadd(int16_t a, int16_t b) { return (int16_t)(a + b); } +double Chypot(double a, double b) { return hypot(a, b); } +int16_t Getn(void) { return 42; } + +const char *Greet(const char *who) +{ + static char buf[128]; + snprintf(buf, sizeof buf, "Hello, %s!", who); + return buf; +} + +/* Returns its own argument pointer after modifying it in place. Exercises the + * string-return path where the result aliases a C-string arg temporary — the + * codegen must copy the result before freeing that temporary. */ +const char *Upcase(const char *s) +{ + for (char *p = (char *)s; *p; p++) + *p = (char)toupper((unsigned char)*p); + return s; +} diff --git a/tests/run_ffi_test.sh b/tests/run_ffi_test.sh new file mode 100755 index 0000000..88ecf07 --- /dev/null +++ b/tests/run_ffi_test.sh @@ -0,0 +1,45 @@ +#!/bin/bash +# Exercise the Level 2 cross-language path: compile a BASIC program that calls +# C functions via '$EXTERN pragmas, link it against a companion C object, run +# it, and compare against expected output. +set -u + +SCRIPT_DIR="$(cd "$(dirname "$0")" && pwd)" +PROJECT_DIR="$(cd "$SCRIPT_DIR/.." && pwd)" +COMPILE="${PROJECT_DIR}/build/gwbasic-compile" +FFI_DIR="${SCRIPT_DIR}/ffi" +WORK_DIR=$(mktemp -d) +trap 'rm -rf "$WORK_DIR"' EXIT + +if [ ! -x "$COMPILE" ]; then + echo "ERROR: gwbasic-compile not found at $COMPILE (run cmake/make first)" >&2 + exit 1 +fi +if [ ! -f "$PROJECT_DIR/build/libgwrt.a" ]; then + echo "ERROR: libgwrt.a not built yet (run cmake/make first)" >&2 + exit 1 +fi + +cp "$FFI_DIR/extern_demo.bas" "$FFI_DIR/extern_lib.c" "$WORK_DIR/" +cd "$WORK_DIR" || exit 1 + +# BASIC -> object (entry point stays main; the C lib provides only helpers) +if ! "$COMPILE" extern_demo.bas --emit-obj --runtime "$PROJECT_DIR" >/dev/null 2>&1; then + echo "FAIL: gwbasic-compile --emit-obj failed" >&2 + exit 1 +fi +gcc -c extern_lib.c -o extern_lib.o || { echo "FAIL: C lib compile" >&2; exit 1; } + +LINK="gcc extern_demo.o extern_lib.o -o extern_demo -L$PROJECT_DIR/build -lgwrt -lm -lpthread" +if ! $LINK -lpulse-simple 2>/dev/null; then + $LINK 2>/dev/null || { echo "FAIL: link" >&2; exit 1; } +fi + +./extern_demo > got.txt 2>&1 +if diff -u "$FFI_DIR/expected.txt" got.txt; then + echo "PASS ffi extern_demo" + exit 0 +else + echo "FAIL ffi extern_demo (output mismatch above)" >&2 + exit 1 +fi