Browse Source

ffi: use C layout for FOR "C" records

Eric Streit 1 day ago
parent
commit
169f37b582

+ 1 - 0
compiler/run_tests.sh

@@ -353,6 +353,7 @@ expect_run_files TCStringQualProg 42 t_cstring.def t_cstring_qual_prog.mod
 expect_run_files CStrProg 42 ../runtime/syslib/CStr.def ../runtime/syslib/CStr.mod tests/cstr_test.def tests/cstr_prog.mod
 expect_run_files LinkNameProg 42 linkname.def linkname_prog.mod
 expect_run_files CAbiScalarsProg 42 cabi_scalars.def cabi_scalars_prog.mod
+expect_run_files CStructLayoutProg 42 cstruct_layout.def cstruct_layout_prog.mod
 expect_run_files EEnumProg 42 e_enum.def e_enum_re.def e_enum_prog.mod
 expect_run_files TClassDefProg 8 t_classdef.def t_classdef_prog.mod
 expect_run_files DQualProg 46 d_basic.def d_basic.mod d_qual_prog.mod

+ 4 - 1
compiler/src/M2.atg

@@ -1727,7 +1727,10 @@ PRODUCTIONS
   RecordType<VAR t: SymTab.TypeIndex>   (. VAR t2: SymTab.TypeIndex;
                                              tagOk: BOOLEAN; .)
     = "RECORD"                          (. allowFwdType := FALSE;
-                                           t := SymTab.NewRecord(); .)
+                                           t := SymTab.NewRecord();
+                                           IF foreignUnit THEN
+                                             SymTab.SetCStruct(t)
+                                           END; .)
       [ RecItem<t> { ";" [ RecItem<t> ] } ]
       "END"                             (. SymTab.LayoutRecord(t); .) .
   RecItem<rec: SymTab.TypeIndex>        (. VAR tt: SymTab.TypeIndex; .)

+ 25 - 3
compiler/src/QbeGen.mod

@@ -2730,6 +2730,13 @@ PROCEDURE RecItems (t: SymTab.TypeIndex; prefix: ARRAY OF CHAR;
     END Sep;
 
   BEGIN
+    IF SymTab.IsCStruct(t) THEN
+      Sep;
+      W("z ");
+      IntStr(VAL(INTEGER, SymTab.TypeSize(t)), sub);
+      W(sub);
+      RETURN
+    END;
     n := SymTab.FieldCount(t);
     i := 0;
     WHILE i < n DO
@@ -2834,6 +2841,11 @@ PROCEDURE DeclRec (name: ARRAY OF CHAR; t: INTEGER);
     vt, sz: QVal;
   BEGIN
     IF NOT opened THEN RETURN END;
+    IF SymTab.IsCStruct(t) THEN
+      IntStr(VAL(INTEGER, SymTab.TypeSize(t)), sz);
+      W("export data $"); W(name); W(" = { z "); W(sz); WL(" }");
+      RETURN
+    END;
     IF SymTab.IsVariant(t) AND (SymTab.ClassOf(t) = SymTab.ClRecord) THEN
       (* variant record: fields overlay, so emit one zero-filled blob
          of the record's (max) size *)
@@ -4537,7 +4549,11 @@ PROCEDURE RecItemDefaults (VAR s: ARRAY OF CHAR; VAR first: BOOLEAN;
       ft := SymTab.FieldType(t, fn);
       cls := SymTab.ClassOf(ft);
       IF first THEN first := FALSE ELSE App(s, ", ") END;
-      IF cls = SymTab.ClReal THEN App(s, "d 0")
+      IF SymTab.IsCStruct(ft) THEN
+        App(s, "z ");
+        IntStr(VAL(INTEGER, SymTab.TypeSize(ft)), sub);
+        App(s, sub)
+      ELSIF cls = SymTab.ClReal THEN App(s, "d 0")
       ELSIF cls = SymTab.ClSReal THEN App(s, "s 0")
       ELSIF (cls = SymTab.ClChar) OR (cls = SymTab.ClByte)
          OR (cls = SymTab.ClSByte) OR (cls = SymTab.ClCBool) THEN App(s, "b 0")
@@ -5294,14 +5310,20 @@ PROCEDURE DeclRecTemplate (varName: ARRAY OF CHAR; rec: INTEGER);
 (* "data $<mod>_<varName>_tmpl = { <one record with counts set> }" plus
    any nested sub-descriptors; InitRecArray copies it over each element
    of the compact array-of-record blob. *)
-  VAR g: QVal; first: BOOLEAN;
+  VAR g, nb: QVal; first: BOOLEAN;
   BEGIN
     IF NOT opened THEN RETURN END;
     Cpy(g, curModName); App(g, "_"); App(g, varName); App(g, "_tmpl");
     RecStatics(g, rec);
     W("export data $"); W(g); W(" = { ");
     first := TRUE;
-    RecItems(rec, g, first);
+    IF SymTab.IsCStruct(rec) THEN
+      W("z ");
+      IntStr(VAL(INTEGER, SymTab.TypeSize(rec)), nb);
+      W(nb)
+    ELSE
+      RecItems(rec, g, first)
+    END;
     WL(" }")
   END DeclRecTemplate;
 

+ 5 - 0
compiler/src/SymTab.def

@@ -621,6 +621,11 @@ PROCEDURE TypeSize (t: TypeIndex): CARDINAL;
 PROCEDURE FieldOffset (rec: TypeIndex; name: ARRAY OF CHAR): INTEGER;
 (* Declaration-order byte offset (-1 if absent). Computed lazily. *)
 
+PROCEDURE SetCStruct (rec: TypeIndex);
+(* Mark a record as C-layout: natural alignment and trailing padding.
+   Used automatically for records declared in a FOR "C" module. *)
+PROCEDURE IsCStruct (rec: TypeIndex): BOOLEAN;
+
 
 PROCEDURE FieldCount (rec: TypeIndex): CARDINAL;
 PROCEDURE FieldName (rec: TypeIndex; i: CARDINAL; VAR name: Name);

+ 108 - 0
compiler/src/SymTab.mod

@@ -123,6 +123,7 @@ VAR
   tmod  : ARRAY [0 .. MaxTypes - 1] OF Name;  (* defining module *)
   tscope : ARRAY [0 .. MaxTypes - 1] OF ScopePtr;
   tdone : ARRAY [0 .. MaxTypes - 1] OF BOOLEAN;
+  tcstruct : ARRAY [0 .. MaxTypes - 1] OF BOOLEAN;
   (* per-class vtables: each class owns a slice of the shared pool *)
   vtBase : ARRAY [0 .. MaxTypes - 1] OF CARDINAL;
   nVirt  : ARRAY [0 .. MaxTypes - 1] OF CARDINAL;
@@ -759,6 +760,7 @@ PROCEDURE NewDesc (form: INTEGER; ref: TypeIndex): TypeIndex;
     tref[nTypes] := ref;
     tbytebuf[nTypes] := FALSE;
     tdone[nTypes] := FALSE;
+    tcstruct[nTypes] := FALSE;
     tvtag[nTypes] := FALSE;
     vtBase[nTypes] := 0;
     nVirt[nTypes] := 0;
@@ -1768,6 +1770,42 @@ PROCEDURE ArrayFieldFootprint (t: TypeIndex): CARDINAL;
     RETURN ArrObjSize(t)
   END ArrayFieldFootprint;
 
+PROCEDURE AlignUp (n, a: CARDINAL): CARDINAL;
+  BEGIN
+    IF a <= 1 THEN RETURN n END;
+    RETURN ((n + a - 1) DIV a) * a
+  END AlignUp;
+
+PROCEDURE AlignOfD (t: TypeIndex; depth: CARDINAL): CARDINAL;
+(* Natural C alignment of t.  Used only for C-layout records. *)
+  VAR r: TypeIndex; f: FieldPtr; a, max: CARDINAL;
+  BEGIN
+    IF depth > ResDepth THEN RETURN 1 END;
+    r := Resolve(t);
+    IF r = InvalidType THEN RETURN 1 END;
+    CASE tform[r] OF
+      FByte, FSByte, FCBool : RETURN 1
+    | FWord16, FSWord16 : RETURN 2
+    | FInt, FBool, FChar, FUChar, FReal32, FEnum, FSub : RETURN 4
+    | FSet : RETURN 4
+    | FPackSet : RETURN SetBytes(t)
+    | FLong, FReal, FPtr, FProc, FArray, FOpenArr, FUStr, FBigSet : RETURN 8
+    | FRecord :
+        IF NOT tcstruct[r] THEN RETURN 8 END;
+        max := 1; f := fields;
+        WHILE f # NIL DO
+          IF f^.owner = r THEN
+            a := AlignOfD(f^.typ, depth + 1);
+            IF a > max THEN max := a END
+          END;
+          f := f^.next
+        END;
+        RETURN max
+    | FAlias : RETURN AlignOfD(tref[r], depth + 1)
+    ELSE RETURN 1
+    END
+  END AlignOfD;
+
 PROCEDURE TypeSizeD (t: TypeIndex; depth: CARDINAL): CARDINAL;
 (* Inline footprint in bytes: scalars 4/8, sets words*4, pointers,
    open and fixed arrays 8 (descriptor address — array objects live
@@ -1793,6 +1831,37 @@ PROCEDURE TypeSizeD (t: TypeIndex; depth: CARDINAL): CARDINAL;
     | FPackSet : RETURN SetBytes(t)
     | FPtr, FOpenArr, FArray, FProc, FUStr : RETURN 8
     | FRecord, FClass :
+        IF (tform[r] = FRecord) AND tcstruct[r] THEN
+          (* C layout: natural alignment, trailing padding. *)
+          n := 0; plain := 0; high := FieldCount(t); f := fields;
+          WHILE f # NIL DO
+            IF f^.owner = r THEN
+              DEC(high);
+              f^.ord := high
+            END;
+            f := f^.next
+          END;
+          n := 0; high := 0; plain := 1;
+          WHILE high < FieldCount(t) DO
+            f := fields;
+            WHILE f # NIL DO
+              IF (f^.owner = r) AND (f^.ord = high) THEN
+                n := AlignUp(n, AlignOfD(f^.typ, depth + 1));
+                IF ClassOf(f^.typ) = ClArray THEN
+                  n := n + ArrayFieldFootprint(f^.typ)
+                ELSE
+                  n := n + TypeSizeD(f^.typ, depth + 1)
+                END;
+                IF AlignOfD(f^.typ, depth + 1) > plain THEN
+                  plain := AlignOfD(f^.typ, depth + 1)
+                END
+              END;
+              f := f^.next
+            END;
+            INC(high)
+          END;
+          RETURN AlignUp(n, plain)
+        END;
         n := 0;
         IF (tform[r] = FClass) AND (tparent[r] # InvalidType) THEN
           (* single inheritance: parent fields (and its vptr) come first *)
@@ -1991,6 +2060,31 @@ PROCEDURE ComputeOffsets (r: TypeIndex);
        AND (tvptr[r] = baseOff) THEN
       baseOff := baseOff + 8
     END;
+    IF (tform[r] = FRecord) AND tcstruct[r] THEN
+      cnt := FieldCount(r);
+      ord := cnt; f := fields;
+      WHILE f # NIL DO
+        IF f^.owner = r THEN DEC(ord); f^.ord := ord END;
+        f := f^.next
+      END;
+      total := 0; high := 1; ord := 0;
+      WHILE ord < cnt DO
+        f := fields;
+        WHILE f # NIL DO
+          IF (f^.owner = r) AND (f^.ord = ord) THEN
+            tagSize := VAL(INTEGER, AlignOfD(f^.typ, 0));
+            total := (total + tagSize - 1) DIV tagSize * tagSize;
+            f^.off := total;
+            total := total + VAL(INTEGER, FieldSize(f^.typ));
+            IF tagSize > high THEN high := tagSize END
+          END;
+          f := f^.next
+        END;
+        INC(ord)
+      END;
+      tdone[r] := TRUE;
+      RETURN
+    END;
     IF NOT tvtag[r] THEN
       (* plain record/class: declaration-ordered, tightly packed *)
       total := baseOff; cnt := 0;
@@ -2095,6 +2189,20 @@ PROCEDURE LayoutRecord (t: TypeIndex);
     END
   END LayoutRecord;
 
+PROCEDURE SetCStruct (rec: TypeIndex);
+  VAR r: TypeIndex;
+  BEGIN
+    r := Resolve(rec);
+    IF (r # InvalidType) AND (tform[r] = FRecord) THEN tcstruct[r] := TRUE END
+  END SetCStruct;
+
+PROCEDURE IsCStruct (rec: TypeIndex): BOOLEAN;
+  VAR r: TypeIndex;
+  BEGIN
+    r := Resolve(rec);
+    RETURN (r # InvalidType) AND (tform[r] = FRecord) AND tcstruct[r]
+  END IsCStruct;
+
 PROCEDURE FieldOffset (rec: TypeIndex; name: ARRAY OF CHAR): INTEGER;
   VAR r: TypeIndex;
     f: FieldPtr;

+ 22 - 0
compiler/tests/cstruct_layout.def

@@ -0,0 +1,22 @@
+DEFINITION MODULE FOR "C" CStructLayout;
+(* Records in a FOR "C" interface use the C layout. *)
+FROM SYSTEM IMPORT ADDRESS;
+EXPORT UNQUALIFIED Mixed, Rect, FRect, RGBA;
+TYPE
+  Mixed = RECORD
+    b : CBool;
+    f : SHORTREAL;
+    d : REAL;
+    i : INTEGER;
+    p : ADDRESS;
+  END;
+  Rect = RECORD
+    x, y, w, h : INTEGER;
+  END;
+  FRect = RECORD
+    x, y, w, h : SHORTREAL;
+  END;
+  RGBA = RECORD
+    r, g, b, a : SHORTREAL;
+  END;
+END CStructLayout.

+ 30 - 0
compiler/tests/cstruct_layout_prog.mod

@@ -0,0 +1,30 @@
+MODULE CStructLayoutProg;
+FROM SYSTEM IMPORT ADDRESS, ADR;
+FROM CStructLayout IMPORT Mixed, Rect, FRect, RGBA;
+
+PROCEDURE mixed_size () : INTEGER; EXTERNAL "m2_c_layout_mixed_size";
+PROCEDURE rect_size () : INTEGER; EXTERNAL "m2_c_layout_rect_size";
+PROCEDURE frect_size () : INTEGER; EXTERNAL "m2_c_layout_frect_size";
+PROCEDURE rgba_size () : INTEGER; EXTERNAL "m2_c_layout_rgba_size";
+PROCEDURE off (base, field : ADDRESS; which : INTEGER) : INTEGER;
+  EXTERNAL "m2_c_layout_offset";
+
+VAR
+  ExitCode : INTEGER;
+  m : Mixed;
+
+BEGIN
+  IF (SIZE(Mixed) = mixed_size())
+     AND (SIZE(Rect) = rect_size())
+     AND (SIZE(FRect) = frect_size())
+     AND (SIZE(RGBA) = rgba_size())
+     AND (off(ADR(m), ADR(m.b), 0) = 1)
+     AND (off(ADR(m), ADR(m.f), 1) = 1)
+     AND (off(ADR(m), ADR(m.d), 2) = 1)
+     AND (off(ADR(m), ADR(m.i), 3) = 1)
+     AND (off(ADR(m), ADR(m.p), 4) = 1) THEN
+    ExitCode := 42
+  ELSE
+    ExitCode := 1
+  END
+END CStructLayoutProg.

+ 2 - 0
docs/INDEX.md

@@ -54,6 +54,8 @@ bisecting *why* a decision was made, not for reading end-to-end).
 - **`plan-separate-compilation.md`** — design record: core stable
   symbols/per-unit objects/init/linker implemented; deferred generics,
   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.
 - **`design-exceptions.md`** — ISO exceptions design: grammar/AST,
   handler stack, `sigsetjmp`/`siglongjmp` codegen, `EXCEPTIONS` /
   `M2EXCEPTION`, trap mapping, module `FINALLY`, tests.  M1–M5 and

+ 64 - 0
docs/cstruct-layout.md

@@ -0,0 +1,64 @@
+# C record layout
+
+Records declared in a `DEFINITION MODULE FOR "C"` use the **C record
+layout**:
+
+- declaration-order fields;
+- natural alignment for each field;
+- trailing padding to the record's maximum alignment;
+- `SIZE` is the C `sizeof` value;
+- field offsets match C `offsetof`.
+
+Example:
+
+```modula2
+DEFINITION MODULE FOR "C" CStructLayout;
+
+FROM SYSTEM IMPORT ADDRESS;
+
+TYPE
+  Mixed = RECORD
+    b : CBool;       (* 1-byte _Bool *)
+    f : SHORTREAL;   (* 4-byte float *)
+    d : REAL;        (* 8-byte double *)
+    i : INTEGER;     (* 4-byte int *)
+    p : ADDRESS;     (* 8-byte pointer *)
+  END;
+END CStructLayout.
+```
+
+The layout is:
+
+```text
+b  @ 0
+f  @ 4
+d  @ 8
+i  @16
+p  @24
+sizeof(Mixed) = 32
+```
+
+This is covered by `compiler/tests/cstruct_layout.def` and
+`CStructLayoutProg`, with the C side checked using `sizeof` and
+`offsetof`.
+
+## Initial boundary policy
+
+Records are currently passed to C **by pointer** only:
+
+```modula2
+c_function(ADR(record))
+```
+
+By-value C struct parameters and results are not yet part of the ABI;
+use a C shim for APIs that require them.
+
+C structs containing inline C arrays cannot be represented by V3 array
+fields, which are descriptors/pointers. Such records need a C shim or
+an array-free view.
+
+## Next
+
+Callback/function-pointer ABI, with top-level trampolines and a
+`user_data` + destroy convention such as the existing `GtkClosures`
+design.

+ 4 - 0
docs/features.md

@@ -97,6 +97,10 @@ Legend: ✅ done · 🔄 partial · ⏸ not started / deferred.
   arithmetic (expressions use double internally).
 - ✅ `CBool`/`CBOOL`: 1-byte C `_Bool` storage and ABI; loads/stores
   use byte access and external results are normalized to 0/1.
+- ✅ Records declared in a `FOR "C"` module use C natural alignment,
+  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.
 - ✅ 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

+ 43 - 0
runtime/syslib/shim.c

@@ -9,6 +9,7 @@
  */
 
 #define _GNU_SOURCE
+#include <stddef.h>
 #include <unistd.h>
 #include <stdlib.h>
 #include <stdio.h>
@@ -440,6 +441,48 @@ _Bool m2_cbool_not(_Bool b)
     return !b;
 }
 
+/* C struct-layout audit helpers. */
+typedef struct {
+    int x, y, w, h;
+} M2C_Rect;
+
+typedef struct {
+    float x, y, w, h;
+} M2C_FRect;
+
+typedef struct {
+    float r, g, b, a;
+} M2C_RGBA;
+
+typedef struct {
+    _Bool b;
+    float f;
+    double d;
+    int i;
+    void *p;
+} M2C_Mixed;
+
+long m2_c_layout_rect_size(void) { return (long)sizeof(M2C_Rect); }
+long m2_c_layout_frect_size(void) { return (long)sizeof(M2C_FRect); }
+long m2_c_layout_rgba_size(void) { return (long)sizeof(M2C_RGBA); }
+long m2_c_layout_mixed_size(void) { return (long)sizeof(M2C_Mixed); }
+
+long m2_c_layout_offset(void *base, void *field, int which)
+{
+    const char *b = (const char *)base;
+    const char *f = (const char *)field;
+    long want;
+    switch (which) {
+    case 0: want = offsetof(M2C_Mixed, b); break;
+    case 1: want = offsetof(M2C_Mixed, f); break;
+    case 2: want = offsetof(M2C_Mixed, d); break;
+    case 3: want = offsetof(M2C_Mixed, i); break;
+    case 4: want = offsetof(M2C_Mixed, p); break;
+    default: return 0;
+    }
+    return (long)(f - b) == want;
+}
+
 /* UString length: the codepoint count is the descriptor's header. */
 long m2ustrlen(long *s)
 {