|
|
@@ -2019,18 +2019,88 @@ PROCEDURE Trap;
|
|
|
END Trap;
|
|
|
|
|
|
(* ---------------- records: flat blobs, pointer fields ---------------- *)
|
|
|
-(* Scalars/sets inline, array fields as 8-byte pointers to static
|
|
|
- descriptors, nested records inline. Static offsets throughout. *)
|
|
|
+(* Scalars/sets inline, array fields as inline descriptors (8-byte length
|
|
|
+ word + data), nested records inline. Static offsets throughout. *)
|
|
|
+
|
|
|
+PROCEDURE HasNestedArray (t: SymTab.TypeIndex): BOOLEAN;
|
|
|
+(* TRUE when record type t (recursively) has an ARRAY OF ARRAY field,
|
|
|
+ i.e. a field whose element is itself an array. Only such record
|
|
|
+ arrays need per-element expansion (their nested sub-descriptors must
|
|
|
+ be emitted); plain record arrays stay a compact zero blob. *)
|
|
|
+ VAR i: CARDINAL; fn: SymTab.Name; ft, et: 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 THEN
|
|
|
+ et := SymTab.ArrayElem(ft);
|
|
|
+ IF SymTab.ClassOf(et) = SymTab.ClArray THEN RETURN TRUE END
|
|
|
+ ELSIF (cls = SymTab.ClRecord) OR (cls = SymTab.ClClass) THEN
|
|
|
+ IF HasNestedArray(ft) THEN RETURN TRUE END
|
|
|
+ END;
|
|
|
+ INC(i)
|
|
|
+ END;
|
|
|
+ RETURN FALSE
|
|
|
+ END HasNestedArray;
|
|
|
|
|
|
PROCEDURE ArrBodyItems (prefix: ARRAY OF CHAR; t: INTEGER);
|
|
|
(* Inline contents of an array descriptor (no "data $name = {" wrapper
|
|
|
and no closing brace): "l <n>[, <elem>...]". Nested levels are
|
|
|
- referenced as $prefix_i (emitted by ArrData). *)
|
|
|
+ referenced as $prefix_i (emitted by ArrData). Record/class elements
|
|
|
+ with nested-array fields are expanded per element (EmitRec) so their
|
|
|
+ sub-descriptors are referenced; others stay a compact zero blob. *)
|
|
|
VAR n, i: CARDINAL;
|
|
|
elem: SymTab.TypeIndex;
|
|
|
ecls: INTEGER;
|
|
|
esz: CARDINAL;
|
|
|
- bv: QVal;
|
|
|
+ bv, sub: QVal;
|
|
|
+ first: BOOLEAN;
|
|
|
+
|
|
|
+ (* One inline record: mirrors RecItems (same field order and comma
|
|
|
+ handling), but array fields recurse into the enclosing
|
|
|
+ ArrBodyItems. Nested here so no FORWARD declaration is needed. *)
|
|
|
+ PROCEDURE EmitRec (rt: SymTab.TypeIndex; rpre: ARRAY OF CHAR;
|
|
|
+ VAR first: BOOLEAN);
|
|
|
+ VAR i, k, w: CARDINAL;
|
|
|
+ fn: SymTab.Name;
|
|
|
+ ft: SymTab.TypeIndex;
|
|
|
+ cls: INTEGER;
|
|
|
+ rsub: QVal;
|
|
|
+
|
|
|
+ PROCEDURE Sep;
|
|
|
+ BEGIN
|
|
|
+ IF first THEN first := FALSE ELSE W(", ") END
|
|
|
+ END Sep;
|
|
|
+
|
|
|
+ BEGIN
|
|
|
+ i := 0;
|
|
|
+ WHILE i < SymTab.FieldCount(rt) DO
|
|
|
+ SymTab.FieldName(rt, i, fn);
|
|
|
+ ft := SymTab.FieldType(rt, fn);
|
|
|
+ cls := SymTab.ClassOf(ft);
|
|
|
+ IF cls = SymTab.ClReal THEN Sep; W("d 0")
|
|
|
+ ELSIF cls = SymTab.ClChar THEN Sep; W("b 0")
|
|
|
+ ELSIF cls = SymTab.ClArray THEN
|
|
|
+ Sep;
|
|
|
+ Cpy(rsub, rpre); App(rsub, "_"); App(rsub, fn);
|
|
|
+ ArrBodyItems(rsub, ft)
|
|
|
+ ELSIF cls = SymTab.ClSet THEN
|
|
|
+ w := SymTab.SetWords(ft);
|
|
|
+ IF w = 0 THEN w := 1 END;
|
|
|
+ Sep; W("w 0");
|
|
|
+ k := 1;
|
|
|
+ WHILE k < w DO W(", w 0"); INC(k) END
|
|
|
+ ELSIF (cls = SymTab.ClRecord) OR (cls = SymTab.ClClass) THEN
|
|
|
+ Cpy(rsub, rpre); App(rsub, "_"); App(rsub, fn);
|
|
|
+ EmitRec(ft, rsub, first)
|
|
|
+ ELSE Sep; W("w 0")
|
|
|
+ END;
|
|
|
+ INC(i)
|
|
|
+ END
|
|
|
+ END EmitRec;
|
|
|
+
|
|
|
BEGIN
|
|
|
n := SymTab.ArrayLen(t);
|
|
|
elem := SymTab.ArrayElem(t);
|
|
|
@@ -2046,6 +2116,17 @@ PROCEDURE ArrBodyItems (prefix: ARRAY OF CHAR; t: INTEGER);
|
|
|
W(bv);
|
|
|
INC(i)
|
|
|
END
|
|
|
+ ELSIF ((ecls = SymTab.ClRecord) OR (ecls = SymTab.ClClass))
|
|
|
+ AND HasNestedArray(elem) THEN
|
|
|
+ (* Per-element record expansion: nested-array field descriptors. *)
|
|
|
+ i := 0;
|
|
|
+ WHILE i < n DO
|
|
|
+ Cpy(sub, prefix); App(sub, "_");
|
|
|
+ IntStr(VAL(INTEGER, i), bv); App(sub, bv);
|
|
|
+ first := FALSE;
|
|
|
+ EmitRec(elem, sub, first);
|
|
|
+ INC(i)
|
|
|
+ END
|
|
|
ELSE
|
|
|
IF ecls = SymTab.ClChar THEN
|
|
|
(* CHAR: n data bytes + one NUL terminator slot *)
|
|
|
@@ -2082,6 +2163,43 @@ PROCEDURE ArrData (name: ARRAY OF CHAR; t: INTEGER);
|
|
|
elem: SymTab.TypeIndex;
|
|
|
bv: QVal;
|
|
|
sub: QVal;
|
|
|
+
|
|
|
+ (* Mirrors RecStatics, but nested-array sub-descriptors recurse into
|
|
|
+ the enclosing ArrData. Nested here so no FORWARD is needed. *)
|
|
|
+ PROCEDURE EmitRecStatics (rpre: ARRAY OF CHAR; rt: SymTab.TypeIndex);
|
|
|
+ VAR k, j, an: CARDINAL;
|
|
|
+ fn: SymTab.Name;
|
|
|
+ ft, et: SymTab.TypeIndex;
|
|
|
+ cls: INTEGER;
|
|
|
+ rsub, bv2: QVal;
|
|
|
+ BEGIN
|
|
|
+ k := 0;
|
|
|
+ WHILE k < SymTab.FieldCount(rt) DO
|
|
|
+ SymTab.FieldName(rt, k, fn);
|
|
|
+ ft := SymTab.FieldType(rt, fn);
|
|
|
+ cls := SymTab.ClassOf(ft);
|
|
|
+ IF cls = SymTab.ClArray THEN
|
|
|
+ et := SymTab.ArrayElem(ft);
|
|
|
+ IF SymTab.ClassOf(et) = SymTab.ClArray THEN
|
|
|
+ an := SymTab.ArrayLen(ft);
|
|
|
+ j := 0;
|
|
|
+ WHILE j < an DO
|
|
|
+ Cpy(rsub, rpre); App(rsub, "_"); App(rsub, fn);
|
|
|
+ App(rsub, "_");
|
|
|
+ IntStr(VAL(INTEGER, j), bv2);
|
|
|
+ App(rsub, bv2);
|
|
|
+ ArrData(rsub, et);
|
|
|
+ INC(j)
|
|
|
+ END
|
|
|
+ END
|
|
|
+ ELSIF (cls = SymTab.ClRecord) OR (cls = SymTab.ClClass) THEN
|
|
|
+ Cpy(rsub, rpre); App(rsub, "_"); App(rsub, fn);
|
|
|
+ EmitRecStatics(rsub, ft)
|
|
|
+ END;
|
|
|
+ INC(k)
|
|
|
+ END
|
|
|
+ END EmitRecStatics;
|
|
|
+
|
|
|
BEGIN
|
|
|
IF NOT opened THEN RETURN END;
|
|
|
W("data $"); W(name);
|
|
|
@@ -2099,6 +2217,20 @@ PROCEDURE ArrData (name: ARRAY OF CHAR; t: INTEGER);
|
|
|
ArrData(sub, elem);
|
|
|
INC(i)
|
|
|
END
|
|
|
+ ELSIF ((SymTab.ClassOf(elem) = SymTab.ClRecord)
|
|
|
+ OR (SymTab.ClassOf(elem) = SymTab.ClClass))
|
|
|
+ AND HasNestedArray(elem) THEN
|
|
|
+ (* Sub-descriptors referenced (as $name_i_field_k) from the inline
|
|
|
+ items emitted by ArrBodyItems; one set per element. *)
|
|
|
+ n := SymTab.ArrayLen(t);
|
|
|
+ i := 0;
|
|
|
+ WHILE i < n DO
|
|
|
+ Cpy(sub, name); App(sub, "_");
|
|
|
+ IntStr(VAL(INTEGER, i), bv);
|
|
|
+ App(sub, bv);
|
|
|
+ EmitRecStatics(sub, elem);
|
|
|
+ INC(i)
|
|
|
+ END
|
|
|
END
|
|
|
END ArrData;
|
|
|
|