Procházet zdrojové kódy

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

Eric Streit před 1 dnem
rodič
revize
11c8db2c3a

+ 3 - 0
bootstrap/fixpoint.sh

@@ -22,6 +22,9 @@
 #
 #
 # Usage: bootstrap/fixpoint.sh   (from anywhere)
 # Usage: bootstrap/fixpoint.sh   (from anywhere)
 set -e
 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)
 ROOT=$(cd "$(dirname "$0")/.." && pwd)
 CC_DIR="$ROOT/compiler"
 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_high.mod 42
 expect_run t_open2d_size.mod 42
 expect_run t_open2d_size.mod 42
 expect_run t_open1d_size_adr.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.mod 42
 expect_run t_record_multidim_ctor.mod 42
 expect_run t_record_multidim_ctor.mod 42
 expect_run t_record_multidim_const.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;
 IMPORT AST, SymTab, QbeGen;
 
 
 PROCEDURE BeginSession (progName: ARRAY OF CHAR);
 PROCEDURE BeginSession (progName: ARRAY OF CHAR);
+PROCEDURE SetLegacyOpen1D;
+(* Bootstrap compatibility: use legacy {count,data} 1-D open ABI. *)
 PROCEDURE BeginUnit;
 PROCEDURE BeginUnit;
 PROCEDURE LowerUnitNow (unit: AST.Node; isProg: BOOLEAN);
 PROCEDURE LowerUnitNow (unit: AST.Node; isProg: BOOLEAN);
 PROCEDURE EndSession;
 PROCEDURE EndSession;

+ 92 - 32
compiler/src/Lower.mod

@@ -59,6 +59,7 @@ VAR
   (* GOTO/labels: user label name -> QbeGen label, per procedure. *)
   (* GOTO/labels: user label name -> QbeGen label, per procedure. *)
   nUserLab : CARDINAL;
   nUserLab : CARDINAL;
   lastView : BOOLEAN;   (* last LowerDesign result is a multi-array view *)
   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;
   userLabNm : ARRAY [0 .. 255 * 64 - 1] OF CHAR;
   userLabQ : ARRAY [0 .. 255] OF QbeGen.QVal;
   userLabQ : ARRAY [0 .. 255] OF QbeGen.QVal;
   (* Scoping: each symbol records the procedure that owns it (-1 =
   (* 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;
           END;
           QbeGen.CheckIndex(ql, qlo, qhi);
           QbeGen.CheckIndex(ql, qlo, qhi);
           eT := SymTab.ArrayElem(t);
           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,
             QbeGen.ViewIndex(q, ql, qlo,
               SymTab.ClassOf(eT) = SymTab.ClArray, qe);
               SymTab.ClassOf(eT) = SymTab.ClArray, qe);
             QbeGen.CopyOp(qe, q)
             QbeGen.CopyOp(qe, q)
@@ -1190,8 +1192,10 @@ PROCEDURE LowerDesign (n: AST.Node; VAR t: SymTab.TypeIndex; VAR k: INTEGER;
       END;
       END;
       INC(i)
       INC(i)
     END;
     END;
-    lastView := viewMode AND (t # SymTab.InvalidType)
+    lastView := (t # SymTab.InvalidType)
                 AND (SymTab.ClassOf(t) = SymTab.ClArray)
                 AND (SymTab.ClassOf(t) = SymTab.ClArray)
+                AND (viewMode OR ((NOT legacyOpen1D)
+                                  AND SymTab.IsOpenArray(t)))
   END LowerDesign;
   END LowerDesign;
 
 
 PROCEDURE CompositeRes (t: SymTab.TypeIndex): BOOLEAN;
 PROCEDURE CompositeRes (t: SymTab.TypeIndex): BOOLEAN;
@@ -1249,7 +1253,7 @@ PROCEDURE LowerCall (n: AST.Node; VAR t: SymTab.TypeIndex;
       seq, next, arg: AST.Node;
       seq, next, arg: AST.Node;
       vaD, vaB, vaN: ARRAY [0 .. 63] OF QbeGen.QVal;
       vaD, vaB, vaN: ARRAY [0 .. 63] OF QbeGen.QVal;
       freeDesc: ARRAY [0 .. 127] OF QbeGen.QVal;
       freeDesc: ARRAY [0 .. 127] OF QbeGen.QVal;
-      nVa, nFree, kva, kfree: CARDINAL;
+      nVa, nFree, kva, kfree: CARDINAL; isOpen1, isExtern: BOOLEAN;
   BEGIN
   BEGIN
     qual := CalleeAlias(n, nm);
     qual := CalleeAlias(n, nm);
     ind := FALSE; isC := FALSE; va := FALSE; pi := -1; ext := FALSE;
     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()
             QbeGen.CopyOp("0", qe); at := SymTab.CharType()
           END;
           END;
           IF (NOT va) AND (NOT isV) THEN CheckSub(ft, qe) 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
           IF va THEN
             (* permissive C variadic argument *)
             (* permissive C variadic argument *)
             QbeGen.CArgAdd(qe, at, qa, cl)
             QbeGen.CArgAdd(qe, at, qa, cl)
           ELSIF isV THEN
           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
                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);
               QbeGen.ViewToOpen1D(qe, ft, qt, qb, qn);
               IF NOT QbeGen.CallArg(qt, "l") THEN END;
               IF NOT QbeGen.CallArg(qt, "l") THEN END;
               IF nVa <= HIGH(vaD) THEN
               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(ft) = SymTab.ClArray)
                AND (SymTab.ClassOf(SymTab.ArrayElem(ft)) = SymTab.ClChar)
                AND (SymTab.ClassOf(SymTab.ArrayElem(ft)) = SymTab.ClChar)
                AND QbeGen.IsImm(qe) THEN
                AND QbeGen.IsImm(qe) THEN
-              (* 1-char string literal passed to a VAR ARRAY OF CHAR:
-                 pass its static descriptor *)
               QbeGen.DeclCharStr(qe, qa);
               QbeGen.DeclCharStr(qe, qa);
               IF NOT QbeGen.CallArg(qa, "l") THEN END
               IF NOT QbeGen.CallArg(qa, "l") THEN END
             ELSIF SymTab.IsByteBuf(ft)
             ELSIF SymTab.IsByteBuf(ft)
                AND (SymTab.ClassOf(at) # SymTab.ClArray)
                AND (SymTab.ClassOf(at) # SymTab.ClArray)
                AND (SymTab.ClassOf(at) # SymTab.ClStr) THEN
                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);
               QbeGen.OpenScalarDesc(qe, at, ft, qa);
               IF NOT QbeGen.CallArg(qa, "l") THEN END
               IF NOT QbeGen.CallArg(qa, "l") THEN END
             ELSIF QbeGen.AddrOfVal(qe, qa) THEN
             ELSIF QbeGen.AddrOfVal(qe, qa) THEN
               IF NOT QbeGen.CallArg(qa, "l") THEN END
               IF NOT QbeGen.CallArg(qa, "l") THEN END
             END
             END
           ELSE
           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(ft) = SymTab.ClArray)
                AND (SymTab.ClassOf(SymTab.ArrayElem(ft)) = SymTab.ClChar)
                AND (SymTab.ClassOf(SymTab.ArrayElem(ft)) = SymTab.ClChar)
                AND QbeGen.IsImm(qe) THEN
                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);
               QbeGen.DeclCharStr(qe, qa);
               IF NOT QbeGen.CallArg(qa, "l") THEN END
               IF NOT QbeGen.CallArg(qa, "l") THEN END
             ELSIF SymTab.IsByteBuf(ft)
             ELSIF SymTab.IsByteBuf(ft)
                AND (SymTab.ClassOf(at) # SymTab.ClArray)
                AND (SymTab.ClassOf(at) # SymTab.ClArray)
                AND (SymTab.ClassOf(at) # SymTab.ClStr) THEN
                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);
               QbeGen.OpenScalarDesc(qe, at, ft, qa);
               IF NOT QbeGen.CallArg(qa, "l") THEN END
               IF NOT QbeGen.CallArg(qa, "l") THEN END
             ELSE
             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)
               IF (SymTab.ClassOf(ft) = SymTab.ClSet)
                  AND (SymTab.ClassOf(at) = SymTab.ClSet)
                  AND (SymTab.ClassOf(at) = SymTab.ClSet)
                  AND (SymTab.IsPackedSet(ft) # SymTab.IsPackedSet(at)) THEN
                  AND (SymTab.IsPackedSet(ft) # SymTab.IsPackedSet(at)) THEN
@@ -1689,7 +1742,9 @@ PROCEDURE LowerBuiltinExpr (n: AST.Node; nm: SymTab.Name;
       ELSIF (dt # SymTab.InvalidType)
       ELSIF (dt # SymTab.InvalidType)
          AND (SymTab.ClassOf(dt) = SymTab.ClArray)
          AND (SymTab.ClassOf(dt) = SymTab.ClArray)
          AND SymTab.IsOpenArray(dt) AND (NOT sfx) THEN
          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 sfx THEN QbeGen.CopyOp(qd, q)
       ELSIF (k = SymTab.KindVar) OR (k = SymTab.KindParam) THEN
       ELSIF (k = SymTab.KindVar) OR (k = SymTab.KindParam) THEN
         QbeGen.AddrOf(qn, q)
         QbeGen.AddrOf(qn, q)
@@ -3037,6 +3092,11 @@ PROCEDURE LowerOneUnit (u: AST.Node; isProg: BOOLEAN);
     END
     END
   END LowerOneUnit;
   END LowerOneUnit;
 
 
+PROCEDURE SetLegacyOpen1D;
+  BEGIN
+    legacyOpen1D := TRUE
+  END SetLegacyOpen1D;
+
 PROCEDURE BeginSession (progName: ARRAY OF CHAR);
 PROCEDURE BeginSession (progName: ARRAY OF CHAR);
 (* Per-unit Lower emission.  The grammar still runs its inline emit while
 (* Per-unit Lower emission.  The grammar still runs its inline emit while
    parsing, but under NoEmit it only mutates QbeGen's counters (nothing
    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);
 PROCEDURE ViewFree (desc: ARRAY OF CHAR);
 (* Release a descriptor allocated by ViewToOpen1D. *)
 (* 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);
 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
 (* 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. *)
    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
   END ViewIndex;
   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);
 PROCEDURE MakeFieldView (addr: ARRAY OF CHAR; t: INTEGER; VAR q: QVal);
   VAR rank, k, count, stride: CARDINAL;
   VAR rank, k, count, stride: CARDINAL;
     cur: SymTab.TypeIndex;
     cur: SymTab.TypeIndex;

+ 7 - 0
compiler/src/compiler.frm

@@ -288,6 +288,7 @@ MODULE -->Grammar;
   VAR
   VAR
     sourceName, listName, progName: ARRAY [0 .. 255] OF CHAR;
     sourceName, listName, progName: ARRAY [0 .. 255] OF CHAR;
     files: ARRAY [0 .. 127] OF ARRAY [0 .. 255] OF CHAR;
     files: ARRAY [0 .. 127] OF ARRAY [0 .. 255] OF CHAR;
+    bootstrapEnv: ARRAY [0 .. 31] OF CHAR;
     nFiles: CARDINAL;
     nFiles: CARDINAL;
     f: CARDINAL;
     f: CARDINAL;
     bad: BOOLEAN;
     bad: BOOLEAN;
@@ -423,6 +424,10 @@ MODULE -->Grammar;
   END DoInst;
   END DoInst;
 
 
   BEGIN
   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) *)
     (* collect the session's source files (program module last) *)
     nFiles := 0;
     nFiles := 0;
     doTwoPhase := TRUE;   (* two-phase parse on by default (-notwophase off) *)
     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 (sourceName[0] = CHR(0)) OR (nFiles > HIGH(files)) THEN EXIT END;
       IF EqNm(sourceName, "-notwophase") THEN
       IF EqNm(sourceName, "-notwophase") THEN
         doTwoPhase := FALSE
         doTwoPhase := FALSE
+      ELSIF EqNm(sourceName, "-legacyopen1d") THEN
+        Lower.SetLegacyOpen1D
       ELSE
       ELSE
         Strings.Assign(sourceName, files[nFiles]);
         Strings.Assign(sourceName, files[nFiles]);
         INC(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);
                   VAR destination: ARRAY OF CHAR);
 PROCEDURE Compare (stringVal1, stringVal2: ARRAY OF CHAR): INTEGER;
 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.
 END FileIO.

+ 7 - 0
runtime/syslib/FileIO.mod

@@ -126,6 +126,13 @@ BEGIN
   RETURN 0
   RETURN 0
 END Compare;
 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
 BEGIN
   (* Arguments exclude argv[0] (the program name), matching the gm2
   (* Arguments exclude argv[0] (the program name), matching the gm2
      host FileIO: user arguments start at cmdline index 1. *)
      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
 (* Copies command-line argument i into s (capacity cap); FALSE when
    no such argument. *)
    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.
 END SysShim.

+ 9 - 0
runtime/syslib/SysShim.mod

@@ -44,6 +44,9 @@ PROCEDURE m2argc () : CARDINAL;
 PROCEDURE m2arg (i : CARDINAL; VAR s : ARRAY OF CHAR;
 PROCEDURE m2arg (i : CARDINAL; VAR s : ARRAY OF CHAR;
                  cap : CARDINAL) : BOOLEAN;
                  cap : CARDINAL) : BOOLEAN;
   EXTERNAL;
   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;
 PROCEDURE fopenread (VAR name : ARRAY OF CHAR) : ADDRESS;
 BEGIN
 BEGIN
@@ -143,4 +146,10 @@ BEGIN
   RETURN m2arg(i, s, cap)
   RETURN m2arg(i, s, cap)
 END arg;
 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.
 END SysShim.

+ 19 - 0
runtime/syslib/shim.c

@@ -277,6 +277,25 @@ long m2arg(long i, long *desc, long cap)
     return 1;
     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). */
 /* Set a string descriptor's logical length (header). */
 long m2setlen(long *desc, long n)
 long m2setlen(long *desc, long n)
 {
 {

+ 16 - 1
tools/m2make/M2make.mod

@@ -49,6 +49,7 @@ VAR
   dryRun, verbose, useGm2: BOOLEAN;
   dryRun, verbose, useGm2: BOOLEAN;
   outGiven: BOOLEAN;
   outGiven: BOOLEAN;
   mainPath, outName, m2bin, shimPath: Path;
   mainPath, outName, m2bin, shimPath: Path;
+  m2Flags: Cmd;
   extraC: Path;  (* extra C file linked in m2 mode (may be empty) *)
   extraC: Path;  (* extra C file linked in m2 mode (may be empty) *)
   nDirs: CARDINAL;
   nDirs: CARDINAL;
   progName: Name;
   progName: Name;
@@ -281,7 +282,8 @@ END Die;
 PROCEDURE Usage;
 PROCEDURE Usage;
 BEGIN
 BEGIN
   Out("Usage: M2make [-n] [-v] [-c m2|gm2] [-I dir] [-o out]"); OutLn;
   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;
 END Usage;
 
 
 (* ---------------- module table ---------------- *)
 (* ---------------- module table ---------------- *)
@@ -788,6 +790,10 @@ BEGIN
   Zero(cmd);
   Zero(cmd);
   AppendSeg(cmd, "mkdir -p gen_ssa && ");
   AppendSeg(cmd, "mkdir -p gen_ssa && ");
   AppendSeg(cmd, m2bin);
   AppendSeg(cmd, m2bin);
+  IF Len(m2Flags) > 0 THEN
+    AppendSeg(cmd, " ");
+    AppendSeg(cmd, m2Flags)
+  END;
   k := 0;
   k := 0;
   WHILE k < nOrder DO
   WHILE k < nOrder DO
     m := order[k];
     m := order[k];
@@ -961,6 +967,7 @@ BEGIN
   Zero(outName);
   Zero(outName);
   Copy("M2", m2bin);
   Copy("M2", m2bin);
   Copy("shim.c", shimPath);
   Copy("shim.c", shimPath);
+  Zero(m2Flags);
   nDirs := 0;
   nDirs := 0;
   na := 0;
   na := 0;
   LOOP
   LOOP
@@ -1019,6 +1026,14 @@ BEGIN
       END;
       END;
       INC(na);
       INC(na);
       Copy(s, shimPath)
       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
     ELSIF Cmp(s, "--extra") = 0 THEN
       ok := M2makeOS.GetArg(na, s, HIGH(s) + 1);
       ok := M2makeOS.GetArg(na, s, HIGH(s) + 1);
       IF NOT ok THEN
       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
 ```sh
 M2make [-n] [-v] [-c m2|gm2] [-I dir] [-o out]
 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).
 - `-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`).
 - `--shim path`: C runtime shim for `m2` mode (default `shim.c`).
 - `--extra path`: extra C file linked in `m2` mode (after the shim;
 - `--extra path`: extra C file linked in `m2` mode (after the shim;
   e.g. a tool's own `m2make_os.c`).
   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>`
 `m2` mode runs one session — `<m2bin> <ordered .def/.mod files>`
 then `qbe` then `cc <image>.s <shim> [<extra>] -o <out> -lm` — and
 then `qbe` then `cc <image>.s <shim> [<extra>] -o <out> -lm` — and