|
|
@@ -123,6 +123,7 @@ VAR
|
|
|
tmod : ARRAY [0 .. MaxTypes - 1] OF Name; (* defining module *)
|
|
|
tscope : ARRAY [0 .. MaxTypes - 1] OF ScopePtr;
|
|
|
tdone : ARRAY [0 .. MaxTypes - 1] OF BOOLEAN;
|
|
|
+ tcstruct : ARRAY [0 .. MaxTypes - 1] OF BOOLEAN;
|
|
|
(* per-class vtables: each class owns a slice of the shared pool *)
|
|
|
vtBase : ARRAY [0 .. MaxTypes - 1] OF CARDINAL;
|
|
|
nVirt : ARRAY [0 .. MaxTypes - 1] OF CARDINAL;
|
|
|
@@ -759,6 +760,7 @@ PROCEDURE NewDesc (form: INTEGER; ref: TypeIndex): TypeIndex;
|
|
|
tref[nTypes] := ref;
|
|
|
tbytebuf[nTypes] := FALSE;
|
|
|
tdone[nTypes] := FALSE;
|
|
|
+ tcstruct[nTypes] := FALSE;
|
|
|
tvtag[nTypes] := FALSE;
|
|
|
vtBase[nTypes] := 0;
|
|
|
nVirt[nTypes] := 0;
|
|
|
@@ -1768,6 +1770,42 @@ PROCEDURE ArrayFieldFootprint (t: TypeIndex): CARDINAL;
|
|
|
RETURN ArrObjSize(t)
|
|
|
END ArrayFieldFootprint;
|
|
|
|
|
|
+PROCEDURE AlignUp (n, a: CARDINAL): CARDINAL;
|
|
|
+ BEGIN
|
|
|
+ IF a <= 1 THEN RETURN n END;
|
|
|
+ RETURN ((n + a - 1) DIV a) * a
|
|
|
+ END AlignUp;
|
|
|
+
|
|
|
+PROCEDURE AlignOfD (t: TypeIndex; depth: CARDINAL): CARDINAL;
|
|
|
+(* Natural C alignment of t. Used only for C-layout records. *)
|
|
|
+ VAR r: TypeIndex; f: FieldPtr; a, max: CARDINAL;
|
|
|
+ BEGIN
|
|
|
+ IF depth > ResDepth THEN RETURN 1 END;
|
|
|
+ r := Resolve(t);
|
|
|
+ IF r = InvalidType THEN RETURN 1 END;
|
|
|
+ CASE tform[r] OF
|
|
|
+ FByte, FSByte, FCBool : RETURN 1
|
|
|
+ | FWord16, FSWord16 : RETURN 2
|
|
|
+ | FInt, FBool, FChar, FUChar, FReal32, FEnum, FSub : RETURN 4
|
|
|
+ | FSet : RETURN 4
|
|
|
+ | FPackSet : RETURN SetBytes(t)
|
|
|
+ | FLong, FReal, FPtr, FProc, FArray, FOpenArr, FUStr, FBigSet : RETURN 8
|
|
|
+ | FRecord :
|
|
|
+ IF NOT tcstruct[r] THEN RETURN 8 END;
|
|
|
+ max := 1; f := fields;
|
|
|
+ WHILE f # NIL DO
|
|
|
+ IF f^.owner = r THEN
|
|
|
+ a := AlignOfD(f^.typ, depth + 1);
|
|
|
+ IF a > max THEN max := a END
|
|
|
+ END;
|
|
|
+ f := f^.next
|
|
|
+ END;
|
|
|
+ RETURN max
|
|
|
+ | FAlias : RETURN AlignOfD(tref[r], depth + 1)
|
|
|
+ ELSE RETURN 1
|
|
|
+ END
|
|
|
+ END AlignOfD;
|
|
|
+
|
|
|
PROCEDURE TypeSizeD (t: TypeIndex; depth: CARDINAL): CARDINAL;
|
|
|
(* Inline footprint in bytes: scalars 4/8, sets words*4, pointers,
|
|
|
open and fixed arrays 8 (descriptor address — array objects live
|
|
|
@@ -1793,6 +1831,37 @@ PROCEDURE TypeSizeD (t: TypeIndex; depth: CARDINAL): CARDINAL;
|
|
|
| FPackSet : RETURN SetBytes(t)
|
|
|
| FPtr, FOpenArr, FArray, FProc, FUStr : RETURN 8
|
|
|
| FRecord, FClass :
|
|
|
+ IF (tform[r] = FRecord) AND tcstruct[r] THEN
|
|
|
+ (* C layout: natural alignment, trailing padding. *)
|
|
|
+ n := 0; plain := 0; high := FieldCount(t); f := fields;
|
|
|
+ WHILE f # NIL DO
|
|
|
+ IF f^.owner = r THEN
|
|
|
+ DEC(high);
|
|
|
+ f^.ord := high
|
|
|
+ END;
|
|
|
+ f := f^.next
|
|
|
+ END;
|
|
|
+ n := 0; high := 0; plain := 1;
|
|
|
+ WHILE high < FieldCount(t) DO
|
|
|
+ f := fields;
|
|
|
+ WHILE f # NIL DO
|
|
|
+ IF (f^.owner = r) AND (f^.ord = high) THEN
|
|
|
+ n := AlignUp(n, AlignOfD(f^.typ, depth + 1));
|
|
|
+ IF ClassOf(f^.typ) = ClArray THEN
|
|
|
+ n := n + ArrayFieldFootprint(f^.typ)
|
|
|
+ ELSE
|
|
|
+ n := n + TypeSizeD(f^.typ, depth + 1)
|
|
|
+ END;
|
|
|
+ IF AlignOfD(f^.typ, depth + 1) > plain THEN
|
|
|
+ plain := AlignOfD(f^.typ, depth + 1)
|
|
|
+ END
|
|
|
+ END;
|
|
|
+ f := f^.next
|
|
|
+ END;
|
|
|
+ INC(high)
|
|
|
+ END;
|
|
|
+ RETURN AlignUp(n, plain)
|
|
|
+ END;
|
|
|
n := 0;
|
|
|
IF (tform[r] = FClass) AND (tparent[r] # InvalidType) THEN
|
|
|
(* single inheritance: parent fields (and its vptr) come first *)
|
|
|
@@ -1991,6 +2060,31 @@ PROCEDURE ComputeOffsets (r: TypeIndex);
|
|
|
AND (tvptr[r] = baseOff) THEN
|
|
|
baseOff := baseOff + 8
|
|
|
END;
|
|
|
+ IF (tform[r] = FRecord) AND tcstruct[r] THEN
|
|
|
+ cnt := FieldCount(r);
|
|
|
+ ord := cnt; f := fields;
|
|
|
+ WHILE f # NIL DO
|
|
|
+ IF f^.owner = r THEN DEC(ord); f^.ord := ord END;
|
|
|
+ f := f^.next
|
|
|
+ END;
|
|
|
+ total := 0; high := 1; ord := 0;
|
|
|
+ WHILE ord < cnt DO
|
|
|
+ f := fields;
|
|
|
+ WHILE f # NIL DO
|
|
|
+ IF (f^.owner = r) AND (f^.ord = ord) THEN
|
|
|
+ tagSize := VAL(INTEGER, AlignOfD(f^.typ, 0));
|
|
|
+ total := (total + tagSize - 1) DIV tagSize * tagSize;
|
|
|
+ f^.off := total;
|
|
|
+ total := total + VAL(INTEGER, FieldSize(f^.typ));
|
|
|
+ IF tagSize > high THEN high := tagSize END
|
|
|
+ END;
|
|
|
+ f := f^.next
|
|
|
+ END;
|
|
|
+ INC(ord)
|
|
|
+ END;
|
|
|
+ tdone[r] := TRUE;
|
|
|
+ RETURN
|
|
|
+ END;
|
|
|
IF NOT tvtag[r] THEN
|
|
|
(* plain record/class: declaration-ordered, tightly packed *)
|
|
|
total := baseOff; cnt := 0;
|
|
|
@@ -2095,6 +2189,20 @@ PROCEDURE LayoutRecord (t: TypeIndex);
|
|
|
END
|
|
|
END LayoutRecord;
|
|
|
|
|
|
+PROCEDURE SetCStruct (rec: TypeIndex);
|
|
|
+ VAR r: TypeIndex;
|
|
|
+ BEGIN
|
|
|
+ r := Resolve(rec);
|
|
|
+ IF (r # InvalidType) AND (tform[r] = FRecord) THEN tcstruct[r] := TRUE END
|
|
|
+ END SetCStruct;
|
|
|
+
|
|
|
+PROCEDURE IsCStruct (rec: TypeIndex): BOOLEAN;
|
|
|
+ VAR r: TypeIndex;
|
|
|
+ BEGIN
|
|
|
+ r := Resolve(rec);
|
|
|
+ RETURN (r # InvalidType) AND (tform[r] = FRecord) AND tcstruct[r]
|
|
|
+ END IsCStruct;
|
|
|
+
|
|
|
PROCEDURE FieldOffset (rec: TypeIndex; name: ARRAY OF CHAR): INTEGER;
|
|
|
VAR r: TypeIndex;
|
|
|
f: FieldPtr;
|