Просмотр исходного кода

language: pointer-based 1-D open views (M6)

Eric Streit 1 день назад
Родитель
Сommit
11c8db2c3a

+ 3 - 0
bootstrap/fixpoint.sh

@@ -22,6 +22,9 @@
 #
 # Usage: bootstrap/fixpoint.sh   (from anywhere)
 set -e
+# Compiler sources are bootstrapped with the legacy 1-D open ABI; user
+# programs built by the resulting compiler use pointer-based views.
+export V3_LEGACY_OPEN1D=1
 
 ROOT=$(cd "$(dirname "$0")/.." && pwd)
 CC_DIR="$ROOT/compiler"

+ 1 - 0
compiler/run_tests.sh

@@ -72,6 +72,7 @@ expect_run t_open2d.mod 42
 expect_run t_open2d_high.mod 42
 expect_run t_open2d_size.mod 42
 expect_run t_open1d_size_adr.mod 42
+expect_run t_open_row_adr.mod 42
 expect_run t_record_multidim.mod 42
 expect_run t_record_multidim_ctor.mod 42
 expect_run t_record_multidim_const.mod 42

+ 2 - 0
compiler/src/Lower.def

@@ -14,6 +14,8 @@ DEFINITION MODULE Lower;
 IMPORT AST, SymTab, QbeGen;
 
 PROCEDURE BeginSession (progName: ARRAY OF CHAR);
+PROCEDURE SetLegacyOpen1D;
+(* Bootstrap compatibility: use legacy {count,data} 1-D open ABI. *)
 PROCEDURE BeginUnit;
 PROCEDURE LowerUnitNow (unit: AST.Node; isProg: BOOLEAN);
 PROCEDURE EndSession;

+ 92 - 32
compiler/src/Lower.mod

@@ -59,6 +59,7 @@ VAR
   (* GOTO/labels: user label name -> QbeGen label, per procedure. *)
   nUserLab : CARDINAL;
   lastView : BOOLEAN;   (* last LowerDesign result is a multi-array view *)
+  legacyOpen1D : BOOLEAN; (* bootstrap: keep the legacy 1-D open ABI *)
   userLabNm : ARRAY [0 .. 255 * 64 - 1] OF CHAR;
   userLabQ : ARRAY [0 .. 255] OF QbeGen.QVal;
   (* Scoping: each symbol records the procedure that owns it (-1 =
@@ -1166,7 +1167,8 @@ PROCEDURE LowerDesign (n: AST.Node; VAR t: SymTab.TypeIndex; VAR k: INTEGER;
           END;
           QbeGen.CheckIndex(ql, qlo, qhi);
           eT := SymTab.ArrayElem(t);
-          IF viewMode THEN
+          IF viewMode OR ((NOT legacyOpen1D) AND isOpen
+                          AND (SymTab.ArrayDepth(t) = 1)) THEN
             QbeGen.ViewIndex(q, ql, qlo,
               SymTab.ClassOf(eT) = SymTab.ClArray, qe);
             QbeGen.CopyOp(qe, q)
@@ -1190,8 +1192,10 @@ PROCEDURE LowerDesign (n: AST.Node; VAR t: SymTab.TypeIndex; VAR k: INTEGER;
       END;
       INC(i)
     END;
-    lastView := viewMode AND (t # SymTab.InvalidType)
+    lastView := (t # SymTab.InvalidType)
                 AND (SymTab.ClassOf(t) = SymTab.ClArray)
+                AND (viewMode OR ((NOT legacyOpen1D)
+                                  AND SymTab.IsOpenArray(t)))
   END LowerDesign;
 
 PROCEDURE CompositeRes (t: SymTab.TypeIndex): BOOLEAN;
@@ -1249,7 +1253,7 @@ PROCEDURE LowerCall (n: AST.Node; VAR t: SymTab.TypeIndex;
       seq, next, arg: AST.Node;
       vaD, vaB, vaN: ARRAY [0 .. 63] OF QbeGen.QVal;
       freeDesc: ARRAY [0 .. 127] OF QbeGen.QVal;
-      nVa, nFree, kva, kfree: CARDINAL;
+      nVa, nFree, kva, kfree: CARDINAL; isOpen1, isExtern: BOOLEAN;
   BEGIN
     qual := CalleeAlias(n, nm);
     ind := FALSE; isC := FALSE; va := FALSE; pi := -1; ext := FALSE;
@@ -1353,15 +1357,51 @@ PROCEDURE LowerCall (n: AST.Node; VAR t: SymTab.TypeIndex;
             QbeGen.CopyOp("0", qe); at := SymTab.CharType()
           END;
           IF (NOT va) AND (NOT isV) THEN CheckSub(ft, qe) END;
+          isOpen1 := (NOT legacyOpen1D)
+                     AND (ft # SymTab.InvalidType)
+                     AND (SymTab.ClassOf(ft) = SymTab.ClArray)
+                     AND (SymTab.ArrayDepth(ft) = 1)
+                     AND SymTab.IsOpenArray(ft);
+          isExtern := ext OR isC;
           IF va THEN
             (* permissive C variadic argument *)
             QbeGen.CArgAdd(qe, at, qa, cl)
           ELSIF isV THEN
-            IF lastView AND (SymTab.ClassOf(ft) = SymTab.ClArray)
+            IF isOpen1 AND NOT isExtern THEN
+              IF lastView OR (SymTab.ClassOf(at) = SymTab.ClArray)
+                 OR (SymTab.ClassOf(at) = SymTab.ClStr)
+                 OR (SymTab.ClassOf(at) = SymTab.ClUStr) THEN
+                QbeGen.MakeOpen1DView(qe, at, ft, lastView, qt);
+                IF NOT QbeGen.CallArg(qt, "l") THEN END
+              ELSIF (SymTab.ClassOf(at) = SymTab.ClChar)
+                 AND (SymTab.ClassOf(SymTab.ArrayElem(ft)) = SymTab.ClChar)
+                 AND QbeGen.IsImm(qe) THEN
+                QbeGen.DeclCharStr(qe, qa);
+                QbeGen.MakeOpen1DView(qa, at, ft, FALSE, qt);
+                IF NOT QbeGen.CallArg(qt, "l") THEN END
+              ELSIF SymTab.IsByteBuf(ft)
+                 AND (SymTab.ClassOf(at) # SymTab.ClArray)
+                 AND (SymTab.ClassOf(at) # SymTab.ClStr) THEN
+                QbeGen.OpenScalarDesc(qe, at, ft, qa);
+                QbeGen.MakeOpen1DView(qa, at, ft, FALSE, qt);
+                IF NOT QbeGen.CallArg(qt, "l") THEN END
+              ELSIF QbeGen.AddrOfVal(qe, qa) THEN
+                IF NOT QbeGen.CallArg(qa, "l") THEN END
+              END
+            ELSIF isOpen1 AND isExtern AND lastView THEN
+              QbeGen.ViewToOpen1D(qe, ft, qt, qb, qn);
+              IF NOT QbeGen.CallArg(qt, "l") THEN END;
+              IF nVa <= HIGH(vaD) THEN
+                QbeGen.CopyOp(qt, vaD[nVa]);
+                QbeGen.CopyOp(qb, vaB[nVa]);
+                QbeGen.CopyOp(qn, vaN[nVa]);
+                INC(nVa)
+              END;
+              IF nFree <= HIGH(freeDesc) THEN
+                QbeGen.CopyOp(qt, freeDesc[nFree]); INC(nFree)
+              END
+            ELSIF lastView AND (SymTab.ClassOf(ft) = SymTab.ClArray)
                AND (SymTab.ArrayDepth(ft) = 1) THEN
-              (* Row/multi view actual for a VAR 1-D open formal:
-                 materialise a legacy {count, data} descriptor, pass it,
-                 then copy its payload back after the call. *)
               QbeGen.ViewToOpen1D(qe, ft, qt, qb, qn);
               IF NOT QbeGen.CallArg(qt, "l") THEN END;
               IF nVa <= HIGH(vaD) THEN
@@ -1377,52 +1417,65 @@ PROCEDURE LowerCall (n: AST.Node; VAR t: SymTab.TypeIndex;
                AND (SymTab.ClassOf(ft) = SymTab.ClArray)
                AND (SymTab.ClassOf(SymTab.ArrayElem(ft)) = SymTab.ClChar)
                AND QbeGen.IsImm(qe) THEN
-              (* 1-char string literal passed to a VAR ARRAY OF CHAR:
-                 pass its static descriptor *)
               QbeGen.DeclCharStr(qe, qa);
               IF NOT QbeGen.CallArg(qa, "l") THEN END
             ELSIF SymTab.IsByteBuf(ft)
                AND (SymTab.ClassOf(at) # SymTab.ClArray)
                AND (SymTab.ClassOf(at) # SymTab.ClStr) THEN
-              (* gm2 ext: wrap the scalar actual as a stack byte-buffer
-                 descriptor (count = SIZE(actual), payload = a copy) *)
               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
             END
           ELSE
-            IF (SymTab.ClassOf(at) = SymTab.ClChar)
+            IF isOpen1 AND NOT isExtern THEN
+              IF lastView OR (SymTab.ClassOf(at) = SymTab.ClArray)
+                 OR (SymTab.ClassOf(at) = SymTab.ClStr)
+                 OR (SymTab.ClassOf(at) = SymTab.ClUStr) THEN
+                QbeGen.MakeOpen1DView(qe, at, ft, lastView, qt);
+                IF NOT QbeGen.CallArg(qt, "l") THEN END
+              ELSIF (SymTab.ClassOf(at) = SymTab.ClChar)
+                 AND (SymTab.ClassOf(SymTab.ArrayElem(ft)) = SymTab.ClChar)
+                 AND QbeGen.IsImm(qe) THEN
+                QbeGen.DeclCharStr(qe, qa);
+                QbeGen.MakeOpen1DView(qa, at, ft, FALSE, qt);
+                IF NOT QbeGen.CallArg(qt, "l") THEN END
+              ELSIF SymTab.IsByteBuf(ft)
+                 AND (SymTab.ClassOf(at) # SymTab.ClArray)
+                 AND (SymTab.ClassOf(at) # SymTab.ClStr) THEN
+                QbeGen.OpenScalarDesc(qe, at, ft, qa);
+                QbeGen.MakeOpen1DView(qa, at, ft, FALSE, qt);
+                IF NOT QbeGen.CallArg(qt, "l") THEN END
+              ELSE
+                IF NOT QbeGen.CallArg(qe, QbeGen.ArgClass(ft)) THEN END
+              END
+            ELSIF isOpen1 AND isExtern AND lastView THEN
+              QbeGen.ViewToOpen1D(qe, ft, qt, qb, qn);
+              QbeGen.CopyOp(qt, qe);
+              IF nFree <= HIGH(freeDesc) THEN
+                QbeGen.CopyOp(qt, freeDesc[nFree]); INC(nFree)
+              END;
+              IF NOT QbeGen.CallArg(qe, QbeGen.ArgClass(ft)) THEN END
+            ELSIF lastView AND (SymTab.ClassOf(ft) = SymTab.ClArray)
+               AND (SymTab.ArrayDepth(ft) = 1) THEN
+              QbeGen.ViewToOpen1D(qe, ft, qt, qb, qn);
+              QbeGen.CopyOp(qt, qe);
+              IF nFree <= HIGH(freeDesc) THEN
+                QbeGen.CopyOp(qt, freeDesc[nFree]); INC(nFree)
+              END;
+              IF NOT QbeGen.CallArg(qe, QbeGen.ArgClass(ft)) THEN END
+            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
-              (* 1-char string literal passed to ARRAY OF CHAR: pass its
-                 static descriptor, not the char code *)
               QbeGen.DeclCharStr(qe, qa);
               IF NOT QbeGen.CallArg(qa, "l") THEN END
             ELSIF SymTab.IsByteBuf(ft)
                AND (SymTab.ClassOf(at) # SymTab.ClArray)
                AND (SymTab.ClassOf(at) # SymTab.ClStr) THEN
-              (* gm2 ext: wrap the scalar actual as a stack byte-buffer
-                 descriptor (count = SIZE(actual), payload = a copy) *)
               QbeGen.OpenScalarDesc(qe, at, ft, qa);
               IF NOT QbeGen.CallArg(qa, "l") THEN END
             ELSE
-              (* A rank-1/row view actual is adapted to the legacy 1-D
-                 descriptor by a payload copy.  VAR formals use the
-                 copy-in/copy-back path above; M3 replaces both with
-                 real view descriptors. *)
-              IF lastView AND (SymTab.ClassOf(ft) = SymTab.ClArray)
-                 AND (SymTab.ArrayDepth(ft) = 1) THEN
-                QbeGen.ViewToOpen1D(qe, ft, qt, qb, qn);
-                QbeGen.CopyOp(qt, qe);
-                IF nFree <= HIGH(freeDesc) THEN
-                  QbeGen.CopyOp(qt, freeDesc[nFree]); INC(nFree)
-                END
-              END;
-              (* A SET/PACKEDSET value actual with a different
-                 representation is converted to a temporary of the
-                 formal type before the call. *)
               IF (SymTab.ClassOf(ft) = SymTab.ClSet)
                  AND (SymTab.ClassOf(at) = SymTab.ClSet)
                  AND (SymTab.IsPackedSet(ft) # SymTab.IsPackedSet(at)) THEN
@@ -1689,7 +1742,9 @@ PROCEDURE LowerBuiltinExpr (n: AST.Node; nm: SymTab.Name;
       ELSIF (dt # SymTab.InvalidType)
          AND (SymTab.ClassOf(dt) = SymTab.ClArray)
          AND SymTab.IsOpenArray(dt) AND (NOT sfx) THEN
-        QbeGen.DescData(qd, q)
+        IF legacyOpen1D THEN QbeGen.DescData(qd, q)
+        ELSE QbeGen.ViewBase(qd, q)
+        END
       ELSIF sfx THEN QbeGen.CopyOp(qd, q)
       ELSIF (k = SymTab.KindVar) OR (k = SymTab.KindParam) THEN
         QbeGen.AddrOf(qn, q)
@@ -3037,6 +3092,11 @@ PROCEDURE LowerOneUnit (u: AST.Node; isProg: BOOLEAN);
     END
   END LowerOneUnit;
 
+PROCEDURE SetLegacyOpen1D;
+  BEGIN
+    legacyOpen1D := TRUE
+  END SetLegacyOpen1D;
+
 PROCEDURE BeginSession (progName: ARRAY OF CHAR);
 (* Per-unit Lower emission.  The grammar still runs its inline emit while
    parsing, but under NoEmit it only mutates QbeGen's counters (nothing

+ 6 - 0
compiler/src/QbeGen.def

@@ -386,6 +386,12 @@ PROCEDURE ViewCopyBack (desc, base, nbytes: ARRAY OF CHAR);
 PROCEDURE ViewFree (desc: ARRAY OF CHAR);
 (* Release a descriptor allocated by ViewToOpen1D. *)
 
+PROCEDURE MakeOpen1DView (src: ARRAY OF CHAR; at, ft: INTEGER;
+                          srcIsView: BOOLEAN; VAR q: QVal);
+(* Build a 1-D ArrayView for an open ARRAY OF formal.  src is either a
+   view (row/multi/open 1-D) or a legacy {count,data} descriptor.  A
+   BYTE/SBYTE formal flattens the payload to its total byte count. *)
+
 PROCEDURE MakeFieldView (addr: ARRAY OF CHAR; t: INTEGER; VAR q: QVal);
 (* Synthesize the view-chain for a rank-2/3 array stored inline in a
    record field.  The outer base is addr; lower levels are templates. *)

+ 58 - 0
compiler/src/QbeGen.mod

@@ -3390,6 +3390,64 @@ PROCEDURE ViewIndex (view, idx, lo: ARRAY OF CHAR;
     END
   END ViewIndex;
 
+PROCEDURE MakeOpen1DView (src: ARRAY OF CHAR; at, ft: INTEGER;
+                          srcIsView: BOOLEAN; VAR q: QVal);
+  VAR cnt, esz, st, base, nv, total, x: QVal;
+    byteFormal: BOOLEAN;
+  BEGIN
+    byteFormal := SymTab.IsByteBuf(ft);
+    IF srcIsView THEN
+      IF byteFormal THEN
+        ViewField(src, 0, cnt);
+        ViewField(src, 8, esz);
+        NewTemp(total); Op3L("mul", total, cnt, esz);
+        CopyOp(total, cnt);
+        NewTemp(esz); CopyOp("1", esz);
+        NewTemp(st); CopyOp("1", st)
+      ELSIF SymTab.IsOpenArray(at) AND (SymTab.ArrayDepth(at) = 1) THEN
+        CopyOp(src, q); RETURN
+      ELSE
+        ViewField(src, 0, cnt);
+        ViewField(src, 8, esz);
+        ViewField(src, 16, st)
+      END;
+      ViewField(src, 24, base)
+    ELSE
+      NewTemp(cnt);
+      W("  "); W(cnt); W(" =l loadl "); WL(src);
+      IF byteFormal THEN
+        IF SymTab.ClassOf(at) = SymTab.ClArray THEN
+          IntStr(VAL(INTEGER, SymTab.ArrayLeafBytes(at)), esz)
+        ELSIF SymTab.ClassOf(at) = SymTab.ClUStr THEN CopyOp("4", esz)
+        ELSE CopyOp("1", esz) END;
+        NewTemp(total); Op3L("mul", total, cnt, esz);
+        CopyOp(total, cnt);
+        NewTemp(esz); CopyOp("1", esz);
+        NewTemp(st); CopyOp("1", st)
+      ELSE
+        IF SymTab.ClassOf(at) = SymTab.ClArray THEN
+          IntStr(VAL(INTEGER, SymTab.ArrayLeafBytes(at)), esz)
+        ELSIF SymTab.ClassOf(at) = SymTab.ClUStr THEN CopyOp("4", esz)
+        ELSE CopyOp("1", esz) END;
+        NewTemp(st); CopyOp(esz, st)
+      END;
+      NewTemp(base); Op3L("add", base, src, "8")
+    END;
+    NewTemp(nv);
+    Revive;
+    W("  "); W(nv); WL(" =l alloc8 40");
+    Revive; W("  storel "); W(cnt); W(", "); WL(nv);
+    NewTemp(x); Op3L("add", x, nv, "8");
+    Revive; W("  storel "); W(esz); W(", "); WL(x);
+    NewTemp(x); Op3L("add", x, nv, "16");
+    Revive; W("  storel "); W(st); W(", "); WL(x);
+    NewTemp(x); Op3L("add", x, nv, "24");
+    Revive; W("  storel "); W(base); W(", "); WL(x);
+    NewTemp(x); Op3L("add", x, nv, "32");
+    Revive; W("  storel 0, "); WL(x);
+    CopyOp(nv, q)
+  END MakeOpen1DView;
+
 PROCEDURE MakeFieldView (addr: ARRAY OF CHAR; t: INTEGER; VAR q: QVal);
   VAR rank, k, count, stride: CARDINAL;
     cur: SymTab.TypeIndex;

+ 7 - 0
compiler/src/compiler.frm

@@ -288,6 +288,7 @@ MODULE -->Grammar;
   VAR
     sourceName, listName, progName: ARRAY [0 .. 255] OF CHAR;
     files: ARRAY [0 .. 127] OF ARRAY [0 .. 255] OF CHAR;
+    bootstrapEnv: ARRAY [0 .. 31] OF CHAR;
     nFiles: CARDINAL;
     f: CARDINAL;
     bad: BOOLEAN;
@@ -423,6 +424,10 @@ MODULE -->Grammar;
   END DoInst;
 
   BEGIN
+    (* Bootstrap compatibility: compiler units may use the legacy 1-D
+       open ABI while user programs use pointer-based views. *)
+    FileIO.GetEnv("V3_LEGACY_OPEN1D", bootstrapEnv);
+    IF bootstrapEnv[0] = "1" THEN Lower.SetLegacyOpen1D END;
     (* collect the session's source files (program module last) *)
     nFiles := 0;
     doTwoPhase := TRUE;   (* two-phase parse on by default (-notwophase off) *)
@@ -431,6 +436,8 @@ MODULE -->Grammar;
       IF (sourceName[0] = CHR(0)) OR (nFiles > HIGH(files)) THEN EXIT END;
       IF EqNm(sourceName, "-notwophase") THEN
         doTwoPhase := FALSE
+      ELSIF EqNm(sourceName, "-legacyopen1d") THEN
+        Lower.SetLegacyOpen1D
       ELSE
         Strings.Assign(sourceName, files[nFiles]);
         INC(nFiles)

+ 26 - 0
compiler/tests/t_open_row_adr.mod

@@ -0,0 +1,26 @@
+MODULE TOpenRowAdr;
+(* M6: row view passed to a 1-D open formal preserves ADR identity. *)
+FROM SYSTEM IMPORT ADDRESS, ADR;
+CONST N = 3;
+TYPE Vector = ARRAY [1..N] OF REAL;
+     Matrix = ARRAY [1..N] OF Vector;
+VAR ExitCode : INTEGER;
+    m : Matrix;
+    expect : ADDRESS;
+
+PROCEDURE Inner (VAR a : ARRAY OF REAL);
+BEGIN
+  IF ADR(a) # expect THEN ExitCode := 1 END
+END Inner;
+
+PROCEDURE Outer (VAR a : ARRAY OF ARRAY OF REAL);
+BEGIN
+  expect := ADR(a[0]);
+  Inner(a[0])
+END Outer;
+
+BEGIN
+  expect := ADR(m);
+  Outer(m);
+  IF ExitCode = 0 THEN ExitCode := 42 END
+END TOpenRowAdr.

+ 4 - 0
runtime/syslib/FileIO.def

@@ -51,4 +51,8 @@ PROCEDURE Concat (stringVal1, stringVal2: ARRAY OF CHAR;
                   VAR destination: ARRAY OF CHAR);
 PROCEDURE Compare (stringVal1, stringVal2: ARRAY OF CHAR): INTEGER;
 
+PROCEDURE GetEnv (envVar: ARRAY OF CHAR; VAR s: ARRAY OF CHAR);
+(* Returns s as the value of environment variable envVar, or empty string
+   if that variable is not defined. *)
+
 END FileIO.

+ 7 - 0
runtime/syslib/FileIO.mod

@@ -126,6 +126,13 @@ BEGIN
   RETURN 0
 END Compare;
 
+PROCEDURE GetEnv (envVar: ARRAY OF CHAR; VAR s: ARRAY OF CHAR);
+BEGIN
+  IF NOT SysShim.getenv(envVar, s, LEN(s)) THEN
+    s[0] := CHR(0)
+  END
+END GetEnv;
+
 BEGIN
   (* Arguments exclude argv[0] (the program name), matching the gm2
      host FileIO: user arguments start at cmdline index 1. *)

+ 6 - 0
runtime/syslib/SysShim.def

@@ -50,4 +50,10 @@ PROCEDURE arg (i : CARDINAL; VAR s : ARRAY OF CHAR;
 (* Copies command-line argument i into s (capacity cap); FALSE when
    no such argument. *)
 
+PROCEDURE getenv (VAR name : ARRAY OF CHAR; VAR value : ARRAY OF CHAR;
+                  cap : CARDINAL) : BOOLEAN;
+(* Copies environment variable name's value into value; FALSE if unset. *)
+(* Copies command-line argument i into s (capacity cap); FALSE when
+   no such argument. *)
+
 END SysShim.

+ 9 - 0
runtime/syslib/SysShim.mod

@@ -44,6 +44,9 @@ PROCEDURE m2argc () : CARDINAL;
 PROCEDURE m2arg (i : CARDINAL; VAR s : ARRAY OF CHAR;
                  cap : CARDINAL) : BOOLEAN;
   EXTERNAL;
+PROCEDURE m2getenv (VAR name : ARRAY OF CHAR; VAR value : ARRAY OF CHAR;
+                    cap : CARDINAL) : BOOLEAN;
+  EXTERNAL;
 
 PROCEDURE fopenread (VAR name : ARRAY OF CHAR) : ADDRESS;
 BEGIN
@@ -143,4 +146,10 @@ BEGIN
   RETURN m2arg(i, s, cap)
 END arg;
 
+PROCEDURE getenv (VAR name : ARRAY OF CHAR; VAR value : ARRAY OF CHAR;
+                  cap : CARDINAL) : BOOLEAN;
+BEGIN
+  RETURN m2getenv(name, value, cap)
+END getenv;
+
 END SysShim.

+ 19 - 0
runtime/syslib/shim.c

@@ -277,6 +277,25 @@ long m2arg(long i, long *desc, long cap)
     return 1;
 }
 
+
+/* Copy an environment variable's value into a descriptor. */
+long m2getenv(long *name, long *desc, long cap)
+{
+    const char *v = getenv((char *)(name + 1));
+    long n;
+
+    if (v == NULL) {
+        if (cap > 0) ((char *)(desc + 1))[0] = 0;
+        return 0;
+    }
+    n = (long)strlen(v);
+    if (cap > 0 && n >= cap) n = cap - 1;
+    if (n < 0) n = 0;
+    memcpy((char *)(desc + 1), v, (size_t)n);
+    if (n < cap) ((char *)(desc + 1))[n] = 0;
+    return 1;
+}
+
 /* Set a string descriptor's logical length (header). */
 long m2setlen(long *desc, long n)
 {

+ 16 - 1
tools/m2make/M2make.mod

@@ -49,6 +49,7 @@ VAR
   dryRun, verbose, useGm2: BOOLEAN;
   outGiven: BOOLEAN;
   mainPath, outName, m2bin, shimPath: Path;
+  m2Flags: Cmd;
   extraC: Path;  (* extra C file linked in m2 mode (may be empty) *)
   nDirs: CARDINAL;
   progName: Name;
@@ -281,7 +282,8 @@ END Die;
 PROCEDURE Usage;
 BEGIN
   Out("Usage: M2make [-n] [-v] [-c m2|gm2] [-I dir] [-o out]"); OutLn;
-  Out("       [--m2bin path] [--shim path] [--extra path] main.mod"); OutLn
+  Out("       [--m2bin path] [--shim path] [--extra path]
+       [--m2flag flag] main.mod"); OutLn
 END Usage;
 
 (* ---------------- module table ---------------- *)
@@ -788,6 +790,10 @@ BEGIN
   Zero(cmd);
   AppendSeg(cmd, "mkdir -p gen_ssa && ");
   AppendSeg(cmd, m2bin);
+  IF Len(m2Flags) > 0 THEN
+    AppendSeg(cmd, " ");
+    AppendSeg(cmd, m2Flags)
+  END;
   k := 0;
   WHILE k < nOrder DO
     m := order[k];
@@ -961,6 +967,7 @@ BEGIN
   Zero(outName);
   Copy("M2", m2bin);
   Copy("shim.c", shimPath);
+  Zero(m2Flags);
   nDirs := 0;
   na := 0;
   LOOP
@@ -1019,6 +1026,14 @@ BEGIN
       END;
       INC(na);
       Copy(s, shimPath)
+    ELSIF Cmp(s, "--m2flag") = 0 THEN
+      ok := M2makeOS.GetArg(na, s, HIGH(s) + 1);
+      IF NOT ok THEN
+        Out("M2make: --m2flag expects an argument"); OutLn;
+        M2makeOS.ExitNow(2)
+      END;
+      INC(na);
+      Copy(s, m2Flags)
     ELSIF Cmp(s, "--extra") = 0 THEN
       ok := M2makeOS.GetArg(na, s, HIGH(s) + 1);
       IF NOT ok THEN

+ 4 - 1
tools/m2make/README.md

@@ -9,7 +9,8 @@ to do), 1 build failure (incl. import cycles), 2 usage error.
 
 ```sh
 M2make [-n] [-v] [-c m2|gm2] [-I dir] [-o out]
-       [--m2bin path] [--shim path] [--extra path] main.mod
+       [--m2bin path] [--shim path] [--extra path]
+       [--m2flag flag] main.mod
 ```
 
 - `-n`: dry run (print the build order and the command only).
@@ -23,6 +24,8 @@ M2make [-n] [-v] [-c m2|gm2] [-I dir] [-o out]
 - `--shim path`: C runtime shim for `m2` mode (default `shim.c`).
 - `--extra path`: extra C file linked in `m2` mode (after the shim;
   e.g. a tool's own `m2make_os.c`).
+- `--m2flag flag`: pass one argument to the M2 driver before the source
+  list (used by the bootstrap fixpoint for `-legacyopen1d`).
 
 `m2` mode runs one session — `<m2bin> <ordered .def/.mod files>`
 then `qbe` then `cc <image>.s <shim> [<extra>] -o <out> -lm` — and