ffi: pass C strings at FOR "C" boundaries

compiler/run_tests.sh

@@ -169,8 +169,6 @@ expect_run t_chain.mod 42
 expect_run t_goto.mod 42
 expect_fail t_gotobad.mod "undeclared identifier"
 expect_run t_under.mod 42
-# Pending C string boundary: t_cstring.mod expects 42 once external
-# ARRAY OF CHAR actuals are converted to NUL-terminated char *.
 expect_run t_with.mod 114
 expect_run t_set.mod 131
 expect_run t_setchar.mod 77
@@ -344,6 +342,8 @@ expect_run_files_out() {
 
 expect_run_files DBasicProg 49 d_basic.def d_basic.mod d_basic_prog.mod
 expect_run_files CForeignProg 42 c_foreign.def c_foreign.mod c_foreign_prog.mod
+expect_run_files TCStringProg 42 t_cstring.def t_cstring_prog.mod
+expect_run_files TCStringQualProg 42 t_cstring.def t_cstring_qual_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

compiler/src/Lower.mod

@@ -1245,12 +1245,46 @@ PROCEDURE CheckSub (t: SymTab.TypeIndex; q: ARRAY OF CHAR);
     END
   END CheckSub;
 
+PROCEDURE AppendArg (val: ARRAY OF CHAR; ft: SymTab.TypeIndex;
+                     isCABI: BOOLEAN; VAR tmp: QbeGen.QVal);
+(* Append one actual to the pending call.  At a C-ABI boundary a CHAR
+   array is passed as a pointer to its payload (descriptor + 8), which
+   is NUL-terminated by the V3 array layout.  Descriptor-ABI external
+   calls (the runtime shim) and internal calls keep the normal
+   descriptor/view argument. *)
+  VAR cl: CHAR;
+  BEGIN
+    IF isCABI THEN
+      QbeGen.CArg(val, ft, tmp, cl)
+    ELSE
+      QbeGen.CopyOp(val, tmp);
+      cl := QbeGen.ArgClass(ft)
+    END;
+    IF NOT QbeGen.CallArg(tmp, cl) THEN END
+  END AppendArg;
+
+PROCEDURE AppendArgL (val: ARRAY OF CHAR; ft: SymTab.TypeIndex;
+                      isCABI: BOOLEAN; VAR tmp: QbeGen.QVal);
+(* Append an address actual (VAR formal or view payload).  The class is
+   always `l`; C ABI char arrays are shifted to their payload first. *)
+  VAR cl: CHAR;
+  BEGIN
+    IF isCABI THEN
+      QbeGen.CArg(val, ft, tmp, cl)
+    ELSE
+      QbeGen.CopyOp(val, tmp);
+      cl := "l"
+    END;
+    IF NOT QbeGen.CallArg(tmp, cl) THEN END
+  END AppendArgL;
+
 PROCEDURE LowerCall (n: AST.Node; VAR t: SymTab.TypeIndex;
                      VAR q: QbeGen.QVal; want: BOOLEAN);
-  VAR nm, pn, cqn: SymTab.Name; i, ai: CARDINAL; at, ft, res: SymTab.TypeIndex;
+  VAR nm, pn, cqn, cm: SymTab.Name;
+      i, ai: CARDINAL; at, ft, res: SymTab.TypeIndex;
       qa, qt, qe, mg, qres, qb, qn: QbeGen.QVal;
-      conv, isV, qual, ind, isC, va: BOOLEAN;
-      uid, depth, np: CARDINAL; ext: BOOLEAN; ck: INTEGER; pi: INTEGER;
+      conv, isV, qual, ind, isC, va, cabi: BOOLEAN;
+      uid, depth, np, md: CARDINAL; ext: BOOLEAN; ck: INTEGER; pi: INTEGER;
       ct: SymTab.TypeIndex; csfx: BOOLEAN; cl: CHAR;
       seq, next, arg: AST.Node;
       vaD, vaB, vaN: ARRAY [0 .. 63] OF QbeGen.QVal;
@@ -1259,6 +1293,7 @@ PROCEDURE LowerCall (n: AST.Node; VAR t: SymTab.TypeIndex;
   BEGIN
     qual := CalleeAlias(n, nm);
     ind := FALSE; isC := FALSE; va := FALSE; pi := -1; ext := FALSE;
+    cabi := FALSE;
     nVa := 0; nFree := 0; kfree := 0;
     IF qual AND qualIsVar THEN
       (* M.Error where Error is a procedure-typed variable: indirect. *)
@@ -1324,6 +1359,15 @@ PROCEDURE LowerCall (n: AST.Node; VAR t: SymTab.TypeIndex;
         END
       END
     END;
+    (* A FOR "C" module exposes a C ABI.  Plain EXTERNAL procedures from
+       ordinary modules (the runtime shim) keep the descriptor ABI. *)
+    IF isC THEN
+      cabi := TRUE
+    ELSIF qual AND SymTab.ProcModuleByUid(qualUid, cm, md) THEN
+      cabi := SymTab.ModForeign(cm)
+    ELSIF SymTab.SymMod(nm, cm) THEN
+      cabi := SymTab.ModForeign(cm)
+    END;
     IF CompositeRes(res) THEN
       (* composite result: pass a hidden destination pointer first *)
       QbeGen.AllocLocal(res, qres);
@@ -1392,7 +1436,7 @@ PROCEDURE LowerCall (n: AST.Node; VAR t: SymTab.TypeIndex;
               END
             ELSIF isOpen1 AND isExtern AND lastView THEN
               QbeGen.ViewToOpen1D(qe, ft, qt, qb, qn);
-              IF NOT QbeGen.CallArg(qt, "l") THEN END;
+              AppendArgL(qt, ft, cabi, qa);
               IF nVa <= HIGH(vaD) THEN
                 QbeGen.CopyOp(qt, vaD[nVa]);
                 QbeGen.CopyOp(qb, vaB[nVa]);
@@ -1405,7 +1449,7 @@ PROCEDURE LowerCall (n: AST.Node; VAR t: SymTab.TypeIndex;
             ELSIF lastView AND (SymTab.ClassOf(ft) = SymTab.ClArray)
                AND (SymTab.ArrayDepth(ft) = 1) THEN
               QbeGen.ViewToOpen1D(qe, ft, qt, qb, qn);
-              IF NOT QbeGen.CallArg(qt, "l") THEN END;
+              AppendArgL(qt, ft, cabi, qa);
               IF nVa <= HIGH(vaD) THEN
                 QbeGen.CopyOp(qt, vaD[nVa]);
                 QbeGen.CopyOp(qb, vaB[nVa]);
@@ -1420,14 +1464,14 @@ PROCEDURE LowerCall (n: AST.Node; VAR t: SymTab.TypeIndex;
                AND (SymTab.ClassOf(SymTab.ArrayElem(ft)) = SymTab.ClChar)
                AND QbeGen.IsImm(qe) THEN
               QbeGen.DeclCharStr(qe, qa);
-              IF NOT QbeGen.CallArg(qa, "l") THEN END
+              AppendArgL(qa, ft, cabi, qt)
             ELSIF SymTab.IsByteBuf(ft)
                AND (SymTab.ClassOf(at) # SymTab.ClArray)
                AND (SymTab.ClassOf(at) # SymTab.ClStr) THEN
               QbeGen.OpenScalarDesc(qe, at, ft, qa);
               IF NOT QbeGen.CallArg(qa, "l") THEN END
             ELSIF QbeGen.AddrOfVal(qe, qa) THEN
-              IF NOT QbeGen.CallArg(qa, "l") THEN END
+              AppendArgL(qa, ft, cabi, qt)
             END
           ELSE
             IF isOpen1 AND NOT isExtern THEN
@@ -1457,7 +1501,7 @@ PROCEDURE LowerCall (n: AST.Node; VAR t: SymTab.TypeIndex;
               IF nFree <= HIGH(freeDesc) THEN
                 QbeGen.CopyOp(qt, freeDesc[nFree]); INC(nFree)
               END;
-              IF NOT QbeGen.CallArg(qe, QbeGen.ArgClass(ft)) THEN END
+              AppendArg(qe, ft, cabi, qa)
             ELSIF lastView AND (SymTab.ClassOf(ft) = SymTab.ClArray)
                AND (SymTab.ArrayDepth(ft) = 1) THEN
               QbeGen.ViewToOpen1D(qe, ft, qt, qb, qn);
@@ -1465,18 +1509,22 @@ PROCEDURE LowerCall (n: AST.Node; VAR t: SymTab.TypeIndex;
               IF nFree <= HIGH(freeDesc) THEN
                 QbeGen.CopyOp(qt, freeDesc[nFree]); INC(nFree)
               END;
-              IF NOT QbeGen.CallArg(qe, QbeGen.ArgClass(ft)) THEN END
+              AppendArg(qe, ft, cabi, qa)
             ELSIF (SymTab.ClassOf(at) = SymTab.ClChar)
                AND (SymTab.ClassOf(ft) = SymTab.ClArray)
                AND (SymTab.ClassOf(SymTab.ArrayElem(ft)) = SymTab.ClChar)
                AND QbeGen.IsImm(qe) THEN
               QbeGen.DeclCharStr(qe, qa);
-              IF NOT QbeGen.CallArg(qa, "l") THEN END
+              AppendArg(qa, ft, cabi, qt)
             ELSIF SymTab.IsByteBuf(ft)
                AND (SymTab.ClassOf(at) # SymTab.ClArray)
                AND (SymTab.ClassOf(at) # SymTab.ClStr) THEN
               QbeGen.OpenScalarDesc(qe, at, ft, qa);
               IF NOT QbeGen.CallArg(qa, "l") THEN END
+            ELSIF cabi
+               AND (SymTab.ClassOf(ft) = SymTab.ClArray)
+               AND SymTab.IsCharArray(ft) THEN
+              AppendArg(qe, ft, cabi, qa)
             ELSE
               IF (SymTab.ClassOf(ft) = SymTab.ClSet)
                  AND (SymTab.ClassOf(at) = SymTab.ClSet)

compiler/src/M2.atg

@@ -192,6 +192,9 @@ VAR
   unitWasDef: BOOLEAN;
   refSeen: BOOLEAN;
   refIsDef: BOOLEAN;
+  (* TRUE for DEFINITION/IMPLEMENTATION MODULE FOR "C"; its procedures
+     use the C ABI at external call boundaries. *)
+  foreignUnit: BOOLEAN;
 
 
 PROCEDURE CopyNm (src: ARRAY OF CHAR; VAR dst: SymTab.Name);
@@ -848,6 +851,7 @@ PRODUCTIONS
                                            END; .) .
   Unit
     =                                   (. isGen := FALSE;
+                                           foreignUnit := FALSE;
                                            allowDefer := FALSE;
                                            allowFwdType := FALSE;
                                            repassing := FALSE; .)
@@ -861,7 +865,8 @@ PRODUCTIONS
                                              astSeq, astTail, astProc: AST.Node; .)
     =                                   (. refN := 0; refSeen := FALSE; .)
       "DEFINITION" "MODULE"
-      [ "FOR" string ]                  (* ISO foreign module: FOR "C" *)
+      [ "FOR" string                     (. foreignUnit := TRUE; .) ]
+                                        (* ISO foreign module: FOR "C" *)
       GetIdent<m1>                      (. IF instActive THEN InstNameGet(m1) END;
                                            IF instActive THEN
                                              IF NOT SymTab.Reenter(m1,
@@ -869,6 +874,8 @@ PRODUCTIONS
                                                SemError(200) END
                                            ELSIF NOT SymTab.BeginDef(m1) THEN
                                              SemError(200) END;
+                                           SymTab.SetModForeign(m1,
+                                             foreignUnit);
                                            QbeGen.SetModule(m1);
                                            CopyNm(m1, unitName);
                                            unitWasGen := isGen
@@ -901,6 +908,10 @@ PRODUCTIONS
                                            AstAppend(AST.NkDeclSeq,
                                              astSeq, astTail, astProc);
                                            Lower.NoteProcNode(astProc);
+                                           IF foreignUnit THEN
+                                             Lower.MarkProcExternal;
+                                             SymTab.MarkExternal("")
+                                           END;
                                            Lower.ScopeLeave;
                                            SymTab.CloseProc;
                                            QbeGen.AbortFunc; .) }
@@ -953,7 +964,8 @@ PRODUCTIONS
                                            hasExcept := FALSE;
                                            hasFinally := FALSE; .)
       "IMPLEMENTATION" "MODULE"
-      [ "FOR" string ]                  (* ISO foreign module: FOR "C" *)
+      [ "FOR" string                     (. foreignUnit := TRUE; .) ]
+                                        (* ISO foreign module: FOR "C" *)
       GetIdent<m1> (. IF instActive THEN InstNameGet(m1) END;
                      IF instActive THEN
                        IF NOT SymTab.Reenter(m1,
@@ -961,6 +973,7 @@ PRODUCTIONS
                          SemError(201) END
                      ELSIF NOT SymTab.BeginImpl(m1) THEN
                        SemError(201) END;
+                     SymTab.SetModForeign(m1, foreignUnit);
                      astStmt := AST.NoNode;
                      astDecl := AST.NoNode;
                      astImp := AST.NoNode;

compiler/src/SymTab.def

@@ -240,6 +240,13 @@ PROCEDURE BeginImpl (name: ARRAY OF CHAR): BOOLEAN;
 (* Resumes a DEFINITION's scope for its IMPLEMENTATION.
    FALSE when the module is undefined or already implemented. *)
 
+PROCEDURE SetModForeign (name: ARRAY OF CHAR; foreign: BOOLEAN);
+(* Marks a module as declared FOR "C"; its procedures use the C ABI at
+   external call boundaries. *)
+
+PROCEDURE ModForeign (name: ARRAY OF CHAR): BOOLEAN;
+(* TRUE when name is a module declared FOR "C". *)
+
 PROCEDURE Reenter (name: ARRAY OF CHAR; kind: INTEGER): BOOLEAN;
 (* Re-enters the scope of an already-registered module (kind is UnitDef
    or UnitImpl) for an instantiation re-parse. *)

compiler/src/SymTab.mod

@@ -166,6 +166,7 @@ VAR
   modScopes : ARRAY [0 .. MaxMods - 1] OF ScopePtr;
   modKind : ARRAY [0 .. MaxMods - 1] OF INTEGER;
   modImpl : ARRAY [0 .. MaxMods - 1] OF BOOLEAN;
+  modForeign : ARRAY [0 .. MaxMods - 1] OF BOOLEAN;
   haveProg : BOOLEAN;
   typeBlockDepth : CARDINAL;  (* > 0 inside a TYPE block *)
   procp    : ARRAY [0 .. MaxPP - 1] OF TypeIndex;  (* proc-type params *)
@@ -2909,6 +2910,7 @@ PROCEDURE NewMod (name: ARRAY OF CHAR; kind: INTEGER): BOOLEAN;
     modScopes[idx] := s;
     modKind[idx] := kind;
     modImpl[idx] := FALSE;
+    modForeign[idx] := FALSE;
     INC(nMods);
     (* the module name lives in the global scope *)
     IF NOT EnterIn(globScope, name, KindModule) THEN
@@ -2925,6 +2927,22 @@ PROCEDURE BeginDef (name: ARRAY OF CHAR): BOOLEAN;
     RETURN NewMod(name, UnitDef)
   END BeginDef;
 
+PROCEDURE SetModForeign (name: ARRAY OF CHAR; foreign: BOOLEAN);
+(* Marks a module as declared FOR "C"; its procedures use the C ABI at
+   external call boundaries. *)
+  VAR idx: INTEGER;
+  BEGIN
+    idx := FindMod(name);
+    IF idx >= 0 THEN modForeign[idx] := foreign END
+  END SetModForeign;
+
+PROCEDURE ModForeign (name: ARRAY OF CHAR): BOOLEAN;
+  VAR idx: INTEGER;
+  BEGIN
+    idx := FindMod(name);
+    RETURN (idx >= 0) AND modForeign[idx]
+  END ModForeign;
+
 PROCEDURE BeginImpl (name: ARRAY OF CHAR): BOOLEAN;
   VAR idx : INTEGER;
   BEGIN

compiler/src/compiler.frm

@@ -900,7 +900,8 @@ MODULE -->Grammar;
           Lower.SetDefUnit(TRUE);
           Lower.LowerUnitNow(GetUnit(), FALSE);
           Lower.SetDefUnit(FALSE)
-        ELSE
+        ELSIF NOT SymTab.ModForeign(uname) THEN
+          (* a FOR "C" interface has no Modula-2 init object *)
           QbeGen.NoteExternalInit(uname)
         END
       ELSE

compiler/tests/t_cstring.def

@@ -0,0 +1,8 @@
+DEFINITION MODULE FOR "C" TCString;
+(* C string boundary test interface: procedures use the C ABI. *)
+EXPORT UNQUALIFIED m2_c_strlen, m2_c_fill;
+
+PROCEDURE m2_c_strlen (s : ARRAY OF CHAR) : CARDINAL;
+PROCEDURE m2_c_fill (VAR buf : ARRAY OF CHAR;
+                     cap : CARDINAL; ch : CHAR) : CARDINAL;
+END TCString.

compiler/tests/t_cstring.mod → compiler/tests/t_cstring_prog.mod

@@ -1,17 +1,13 @@
-MODULE TCString;
+MODULE TCStringProg;
 (* C string boundary regression: an ARRAY OF CHAR actual must arrive at
    a foreign C procedure as a NUL-terminated char *, not as the V3
-   descriptor address.  Expected exit code: 42.
-
-   This test is intentionally pending until the external-call boundary
-   conversion lands; it is not yet wired into run_tests.sh. *)
-PROCEDURE m2_c_strlen (s : ARRAY OF CHAR) : CARDINAL; EXTERNAL;
-PROCEDURE m2_c_fill (VAR buf : ARRAY OF CHAR;
-                     cap : CARDINAL; ch : CHAR) : CARDINAL; EXTERNAL;
+   descriptor address.  Expected exit code: 42. *)
+FROM TCString IMPORT m2_c_strlen, m2_c_fill;
 
 VAR
   ExitCode : INTEGER;
   fixed : ARRAY [0..7] OF CHAR;
+  raw : ARRAY [0..3] OF CHAR;
   out : ARRAY [0..7] OF CHAR;
   n : CARDINAL;
 
@@ -22,9 +18,11 @@ END open_len;
 
 BEGIN
   fixed := "hello";
+  raw[0] := 'a'; raw[1] := 'b'; raw[2] := 'c'; raw[3] := 'd';
   n := m2_c_fill(out, 8, 'x');
   IF (m2_c_strlen("hello") = 5)
      AND (m2_c_strlen(fixed) = 5)
+     AND (m2_c_strlen(raw) = 4)
      AND (open_len("world") = 5)
      AND (n = 7)
      AND (out[0] = 'x')
@@ -34,4 +32,4 @@ BEGIN
   ELSE
     ExitCode := 1
   END
-END TCString.
+END TCStringProg.

compiler/tests/t_cstring_qual_prog.mod

@@ -0,0 +1,17 @@
+MODULE TCStringQualProg;
+(* Qualified C import: the FOR "C" ABI must also apply to M.P calls. *)
+IMPORT TCString;
+
+VAR
+  ExitCode : INTEGER;
+  s : ARRAY [0..7] OF CHAR;
+
+BEGIN
+  s := "hello";
+  IF (TCString.m2_c_strlen("hello") = 5)
+     AND (TCString.m2_c_strlen(s) = 5) THEN
+    ExitCode := 42
+  ELSE
+    ExitCode := 1
+  END
+END TCStringQualProg.

docs/features.md

@@ -30,9 +30,10 @@ Legend: ✅ done · 🔄 partial · ⏸ not started / deferred.
   multi-dimensional formals (`ARRAY OF ARRAY OF …`) use flat payloads
   + per-level views, with row/subarray conversion and open-to-open
   forwarding.  Internal 1-D open formals use pointer-based views (row
-  `ADR` identity preserved); external C boundaries still receive the
-  legacy descriptor.  Record/class fields of rank 2/3 are inline flat
-  payloads with synthesized views; record and array-of-record
+  `ADR` identity preserved); ordinary `EXTERNAL` shims still receive
+  the legacy descriptor, while `MODULE FOR "C"` procedures receive a
+  NUL-terminated payload pointer.  Record/class fields of rank 2/3 are
+  inline flat payloads with synthesized views; record and array-of-record
   constructors support them.
 - ✅ ISO empty string literal: `""`/`''` is compatible with `CHAR`
   (value 0) in assignment, comparison, `CASE` labels, `FOR` bounds,
@@ -79,6 +80,10 @@ Legend: ✅ done · 🔄 partial · ⏸ not started / deferred.
   `ARRAY OF CHAR`, extra arguments untyped, result usable or discarded
   as a statement).  Unknown names keep the permissive no-result varargs
   external.  String/CHAR-array actuals pass as `descriptor+8`.
+- ✅ `DEFINITION`/`IMPLEMENTATION MODULE FOR "C"`: procedures use the
+  C ABI, so `ARRAY OF CHAR` actuals are passed as NUL-terminated
+  payload pointers (`descriptor+8`).  Plain `EXTERNAL` procedures in
+  ordinary modules keep the descriptor ABI used by the runtime shim.
 - ✅ 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