|
|
@@ -76,7 +76,7 @@ VAR
|
|
|
must hold the compiler's own
|
|
|
image text when self-hosting) *)
|
|
|
sessUsed : CARDINAL;
|
|
|
- nestBufs : ARRAY [0 .. 15] OF ARRAY [0 .. 65535] OF CHAR;
|
|
|
+ nestBufs : ARRAY [0 .. 15] OF ARRAY [0 .. 131071] OF CHAR;
|
|
|
nestUsed : ARRAY [0 .. 15] OF CARDINAL;
|
|
|
(* Short-circuit AND/OR: the RHS operand's code is buffered here
|
|
|
(delayTop > 0) and replayed inside the branch. *)
|
|
|
@@ -2227,6 +2227,27 @@ PROCEDURE HasArrayField (t: SymTab.TypeIndex): BOOLEAN;
|
|
|
RETURN FALSE
|
|
|
END HasArrayField;
|
|
|
|
|
|
+PROCEDURE HasMultiArrayField (t: SymTab.TypeIndex): BOOLEAN;
|
|
|
+(* TRUE when a record/class contains a rank-2/3 array field, directly
|
|
|
+ or in a nested record. Such record constructors need the runtime
|
|
|
+ path so the flat field payload is handled by a view. *)
|
|
|
+ VAR i: CARDINAL; fn: SymTab.Name; ft: SymTab.TypeIndex; cls: INTEGER;
|
|
|
+ BEGIN
|
|
|
+ i := 0;
|
|
|
+ WHILE i < SymTab.FieldCount(t) DO
|
|
|
+ SymTab.FieldName(t, i, fn);
|
|
|
+ ft := SymTab.FieldType(t, fn);
|
|
|
+ cls := SymTab.ClassOf(ft);
|
|
|
+ IF (cls = SymTab.ClArray) AND SymTab.IsMultiArray(ft) THEN
|
|
|
+ RETURN TRUE
|
|
|
+ ELSIF (cls = SymTab.ClRecord) OR (cls = SymTab.ClClass) THEN
|
|
|
+ IF HasMultiArrayField(ft) THEN RETURN TRUE END
|
|
|
+ END;
|
|
|
+ INC(i)
|
|
|
+ END;
|
|
|
+ RETURN FALSE
|
|
|
+ END HasMultiArrayField;
|
|
|
+
|
|
|
PROCEDURE RecArrayExpanded (n: CARDINAL; t: INTEGER): BOOLEAN;
|
|
|
(* TRUE when a record-/class-array's per-element expansion fits the image
|
|
|
budget. Larger tables keep the compact zero blob and are instead
|
|
|
@@ -2279,8 +2300,13 @@ PROCEDURE ArrBodyItems (prefix: ARRAY OF CHAR; t: INTEGER);
|
|
|
Sep; W("h 0")
|
|
|
ELSIF cls = SymTab.ClArray THEN
|
|
|
Sep;
|
|
|
- Cpy(rsub, rpre); App(rsub, "_"); App(rsub, fn);
|
|
|
- ArrBodyItems(rsub, ft)
|
|
|
+ IF SymTab.IsMultiArray(ft) THEN
|
|
|
+ W("z "); IntStr(VAL(INTEGER, SymTab.ArrayPayloadSize(ft)), rsub);
|
|
|
+ W(rsub)
|
|
|
+ ELSE
|
|
|
+ Cpy(rsub, rpre); App(rsub, "_"); App(rsub, fn);
|
|
|
+ ArrBodyItems(rsub, ft)
|
|
|
+ END
|
|
|
ELSIF cls = SymTab.ClSet THEN
|
|
|
w := SymTab.SetWords(ft);
|
|
|
IF w = 0 THEN w := 1 END;
|
|
|
@@ -2375,7 +2401,7 @@ PROCEDURE ArrData (name: ARRAY OF CHAR; t: INTEGER);
|
|
|
SymTab.FieldName(rt, k, fn);
|
|
|
ft := SymTab.FieldType(rt, fn);
|
|
|
cls := SymTab.ClassOf(ft);
|
|
|
- IF cls = SymTab.ClArray THEN
|
|
|
+ IF (cls = SymTab.ClArray) AND NOT SymTab.IsMultiArray(ft) THEN
|
|
|
et := SymTab.ArrayElem(ft);
|
|
|
IF SymTab.ClassOf(et) = SymTab.ClArray THEN
|
|
|
an := SymTab.ArrayLen(ft);
|
|
|
@@ -2447,7 +2473,7 @@ PROCEDURE RecStatics (recname: ARRAY OF CHAR; t: SymTab.TypeIndex);
|
|
|
SymTab.FieldName(t, i, fn);
|
|
|
ft := SymTab.FieldType(t, fn);
|
|
|
cls := SymTab.ClassOf(ft);
|
|
|
- IF cls = SymTab.ClArray THEN
|
|
|
+ IF (cls = SymTab.ClArray) AND NOT SymTab.IsMultiArray(ft) THEN
|
|
|
et := SymTab.ArrayElem(ft);
|
|
|
IF SymTab.ClassOf(et) = SymTab.ClArray THEN
|
|
|
an := SymTab.ArrayLen(ft);
|
|
|
@@ -2498,10 +2524,14 @@ PROCEDURE RecItems (t: SymTab.TypeIndex; prefix: ARRAY OF CHAR;
|
|
|
ELSIF (cls = SymTab.ClWord16) OR (cls = SymTab.ClSWord16) THEN
|
|
|
Sep; W("h 0")
|
|
|
ELSIF cls = SymTab.ClArray THEN
|
|
|
- (* array field: inline descriptor (was a pointer) *)
|
|
|
Sep;
|
|
|
- Cpy(sub, prefix); App(sub, "_"); App(sub, fn);
|
|
|
- ArrBodyItems(sub, ft)
|
|
|
+ IF SymTab.IsMultiArray(ft) THEN
|
|
|
+ W("z "); IntStr(VAL(INTEGER, SymTab.ArrayPayloadSize(ft)), sub);
|
|
|
+ W(sub)
|
|
|
+ ELSE
|
|
|
+ Cpy(sub, prefix); App(sub, "_"); App(sub, fn);
|
|
|
+ ArrBodyItems(sub, ft)
|
|
|
+ END
|
|
|
ELSIF cls = SymTab.ClSet THEN
|
|
|
w := SymTab.SetWords(ft);
|
|
|
IF w = 0 THEN w := 1 END;
|
|
|
@@ -3360,6 +3390,51 @@ PROCEDURE ViewIndex (view, idx, lo: ARRAY OF CHAR;
|
|
|
END
|
|
|
END ViewIndex;
|
|
|
|
|
|
+PROCEDURE MakeFieldView (addr: ARRAY OF CHAR; t: INTEGER; VAR q: QVal);
|
|
|
+ VAR rank, k, count, stride: CARDINAL;
|
|
|
+ cur: SymTab.TypeIndex;
|
|
|
+ v, a, nb, off: QVal;
|
|
|
+ BEGIN
|
|
|
+ rank := SymTab.ArrayDepth(t);
|
|
|
+ IF rank <= 1 THEN CopyOp(addr, q); RETURN END;
|
|
|
+ IntStr(VAL(INTEGER, rank * 40), nb);
|
|
|
+ NewTemp(q);
|
|
|
+ Revive;
|
|
|
+ W(" "); W(q); W(" =l alloc8 "); WL(nb);
|
|
|
+ cur := t; k := 0;
|
|
|
+ WHILE k < rank DO
|
|
|
+ IntStr(VAL(INTEGER, k * 40), off);
|
|
|
+ NewTemp(v); Op3L("add", v, q, off);
|
|
|
+ count := SymTab.ArrayLen(cur);
|
|
|
+ stride := SymTab.ArrayStride(t, k);
|
|
|
+ IntStr(VAL(INTEGER, count), nb);
|
|
|
+ Revive; W(" storel "); W(nb); W(", "); WL(v);
|
|
|
+ IntStr(VAL(INTEGER, stride), nb);
|
|
|
+ NewTemp(a); Op3L("add", a, v, "8");
|
|
|
+ Revive; W(" storel "); W(nb); W(", "); WL(a);
|
|
|
+ NewTemp(a); Op3L("add", a, v, "16");
|
|
|
+ Revive; W(" storel "); W(nb); W(", "); WL(a);
|
|
|
+ IF k = 0 THEN
|
|
|
+ NewTemp(a); Op3L("add", a, v, "24");
|
|
|
+ Revive; W(" storel "); W(addr); W(", "); WL(a)
|
|
|
+ ELSE
|
|
|
+ NewTemp(a); Op3L("add", a, v, "24");
|
|
|
+ Revive; W(" storel 0, "); WL(a)
|
|
|
+ END;
|
|
|
+ IF k + 1 < rank THEN
|
|
|
+ NewTemp(a); Op3L("add", a, v, "32");
|
|
|
+ IntStr(VAL(INTEGER, (k + 1) * 40), off);
|
|
|
+ NewTemp(nb); Op3L("add", nb, q, off);
|
|
|
+ Revive; W(" storel "); W(nb); W(", "); WL(a)
|
|
|
+ ELSE
|
|
|
+ NewTemp(a); Op3L("add", a, v, "32");
|
|
|
+ Revive; W(" storel 0, "); WL(a)
|
|
|
+ END;
|
|
|
+ cur := SymTab.ArrayElem(cur);
|
|
|
+ INC(k)
|
|
|
+ END
|
|
|
+ END MakeFieldView;
|
|
|
+
|
|
|
PROCEDURE ViewToOpen1D (view: ARRAY OF CHAR; ft: INTEGER;
|
|
|
VAR q, base, nbytes: QVal);
|
|
|
VAR count, elem, total, n, desc, p, p2, eoff: QVal;
|
|
|
@@ -4226,7 +4301,17 @@ PROCEDURE CtorArrStatic (VAR s: ARRAY OF CHAR; lvl: CARDINAL;
|
|
|
Cpy(v, ctorEv[lvl][k])
|
|
|
ELSE Cpy(v, "0")
|
|
|
END;
|
|
|
- CtorItem(s, v, ecls);
|
|
|
+ IF (ecls = SymTab.ClRecord) OR (ecls = SymTab.ClClass) THEN
|
|
|
+ ci := FindCtor(v);
|
|
|
+ IF ci >= 0 THEN
|
|
|
+ App(s, ", "); App(s, ctorTxt[ci]);
|
|
|
+ ctorUse[ci] := FALSE
|
|
|
+ ELSE
|
|
|
+ AppFlatZero(s, SymTab.TypeSize(elem))
|
|
|
+ END
|
|
|
+ ELSE
|
|
|
+ CtorItem(s, v, ecls)
|
|
|
+ END;
|
|
|
INC(k)
|
|
|
END;
|
|
|
IF ecls = SymTab.ClChar THEN App(s, ", b 0")
|
|
|
@@ -4234,6 +4319,100 @@ PROCEDURE CtorArrStatic (VAR s: ARRAY OF CHAR; lvl: CARDINAL;
|
|
|
END
|
|
|
END CtorArrStatic;
|
|
|
|
|
|
+PROCEDURE NextCtorTok (txt: ARRAY OF CHAR; VAR pos: CARDINAL;
|
|
|
+ VAR kind: CHAR; VAR val: QVal): BOOLEAN;
|
|
|
+ VAR L, j: CARDINAL;
|
|
|
+ BEGIN
|
|
|
+ val[0] := CHR(0); kind := CHR(0);
|
|
|
+ L := Len(txt);
|
|
|
+ WHILE (pos < L) AND ((txt[pos] = " ") OR (txt[pos] = ",")) DO
|
|
|
+ INC(pos)
|
|
|
+ END;
|
|
|
+ IF (pos >= L) OR (txt[pos] = "}") THEN RETURN FALSE END;
|
|
|
+ kind := txt[pos]; INC(pos);
|
|
|
+ WHILE (pos < L) AND (txt[pos] = " ") DO INC(pos) END;
|
|
|
+ j := 0;
|
|
|
+ WHILE (pos < L) AND (txt[pos] # ",") AND (txt[pos] # " ")
|
|
|
+ AND (txt[pos] # "}") DO
|
|
|
+ IF j <= HIGH(val) THEN val[j] := txt[pos] END;
|
|
|
+ INC(j); INC(pos)
|
|
|
+ END;
|
|
|
+ IF j <= HIGH(val) THEN val[j] := CHR(0) END;
|
|
|
+ RETURN TRUE
|
|
|
+ END NextCtorTok;
|
|
|
+
|
|
|
+PROCEDURE AppFlat (VAR out: ARRAY OF CHAR; kind: CHAR; val: ARRAY OF CHAR);
|
|
|
+ VAR n: CARDINAL;
|
|
|
+ BEGIN
|
|
|
+ IF out[0] # CHR(0) THEN App(out, ", ") END;
|
|
|
+ IF kind # CHR(0) THEN
|
|
|
+ n := Len(out);
|
|
|
+ out[n] := kind;
|
|
|
+ out[n + 1] := CHR(0);
|
|
|
+ App(out, " ")
|
|
|
+ END;
|
|
|
+ App(out, val)
|
|
|
+ END AppFlat;
|
|
|
+
|
|
|
+PROCEDURE AppFlatZero (VAR out: ARRAY OF CHAR; n: CARDINAL);
|
|
|
+ VAR bv: QVal;
|
|
|
+ BEGIN
|
|
|
+ IF n = 0 THEN RETURN END;
|
|
|
+ IF out[0] # CHR(0) THEN App(out, ", ") END;
|
|
|
+ App(out, "z ");
|
|
|
+ IntStr(VAL(INTEGER, n), bv); App(out, bv)
|
|
|
+ END AppFlatZero;
|
|
|
+
|
|
|
+PROCEDURE AppZeroItem (VAR out: ARRAY OF CHAR; n: CARDINAL);
|
|
|
+ VAR bv: QVal;
|
|
|
+ BEGIN
|
|
|
+ IF n = 0 THEN RETURN END;
|
|
|
+ App(out, "z ");
|
|
|
+ IntStr(VAL(INTEGER, n), bv); App(out, bv)
|
|
|
+ END AppZeroItem;
|
|
|
+
|
|
|
+PROCEDURE FlattenArrayText (txt: ARRAY OF CHAR; t: INTEGER;
|
|
|
+ VAR out: ARRAY OF CHAR);
|
|
|
+ VAR pos: CARDINAL; kind: CHAR; val: QVal; n, i, elemN, ci: INTEGER;
|
|
|
+ elem: SymTab.TypeIndex;
|
|
|
+ BEGIN
|
|
|
+ pos := 0;
|
|
|
+ IF (NOT NextCtorTok(txt, pos, kind, val)) OR (kind # "l")
|
|
|
+ OR (NOT ParseInt(val, n)) OR (n < 0) THEN
|
|
|
+ AppFlatZero(out, SymTab.ArrayPayloadSize(t)); RETURN
|
|
|
+ END;
|
|
|
+ elem := SymTab.ArrayElem(t);
|
|
|
+ elemN := VAL(INTEGER, SymTab.ArrayPayloadSize(elem));
|
|
|
+ i := 0;
|
|
|
+ WHILE i < n DO
|
|
|
+ IF NOT NextCtorTok(txt, pos, kind, val) THEN
|
|
|
+ AppFlatZero(out, VAL(CARDINAL, elemN))
|
|
|
+ ELSIF SymTab.ClassOf(elem) = SymTab.ClArray THEN
|
|
|
+ ci := FindCtor(val);
|
|
|
+ IF (kind = "l") AND (val[0] = "$") AND (ci >= 0) THEN
|
|
|
+ FlattenArrayText(ctorTxt[ci], elem, out)
|
|
|
+ ELSE
|
|
|
+ AppFlatZero(out, VAL(CARDINAL, elemN))
|
|
|
+ END
|
|
|
+ ELSE
|
|
|
+ AppFlat(out, kind, val)
|
|
|
+ END;
|
|
|
+ INC(i)
|
|
|
+ END
|
|
|
+ END FlattenArrayText;
|
|
|
+
|
|
|
+PROCEDURE FlattenCtorText (v: ARRAY OF CHAR; t: INTEGER;
|
|
|
+ VAR out: ARRAY OF CHAR);
|
|
|
+ VAR ci: INTEGER;
|
|
|
+ BEGIN
|
|
|
+ ci := FindCtor(v);
|
|
|
+ IF ci < 0 THEN
|
|
|
+ AppFlatZero(out, SymTab.ArrayPayloadSize(t))
|
|
|
+ ELSE
|
|
|
+ FlattenArrayText(ctorTxt[ci], t, out)
|
|
|
+ END
|
|
|
+ END FlattenCtorText;
|
|
|
+
|
|
|
PROCEDURE CtorRecStatic (VAR s: ARRAY OF CHAR; lvl: CARDINAL;
|
|
|
t: INTEGER; cnt: CARDINAL);
|
|
|
(* Static record body: fields in declaration order; an array/record
|
|
|
@@ -4243,6 +4422,7 @@ PROCEDURE CtorRecStatic (VAR s: ARRAY OF CHAR; lvl: CARDINAL;
|
|
|
fn: SymTab.Name;
|
|
|
ft: SymTab.TypeIndex;
|
|
|
v, bv: QVal;
|
|
|
+ flat: ARRAY [0 .. 4095] OF CHAR;
|
|
|
first: BOOLEAN;
|
|
|
BEGIN
|
|
|
first := TRUE;
|
|
|
@@ -4259,7 +4439,17 @@ PROCEDURE CtorRecStatic (VAR s: ARRAY OF CHAR; lvl: CARDINAL;
|
|
|
cls := SymTab.ClassOf(ft);
|
|
|
v[0] := CHR(0);
|
|
|
IF i < VAL(INTEGER, cnt) THEN Cpy(v, ctorEv[lvl][i]) END;
|
|
|
- IF (v[0] # CHR(0)) AND (v[0] = "$")
|
|
|
+ IF (v[0] # CHR(0)) AND (cls = SymTab.ClArray)
|
|
|
+ AND SymTab.IsMultiArray(ft) THEN
|
|
|
+ flat[0] := CHR(0);
|
|
|
+ IF (v[0] = "$") AND (v[1] = "c") THEN
|
|
|
+ FlattenCtorText(v, ft, flat)
|
|
|
+ END;
|
|
|
+ IF first THEN first := FALSE ELSE App(s, ", ") END;
|
|
|
+ IF flat[0] # CHR(0) THEN App(s, flat)
|
|
|
+ ELSE AppZeroItem(s, SymTab.ArrayPayloadSize(ft))
|
|
|
+ END
|
|
|
+ ELSIF (v[0] # CHR(0)) AND (v[0] = "$")
|
|
|
AND ((cls = SymTab.ClArray) OR (cls = SymTab.ClRecord)
|
|
|
OR (cls = SymTab.ClClass)) THEN
|
|
|
ci := FindCtor(v);
|
|
|
@@ -4267,7 +4457,11 @@ PROCEDURE CtorRecStatic (VAR s: ARRAY OF CHAR; lvl: CARDINAL;
|
|
|
IF ci >= 0 THEN
|
|
|
App(s, ctorTxt[ci]);
|
|
|
ctorUse[ci] := FALSE
|
|
|
- ELSIF cls = SymTab.ClArray THEN ArrZeroBody(s, ft)
|
|
|
+ ELSIF cls = SymTab.ClArray THEN
|
|
|
+ IF SymTab.IsMultiArray(ft) THEN
|
|
|
+ AppZeroItem(s, SymTab.ArrayPayloadSize(ft))
|
|
|
+ ELSE ArrZeroBody(s, ft)
|
|
|
+ END
|
|
|
ELSE App(s, "w 0")
|
|
|
END
|
|
|
ELSIF v[0] # CHR(0) THEN
|
|
|
@@ -4280,7 +4474,11 @@ PROCEDURE CtorRecStatic (VAR s: ARRAY OF CHAR; lvl: CARDINAL;
|
|
|
IF first THEN first := FALSE ELSE App(s, ", ") END;
|
|
|
IF cls = SymTab.ClReal THEN App(s, "d 0")
|
|
|
ELSIF cls = SymTab.ClChar THEN App(s, "b 0")
|
|
|
- ELSIF cls = SymTab.ClArray THEN ArrZeroBody(s, ft)
|
|
|
+ ELSIF cls = SymTab.ClArray THEN
|
|
|
+ IF SymTab.IsMultiArray(ft) THEN
|
|
|
+ AppZeroItem(s, SymTab.ArrayPayloadSize(ft))
|
|
|
+ ELSE ArrZeroBody(s, ft)
|
|
|
+ END
|
|
|
ELSIF cls = SymTab.ClSet THEN
|
|
|
w := VAL(INTEGER, SymTab.SetWords(ft));
|
|
|
IF w = 0 THEN w := 1 END;
|
|
|
@@ -4294,10 +4492,29 @@ PROCEDURE CtorRecStatic (VAR s: ARRAY OF CHAR; lvl: CARDINAL;
|
|
|
IF first THEN App(s, "w 0") END
|
|
|
END CtorRecStatic;
|
|
|
|
|
|
+PROCEDURE ClearBytes (addr: ARRAY OF CHAR; n: CARDINAL);
|
|
|
+ VAR nb, a: QVal;
|
|
|
+ BEGIN
|
|
|
+ IF n = 0 THEN RETURN END;
|
|
|
+ IntStr(VAL(INTEGER, n), nb);
|
|
|
+ NewTemp(a);
|
|
|
+ W(" "); W(a); W(" =l call $memset(l "); W(addr);
|
|
|
+ W(", w 0, l "); W(nb); WL(")")
|
|
|
+ END ClearBytes;
|
|
|
+
|
|
|
+PROCEDURE ClearMultiField (addr: ARRAY OF CHAR; t: SymTab.TypeIndex);
|
|
|
+ VAR nb, a: QVal;
|
|
|
+ BEGIN
|
|
|
+ IntStr(VAL(INTEGER, SymTab.ArrayPayloadSize(t)), nb);
|
|
|
+ NewTemp(a);
|
|
|
+ W(" "); W(a); W(" =l call $memset(l "); W(addr);
|
|
|
+ W(", w 0, l "); W(nb); WL(")")
|
|
|
+ END ClearMultiField;
|
|
|
+
|
|
|
PROCEDURE CtorEnd (VAR q: QVal);
|
|
|
VAR t, cls, lvl, k, n, cnt, esz, off, ci: INTEGER;
|
|
|
allc: BOOLEAN;
|
|
|
- bv, a, v: QVal;
|
|
|
+ bv, a, v, qview: QVal;
|
|
|
s: ARRAY [0 .. 4095] OF CHAR;
|
|
|
ft, elem: SymTab.TypeIndex;
|
|
|
nm: SymTab.Name;
|
|
|
@@ -4343,7 +4560,15 @@ PROCEDURE CtorEnd (VAR q: QVal);
|
|
|
WHILE k < n DO
|
|
|
off := 8 + k * esz;
|
|
|
FieldAddr(q, off, a);
|
|
|
- IF k < cnt THEN
|
|
|
+ IF (SymTab.ClassOf(elem) = SymTab.ClRecord)
|
|
|
+ OR (SymTab.ClassOf(elem) = SymTab.ClClass) THEN
|
|
|
+ IF k < cnt THEN
|
|
|
+ Cpy(v, ctorEv[lvl][k]);
|
|
|
+ CopyRecord(a, v, elem)
|
|
|
+ ELSE
|
|
|
+ ClearBytes(a, SymTab.TypeSize(elem))
|
|
|
+ END
|
|
|
+ ELSIF k < cnt THEN
|
|
|
Cpy(v, ctorEv[lvl][k]);
|
|
|
ElemStore(a, v, elem)
|
|
|
ELSE ElemStore(a, "0", elem)
|
|
|
@@ -4377,8 +4602,13 @@ PROCEDURE CtorEnd (VAR q: QVal);
|
|
|
IF k < cnt THEN
|
|
|
Cpy(v, ctorEv[lvl][k]);
|
|
|
IF SymTab.ClassOf(ft) = SymTab.ClArray THEN
|
|
|
- InitArrHeader(a, ft);
|
|
|
- CopyArray(a, v, ft)
|
|
|
+ IF SymTab.IsMultiArray(ft) THEN
|
|
|
+ MakeFieldView(a, ft, qview);
|
|
|
+ CopyArray(qview, v, ft)
|
|
|
+ ELSE
|
|
|
+ InitArrHeader(a, ft);
|
|
|
+ CopyArray(a, v, ft)
|
|
|
+ END
|
|
|
ELSIF (SymTab.ClassOf(ft) = SymTab.ClRecord)
|
|
|
OR (SymTab.ClassOf(ft) = SymTab.ClClass) THEN
|
|
|
CopyRecord(a, v, ft)
|
|
|
@@ -4386,6 +4616,9 @@ PROCEDURE CtorEnd (VAR q: QVal);
|
|
|
CopySet(a, v, SymTab.SetWords(ft), SymTab.SetWords(ft))
|
|
|
ELSE ElemStore(a, v, ft)
|
|
|
END
|
|
|
+ ELSIF (SymTab.ClassOf(ft) = SymTab.ClArray)
|
|
|
+ AND SymTab.IsMultiArray(ft) THEN
|
|
|
+ ClearMultiField(a, ft)
|
|
|
ELSIF (SymTab.ClassOf(ft) = SymTab.ClReal)
|
|
|
OR (SymTab.ClassOf(ft) = SymTab.ClChar)
|
|
|
OR (SymTab.ClassOf(ft) = SymTab.ClInt)
|
|
|
@@ -4534,6 +4767,11 @@ PROCEDURE InitMultiHeap (addr: ARRAY OF CHAR; t: SymTab.TypeIndex);
|
|
|
W(pay); W(", w 0, l "); W(nb); WL(")")
|
|
|
END InitMultiHeap;
|
|
|
|
|
|
+PROCEDURE InitMultiField (addr: ARRAY OF CHAR; t: SymTab.TypeIndex);
|
|
|
+ BEGIN
|
|
|
+ ClearMultiField(addr, t)
|
|
|
+ END InitMultiField;
|
|
|
+
|
|
|
PROCEDURE InitHeap (addr: ARRAY OF CHAR; t: SymTab.TypeIndex);
|
|
|
VAR cls, ecls: INTEGER;
|
|
|
n, i: CARDINAL;
|
|
|
@@ -4596,11 +4834,14 @@ PROCEDURE InitHeap (addr: ARRAY OF CHAR; t: SymTab.TypeIndex);
|
|
|
ft := SymTab.FieldType(t, fn);
|
|
|
ecls := SymTab.ClassOf(ft);
|
|
|
IF ecls = SymTab.ClArray THEN
|
|
|
- (* inline array field: initialize its header in place *)
|
|
|
IntStr(SymTab.FieldOffset(t, fn), nb);
|
|
|
NewTemp(fa);
|
|
|
Op3L("add", fa, addr, nb);
|
|
|
- InitHeap(fa, ft)
|
|
|
+ IF SymTab.IsMultiArray(ft) THEN
|
|
|
+ InitMultiField(fa, ft)
|
|
|
+ ELSE
|
|
|
+ InitHeap(fa, ft)
|
|
|
+ END
|
|
|
ELSIF (ecls = SymTab.ClRecord) OR (ecls = SymTab.ClClass) THEN
|
|
|
IntStr(SymTab.FieldOffset(t, fn), nb);
|
|
|
NewTemp(fa);
|