|
|
@@ -11,6 +11,7 @@ CONST
|
|
|
ResDepth = 64;
|
|
|
MaxPP = 1024; (* total procedure-type parameter slots *)
|
|
|
MaxEnumLit = 8192; (* enumeration literals, for export/import *)
|
|
|
+ MaxDefer = 512; (* deferred procedure bodies (two-phase parse) *)
|
|
|
|
|
|
(* descriptor forms *)
|
|
|
FNone = 0; FAlias = 1; FSub = 2; FEnum = 3; FArray = 4;
|
|
|
@@ -105,9 +106,9 @@ VAR
|
|
|
scope, saved while still current, restored for the re-parse pass *)
|
|
|
uidBase : ARRAY [0 .. 1023] OF Name; (* uid -> base name (mangling) *)
|
|
|
nDefer : CARDINAL;
|
|
|
- deferProc : ARRAY [0 .. 255] OF SymPtr;
|
|
|
- deferScope : ARRAY [0 .. 255] OF ScopePtr;
|
|
|
- deferSeq : ARRAY [0 .. 255] OF CARDINAL;
|
|
|
+ deferProc : ARRAY [0 .. MaxDefer - 1] OF SymPtr;
|
|
|
+ deferScope : ARRAY [0 .. MaxDefer - 1] OF ScopePtr;
|
|
|
+ deferSeq : ARRAY [0 .. MaxDefer - 1] OF CARDINAL;
|
|
|
declSeq : CARDINAL; (* next declaration-order number *)
|
|
|
orderCheck : BOOLEAN; (* enforce use-before-decl in a deferred body *)
|
|
|
orderSeq : CARDINAL; (* the enclosing procedure's declaration seq *)
|
|
|
@@ -1583,6 +1584,78 @@ PROCEDURE ElemBytes (t: TypeIndex): CARDINAL;
|
|
|
PROCEDURE IsCharArray (t: TypeIndex): BOOLEAN;
|
|
|
BEGIN RETURN ClassOf(ArrayElem(t)) = ClChar END IsCharArray;
|
|
|
|
|
|
+PROCEDURE ArrayRank (t: TypeIndex): CARDINAL;
|
|
|
+ BEGIN
|
|
|
+ RETURN ArrayDepth(t)
|
|
|
+ END ArrayRank;
|
|
|
+
|
|
|
+PROCEDURE IsMultiArray (t: TypeIndex): BOOLEAN;
|
|
|
+ BEGIN
|
|
|
+ RETURN ArrayDepth(t) > 1
|
|
|
+ END IsMultiArray;
|
|
|
+
|
|
|
+PROCEDURE ArrayLeafBytes (t: TypeIndex): CARDINAL;
|
|
|
+(* Walk to the scalar/record at the bottom of the array chain. *)
|
|
|
+ VAR cur: TypeIndex; cls: INTEGER;
|
|
|
+ BEGIN
|
|
|
+ cur := Resolve(t);
|
|
|
+ IF (cur = InvalidType) OR (tform[cur] # FArray)
|
|
|
+ AND (tform[cur] # FOpenArr) THEN
|
|
|
+ RETURN 0
|
|
|
+ END;
|
|
|
+ WHILE (cur # InvalidType)
|
|
|
+ AND ((tform[cur] = FArray) OR (tform[cur] = FOpenArr)) DO
|
|
|
+ cur := Resolve(ArrayElem(cur))
|
|
|
+ END;
|
|
|
+ IF cur = InvalidType THEN RETURN 0 END;
|
|
|
+ cls := ClassOf(cur);
|
|
|
+ IF (cls = ClChar) OR (cls = ClByte) OR (cls = ClSByte) THEN RETURN 1
|
|
|
+ ELSIF (cls = ClWord16) OR (cls = ClSWord16) THEN RETURN 2
|
|
|
+ ELSIF (cls = ClRecord) OR (cls = ClClass) OR (cls = ClSet) THEN
|
|
|
+ RETURN TypeSize(cur)
|
|
|
+ ELSIF (cls = ClReal) OR (cls = ClLong) OR (cls = ClPtr)
|
|
|
+ OR (cls = ClProc) OR (cls = ClStr) THEN RETURN 8
|
|
|
+ ELSIF cls = ClInvalid THEN RETURN 0
|
|
|
+ ELSE RETURN 4
|
|
|
+ END
|
|
|
+ END ArrayLeafBytes;
|
|
|
+
|
|
|
+PROCEDURE ArrayStride (t: TypeIndex; level: CARDINAL): CARDINAL;
|
|
|
+ VAR r, cur: TypeIndex; rank, k, len, stride: CARDINAL;
|
|
|
+ BEGIN
|
|
|
+ rank := ArrayDepth(t);
|
|
|
+ IF (rank = 0) OR (level >= rank) THEN RETURN 0 END;
|
|
|
+ stride := ArrayLeafBytes(t);
|
|
|
+ IF stride = 0 THEN RETURN 0 END;
|
|
|
+ r := Resolve(t);
|
|
|
+ cur := r;
|
|
|
+ k := 0;
|
|
|
+ WHILE k < rank DO
|
|
|
+ IF k > level THEN
|
|
|
+ IF (cur = InvalidType) OR (tform[cur] = FOpenArr) THEN RETURN 0 END;
|
|
|
+ len := ArrayLen(cur);
|
|
|
+ IF len = 0 THEN RETURN 0 END;
|
|
|
+ stride := stride * len
|
|
|
+ END;
|
|
|
+ cur := Resolve(ArrayElem(cur));
|
|
|
+ INC(k)
|
|
|
+ END;
|
|
|
+ RETURN stride
|
|
|
+ END ArrayStride;
|
|
|
+
|
|
|
+PROCEDURE ArrayPayloadSize (t: TypeIndex): CARDINAL;
|
|
|
+ VAR r: TypeIndex; stride, count: CARDINAL;
|
|
|
+ BEGIN
|
|
|
+ r := Resolve(t);
|
|
|
+ IF (r = InvalidType) OR (tform[r] = FOpenArr) THEN RETURN 0 END;
|
|
|
+ IF (tform[r] # FArray) THEN RETURN 0 END;
|
|
|
+ stride := ArrayStride(t, 0);
|
|
|
+ IF stride = 0 THEN RETURN 0 END;
|
|
|
+ count := ArrayLen(r);
|
|
|
+ IF count = 0 THEN RETURN 0 END;
|
|
|
+ RETURN stride * count
|
|
|
+ END ArrayPayloadSize;
|
|
|
+
|
|
|
PROCEDURE ArrObjSize (t: TypeIndex): CARDINAL;
|
|
|
(* full inline size of a fixed array: header (count) + packed elements
|
|
|
(+1 terminator byte for CHAR arrays) *)
|
