|
@@ -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
|