Compiler: $EXTERN pragma for calling C functions from BASIC (Level 2 FFI) (#1)
Add a '$EXTERN NAME(ARGTYPES) AS RET pragma so compiled BASIC can call C functions directly, the natural follow-up to Level 1 (--emit-obj / --main-name). The pragma is an apostrophe comment, so the interpreter ignores it while the compiler registers it. Map INTEGER/SINGLE/DOUBLE/STRING to int16_t/float/double/const char* at the boundary: a string argument crosses as a temporary C copy that is freed after the call, and a string return is copied into the pool. The call name is matched case-insensitively but emitted as the C symbol with the case written in the pragma. Names are recognized before parse_var() truncates identifiers to two significant characters, so multi-character C function names work. A string return that aliases a char* argument is copied before the argument temporaries are freed, which avoids a use-after-free. Over-supplied arguments are consumed without desyncing the token stream and warn on arity mismatch. Docs: getting-started.md "Foreign Functions from BASIC". Test: tests/run_ffi_test.sh, wired into CI. 63/63 compiler, 72/72 interpreter, 68/68 compat still pass. Also refile the roadmap "Next Up" backlog as git-bug issues and prune docs/roadmap.md to point at git-bug as the source of truth for planned work. Co-authored-by: Eremey Valetov <evvaletov@users.noreply.github.com>
This commit is contained in:
Eremey Valetov
co-authored by
Eremey Valetov
Eremey Valetov
parent
791b5a4710
commit
89fe0fb0b3
@@ -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:
|
||||
|
||||
+61
-2
@@ -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 <stdint.h>
|
||||
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
|
||||
|
||||
|
||||
+32
-84
@@ -91,97 +91,45 @@ Cross-compiles to DOS using OpenWatcom V2. Two targets:
|
||||
|
||||
Tested on FreeDOS 1.4 via QEMU.
|
||||
|
||||
## Next Up
|
||||
### Cross-Language Linking (Levels 1 & 2)
|
||||
|
||||
### 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)
|
||||
- **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).
|
||||
|
||||
### Cross-Language Linking
|
||||
Level 3 (export BASIC routines as C-callable) remains deferred -- see git-bug.
|
||||
|
||||
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.
|
||||
## Planned
|
||||
|
||||
- **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)`.
|
||||
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:
|
||||
|
||||
- **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.
|
||||
| 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 |
|
||||
|
||||
- **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.
|
||||
Recently shipped: Level 2 `'$EXTERN` FFI pragma (`56b96e0`, closed).
|
||||
|
||||
### 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.
|
||||
Run `git-bug bug show <id>` 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
|
||||
|
||||
|
||||
@@ -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);
|
||||
|
||||
|
||||
+145
-1
@@ -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;
|
||||
|
||||
+176
-5
@@ -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 <string.h>\n");
|
||||
EMIT("#include <time.h>\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));
|
||||
|
||||
@@ -0,0 +1,6 @@
|
||||
sum= 7
|
||||
hyp= 5
|
||||
Hello, World!
|
||||
Hello, BASIC!
|
||||
getn= 42
|
||||
HELLO
|
||||
@@ -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
|
||||
@@ -0,0 +1,26 @@
|
||||
/* C functions called from extern_demo.bas via '$EXTERN pragmas. */
|
||||
#include <stdint.h>
|
||||
#include <math.h>
|
||||
#include <stdio.h>
|
||||
#include <ctype.h>
|
||||
|
||||
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;
|
||||
}
|
||||
Executable
+45
@@ -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
|
||||
Reference in New Issue
Block a user