Forráskód Böngészése

ffi: make top-level procedures C-callable

Eric Streit 1 napja
szülő
commit
1de82f0c62

+ 1 - 0
compiler/run_tests.sh

@@ -174,6 +174,7 @@ expect_run t_f32proc.mod 42
 expect_run t_f32field.mod 42
 expect_run t_f32conv.mod 42
 expect_run t_f32const.mod 42
+expect_run t_callback.mod 42
 expect_run t_extern_alias.mod 42
 expect_run t_with.mod 114
 expect_run t_set.mod 131

+ 18 - 9
compiler/src/QbeGen.mod

@@ -68,6 +68,7 @@ VAR
   stkLink : ARRAY [0 .. 15] OF QVal;    (* per-call static links *)
   stkExt : ARRAY [0 .. 15] OF BOOLEAN;  (* per-call external flag *)
   stkInd : ARRAY [0 .. 15] OF BOOLEAN;  (* per-call indirect flag *)
+  stkHasLink : ARRAY [0 .. 15] OF BOOLEAN; (* per-call hidden static link *)
   outSel : CARDINAL;  (* 0 = file, else nestBufs[outSel-1] *)
   nInit : CARDINAL;
   initNames : ARRAY [0 .. 31] OF QVal;
@@ -1275,9 +1276,14 @@ PROCEDURE BeginFunc (mangled: ARRAY OF CHAR);
     Cpy(funcName, mangled);
     hbuf[0] := CHR(0);
     NewTemp(slTmp);
-    HApp("l ");
-    HApp(slTmp);
-    hdrComma := TRUE;
+    hdrComma := FALSE;
+    IF funcDepth > 1 THEN
+      (* Nested procedures still take the parent frame link; top-level
+         procedures use the C-visible argument list. *)
+      HApp("l ");
+      HApp(slTmp);
+      hdrComma := TRUE
+    END;
     IF funcDepth > 1 THEN
       outSel := funcDepth - 1;
       IF outSel > HIGH(nestBufs) + 1 THEN
@@ -1345,7 +1351,9 @@ PROCEDURE EndFuncHeader;
     Cpy(scopeLink[scopeTop - 1], lk);
     Revive;
     W("  "); W(lk); W(" =l alloc8 520"); WL("");
-    W("  storel "); W(slTmp); W(", "); WL(lk);
+    W("  storel ");
+    IF funcDepth > 1 THEN W(slTmp) ELSE W("0") END;
+    W(", "); WL(lk);
     i := 0;
     WHILE i < nPar DO
       cls := SymTab.ClassOf(parTyp[i]);
@@ -1511,6 +1519,7 @@ PROCEDURE CallBeginInd (callee: ARRAY OF CHAR; resT: INTEGER;
     stkRes[callDepth] := ResClass(resT);
     stkExt[callDepth] := isExt;
     stkInd[callDepth] := TRUE;
+    stkHasLink[callDepth] := FALSE;
     Cpy(stkLink[callDepth], "0");
     stkArg[callDepth][0] := CHR(0);
     stkN[callDepth] := 0;
@@ -1560,13 +1569,13 @@ PROCEDURE CallBegin (mangled: ARRAY OF CHAR; resT: INTEGER;
     stkRes[callDepth] := ResClass(resT);
     stkExt[callDepth] := isExt;
     stkInd[callDepth] := FALSE;
+    stkHasLink[callDepth] := FALSE;
     stkArg[callDepth][0] := CHR(0);
     stkN[callDepth] := 0;
-    IF isExt THEN
-      Cpy(stkLink[callDepth], "0")
-    ELSIF funcDepth = 0 THEN
+    IF isExt OR (fdep = 0) THEN
       Cpy(stkLink[callDepth], "0")
     ELSE
+      stkHasLink[callDepth] := TRUE;
       walks := VAL(INTEGER, funcDepth) - VAL(INTEGER, fdep);
       Cpy(cur, scopeLink[scopeTop - 1]);
       WHILE walks > 0 DO
@@ -1644,8 +1653,8 @@ PROCEDURE CallEnd (wantRes: BOOLEAN; VAR q: QVal);
     ELSE
       W(" call $"); W(funcName); W("(")
     END;
-    IF stkExt[d] THEN
-      W(body)                       (* C callee: no static link *)
+    IF stkExt[d] OR NOT stkHasLink[d] THEN
+      W(body)                       (* C/top-level callee: no static link *)
     ELSE
       W("l "); W(stkLink[d]);
       IF body[0] # CHR(0) THEN W(", "); W(body) END

+ 34 - 0
compiler/tests/t_callback.mod

@@ -0,0 +1,34 @@
+MODULE TCallback;
+(* A top-level V3 procedure is C-callable after the callback ABI change. *)
+FROM SYSTEM IMPORT ADDRESS, ADR;
+
+PROCEDURE add (a, b : INTEGER) : INTEGER;
+BEGIN
+  RETURN a + b
+END add;
+
+PROCEDURE call_add (fn : ADDRESS; a, b : INTEGER) : INTEGER;
+  EXTERNAL "m2_c_call_add";
+PROCEDURE call_two (fn, a, b : ADDRESS); EXTERNAL "m2_c_call_two";
+
+VAR
+  ExitCode : INTEGER;
+  gotA, gotB : ADDRESS;
+
+PROCEDURE two (a, b : ADDRESS);
+BEGIN
+  gotA := a;
+  gotB := b
+END two;
+
+BEGIN
+  gotA := NIL;
+  gotB := NIL;
+  call_two(ADR(two), ADR(gotA), ADR(gotB));
+  IF (call_add(ADR(add), 20, 22) = 42)
+     AND (gotA = ADR(gotA)) AND (gotB = ADR(gotB)) THEN
+    ExitCode := 42
+  ELSE
+    ExitCode := 1
+  END
+END TCallback.

+ 2 - 0
docs/INDEX.md

@@ -56,6 +56,8 @@ bisecting *why* a decision was made, not for reading end-to-end).
   incremental builds and self-host; dialect library-folder appendix.
 - **`cstruct-layout.md`** — C-layout for records in `FOR "C"` modules:
   natural alignment, `sizeof`/`offsetof`, pointer-only boundary policy.
+- **`callback-abi.md`** — top-level V3 procedures as C function pointers,
+  trampoline/user-data rules, nested/method limitations.
 - **`design-exceptions.md`** — ISO exceptions design: grammar/AST,
   handler stack, `sigsetjmp`/`siglongjmp` codegen, `EXCEPTIONS` /
   `M2EXCEPTION`, trap mapping, module `FINALLY`, tests.  M1–M5 and

+ 66 - 0
docs/callback-abi.md

@@ -0,0 +1,66 @@
+# Callback ABI
+
+Top-level V3 procedures are now **C-callable**:
+
+- no hidden static-link parameter;
+- arguments and result follow the C/QBE ABI;
+- `ADR(Proc)` yields a function pointer usable through a C
+  `typedef` / `void *`;
+- `short real`, `CBool`, C strings and C-layout record pointers work
+  in callback signatures.
+
+Example:
+
+```modula2
+PROCEDURE add (a, b : INTEGER) : INTEGER;
+BEGIN
+  RETURN a + b
+END add;
+
+PROCEDURE call_add (fn : ADDRESS; a, b : INTEGER) : INTEGER;
+  EXTERNAL "m2_c_call_add";
+
+...
+call_add(ADR(add), 20, 22)
+```
+
+The C side is:
+
+```c
+int m2_c_call_add(void *fn, int a, int b)
+{
+    int (*f)(int, int) = (int (*)(int, int))fn;
+    return f(a, b);
+}
+```
+
+Covered by `compiler/tests/t_callback.mod`.
+
+## Nested procedures
+
+Nested procedures still take a hidden parent-frame link and are **not**
+C-callable. Keep callbacks at module level, or use a small C/Modula-2
+trampoline with a context record.
+
+## GTK/GObject pattern
+
+A `GtkClosures`-style design now works without a C wrapper for the
+V3 procedure itself:
+
+```modula2
+PROCEDURE Tramp2 (instance, ctx : ADDRESS);
+```
+
+The C side registers `Tramp2` as the signal callback and passes the
+`ctx` pointer as user data. Keep allocation, destroy handling and
+`user_data` ownership in a context object, as in the existing
+`GtkClosures` design.
+
+## Still not supported
+
+- V3 instance methods as direct C callbacks; they still carry a hidden
+  receiver, so use a top-level trampoline.
+- Nested procedure values.
+- C varargs callbacks.
+- C struct-by-value callback arguments/results; use pointers or a C
+  shim.

+ 4 - 0
docs/features.md

@@ -101,6 +101,10 @@ Legend: ✅ done · 🔄 partial · ⏸ not started / deferred.
   C `sizeof` for `SIZE`, and C `offsetof` field offsets.  They are
   currently passed to C by pointer; by-value struct ABI and inline C
   arrays remain shim territory.
+- ✅ Top-level procedures are C-callable function pointers: no hidden
+  static link, C argument/result order, and `ADR(proc)` works with a C
+  callback typedef.  Nested procedures and instance methods still need
+  a top-level trampoline.
 - ✅ Set builtins `INCL`/`EXCL` and `SHIFT`/`ROTATE`; `SET OF <enum>`
   and `SET OF <char-range>`; bounded sets up to 1,000,000 bits;
   `SET OF CARDINAL` and `SET OF INTEGER` use a sorted range-list

+ 13 - 0
runtime/syslib/shim.c

@@ -441,6 +441,19 @@ _Bool m2_cbool_not(_Bool b)
     return !b;
 }
 
+/* C callback test: call a V3 top-level procedure with C arguments. */
+int m2_c_call_add(void *fn, int a, int b)
+{
+    int (*f)(int, int) = (int (*)(int, int))fn;
+    return f(a, b);
+}
+
+void m2_c_call_two(void *fn, void *a, void *b)
+{
+    void (*f)(void *, void *) = (void (*)(void *, void *))fn;
+    f(a, b);
+}
+
 /* C struct-layout audit helpers. */
 typedef struct {
     int x, y, w, h;