* instead of embedding the attributes inside the class' and property's type data only store a reference to a table of attributes

git-svn-id: trunk@42365 -

compiler/ncgrtti.pas

@@ -57,7 +57,7 @@ interface
         function ref_rtti(def:tdef;rt:trttitype;indirect:boolean;suffix:tsymstr):tasmsymbol;
         procedure write_rtti_name(tcb: ttai_typedconstbuilder; def: tdef);
         procedure write_rtti_data(tcb: ttai_typedconstbuilder; def:tdef; rt: trttitype);
-        procedure write_attribute_data(tcb: ttai_typedconstbuilder; def:tdef);
+        procedure write_attribute_data(tcb: ttai_typedconstbuilder;attr_list:trtti_attribute_list);
         procedure write_unit_info_reference(tcb: ttai_typedconstbuilder);
         procedure write_child_rtti_data(def:tdef;rt:trttitype);
         procedure write_rtti_reference(tcb: ttai_typedconstbuilder; def: tdef; rt: trttitype);
@@ -761,9 +761,6 @@ implementation
         proctypesinfo : byte;
         propnameitem  : tpropnamelistitem;
         propdefname : string;
-        attridx: ShortInt;
-        attrcount: byte;
-        attr: trtti_attribute;
 
         procedure writeaccessproc(pap:tpropaccesslisttypes; shiftvalue : byte; unsetvalue: byte);
         var
@@ -909,22 +906,12 @@ implementation
                 tcb.emit_ord_const(propnameitem.propindex,u16inttype);
                 tcb.emit_ord_const(proctypesinfo,u8inttype);
 
-                { Write property attribute count }
-                if assigned(tpropertysym(sym).rtti_attribute_list) then
-                  attrcount:=tpropertysym(sym).rtti_attribute_list.get_attribute_count
-                else
-                  attrcount:=0;
-                tcb.emit_ord_const(attrcount,u8inttype);
+                { write reference to attribute table }
+                write_attribute_data(tcb,tpropertysym(sym).rtti_attribute_list);
 
                 { Write property name }
                 tcb.emit_shortstring_const(tpropertysym(sym).realname);
 
-                { Write property attributes }
-                for attridx := 0 to attrcount-1 do
-                  begin
-                    attr := trtti_attribute(tpropertysym(sym).rtti_attribute_list.rtti_attributes[attridx]);
-                    tcb.emit_tai(Tai_const.Createname(attr.symbolname,AT_DATA_FORCEINDIRECT,0), cpointerdef.getreusable(ttypesym(attr.typesym).typedef));
-                  end;
                 tcb.end_anonymous_record;
              end;
           end;
@@ -1583,7 +1570,7 @@ implementation
 
             { TAttributeData }
             if rmo_hasattributes in current_module.rtti_options then
-                write_attribute_data(tcb, def);
+                write_attribute_data(tcb, def.rtti_attribute_list);
 
             { write published properties for this object }
             published_properties_write_rtti_data(tcb,propnamelist,def.symtable);
@@ -1746,26 +1733,57 @@ implementation
         end;
       end;
 
-    procedure TRTTIWriter.write_attribute_data(tcb: ttai_typedconstbuilder; def: tdef);
+  procedure TRTTIWriter.write_attribute_data(tcb:ttai_typedconstbuilder;attr_list:trtti_attribute_list);
     var
-      count: word;
-      idx: byte;
-      attr: trtti_attribute;
+      count, i: word;
+      attr : trtti_attribute;
+      tbltcb : ttai_typedconstbuilder;
+      tbllab : tasmlabel;
+      tbldef : tdef;
     begin
-      if (def.typ = objectdef) and (assigned(tobjectdef(def).rtti_attribute_list)) then
-        count:=tobjectdef(def).rtti_attribute_list.get_attribute_count
+      if assigned(attr_list) then
+        count:=attr_list.get_attribute_count
       else
         count:=0;
 
-      tcb.emit_ord_const(count,u16inttype);
+      if count=0 then
+        begin
+          { write a Nil reference }
+          tcb.emit_tai(Tai_const.Create_nil_dataptr,voidpointertype);
+          exit;
+        end;
 
-      if count>0 then
-        for idx:=0 to count-1 do
-          begin
-            attr := trtti_attribute(tobjectdef(def).rtti_attribute_list.rtti_attributes[idx]);
-            tcb.emit_tai(Tai_const.Createname(attr.symbolname,AT_DATA_FORCEINDIRECT,0), cpointerdef.getreusable(ttypesym(attr.typesym).typedef));
-          end;
-      end;
+      { first write the attribute list as a separate table }
+      current_asmdata.getglobaldatalabel(tbllab);
+
+      tbltcb:=ctai_typedconstbuilder.create([tcalo_is_lab,tcalo_make_dead_strippable,tcalo_apply_constalign]);
+
+      tbltcb.begin_anonymous_record('',defaultpacking,min(reqalign,SizeOf(PInt)),
+        targetinfos[target_info.system]^.alignment.recordalignmin,
+        targetinfos[target_info.system]^.alignment.maxCrecordalign);
+      tbltcb.emit_ord_const(count,u16inttype);
+      for i:=0 to count-1 do
+        begin
+          tbltcb.begin_anonymous_record('',defaultpacking,min(reqalign,SizeOf(PInt)),
+            targetinfos[target_info.system]^.alignment.recordalignmin,
+            targetinfos[target_info.system]^.alignment.maxCrecordalign);
+          attr:=trtti_attribute(attr_list.rtti_attributes[i]);
+
+          tbltcb.emit_tai(tai_const.Createname(attr.symbolname,AT_DATA_FORCEINDIRECT,0),cpointerdef.getreusable(ttypesym(attr.typesym).typedef));
+
+          tbltcb.end_anonymous_record;
+        end;
+      tbldef:=tbltcb.end_anonymous_record;
+
+      current_asmdata.asmlists[al_rtti].concatlist(
+        tbltcb.get_final_asmlist(tbllab,tbldef,sec_rodata,tbllab.name,const_align(sizeof(pint)))
+      );
+
+      tbltcb.free;
+
+      { write the reference to the attribute table }
+      tcb.emit_tai(Tai_const.Create_sym(tbllab),voidpointertype);
+    end;
 
     procedure TRTTIWriter.write_unit_info_reference(tcb: ttai_typedconstbuilder);
     begin

packages/rtl-objpas/src/inc/rtti.pp

@@ -3398,13 +3398,16 @@ end;
 function TRttiProperty.GetAttributes: specialize TArray<TCustomAttribute>;
 var
   i: Integer;
+  ad: PAttributeData;
 begin
   if not FAttributesResolved then
     begin
-      setlength(FAttributes,FPropInfo^.AttributeCount);
-      for i := 0 to FPropInfo^.AttributeCount-1 do
+      ad := FPropInfo^.AttributeTable;
+      if Assigned(ad) then
         begin
-          FAttributes[i]:=TCustomAttribute(GetPropAttribute(FPropInfo,i));
+          SetLength(FAttributes, FPropInfo^.AttributeTable^.AttributeCount);
+          for i := 0 to High(FAttributes) do
+            FAttributes[i] := TCustomAttribute(GetPropAttribute(FPropInfo, i));
         end;
       FAttributesResolved:=true;
     end;
@@ -3631,9 +3634,12 @@ begin
   if not FAttributesResolved then
     begin
     ad := GetAttributeData(FTypeInfo);
-    setlength(FAttributes,ad^.AttributeCount);
-    for i := 0 to ad^.AttributeCount-1 do
-      FAttributes[i]:=GetAttribute(ad,i);
+    if Assigned(ad) then
+      begin
+      setlength(FAttributes,ad^.AttributeCount);
+      for i := 0 to ad^.AttributeCount-1 do
+        FAttributes[i]:=GetAttribute(ad,i);
+      end;
     FAttributesResolved:=true;
     end;
   result := FAttributes;

rtl/objpas/typinfo.pp

@@ -526,6 +526,20 @@ unit TypInfo;
         { PropertyTable: TPropData }
       end;
 
+      TAttributeProc = function : TCustomAttribute;
+      PAttributeProcList = ^TAttributeProcList;
+      TAttributeProcList = array[0..$ffff] of TAttributeProc;
+
+      TAttributeData =
+{$ifndef FPC_REQUIRES_PROPER_ALIGNMENT}
+      packed
+{$endif}
+      record
+        AttributeCount: word;
+        AttributesList: TAttributeProcList;
+      end;
+      PAttributeData = ^TAttributeData;
+
       PTypeData = ^TTypeData;
       TTypeData =
 {$ifndef FPC_REQUIRES_PROPER_ALIGNMENT}
@@ -623,7 +637,7 @@ unit TypInfo;
                ParentInfoRef : TypeInfoPtr;
                PropCount : SmallInt;
                UnitInfo : PUnitInfo
-               // AttributeData: TAttributeData;
+               // AttributeTable: PAttributeData;
                // here the properties follow as array of TPropInfo
               );
             tkRecord:
@@ -741,7 +755,7 @@ unit TypInfo;
         //     6 : true, constant index property
         PropProcs : Byte;
 
-        AttributeCount : Byte;
+        AttributeTable : PAttributeData;
         Name : ShortString;
         property PropType: PTypeInfo read GetPropType;
         property Tail: Pointer read GetTail;
@@ -750,19 +764,9 @@ unit TypInfo;
 
       TProcInfoProc = Procedure(PropInfo : PPropInfo) of object;
 
-      TAttributeProc = function : TCustomAttribute;
-      PAttributeProcList = ^TAttributeProcList;
-      TAttributeProcList = array[0..$ffff] of TAttributeProc;
-
       PPropList = ^TPropList;
       TPropList = array[0..{$ifdef cpu16}(32768 div sizeof(PPropInfo))-2{$else}65535{$endif}] of PPropInfo;
 
-      TAttributeData = record
-        AttributeCount: word;
-        AttributesList: TAttributeProcList;
-      end;
-      PAttributeData = ^TAttributeData;
-
       PUnitInfoList = ^TUnitInfoList;
       TUnitInfoList = record
         UnitCount: IntPtr;
@@ -912,7 +916,6 @@ function GetNextTypeInfo(ATypeInfo: PTypeInfo): PTypeInfo;
 
 function GetAttributeData(TypeInfo: PTypeInfo): PAttributeData;
 
-function GetPropAttributeProclist(PropInfo: PPropInfo): PAttributeProcList;
 function GetPropAttribute(PropInfo: PPropInfo; AttributeNr: byte): TObject;
 
 function GetAttribute(AttributeData: PAttributeData; AttributeNr: byte): TCustomAttribute;
@@ -1027,7 +1030,7 @@ begin
     begin
       TD := GetTypeData(TypeInfo);
       if (rmoHasAttributes in td^.UnitInfo^.UnitOptions) then
-        Result:=PAttributeData(aligntoptr(pointer(@TD^.UnitInfo)+sizeof(TD^.UnitInfo)))
+        Result:=PAttributeData(PPointer(aligntoptr(pointer(@TD^.UnitInfo)+sizeof(TD^.UnitInfo)))^)
       else
         result := nil;
     end;
@@ -1035,15 +1038,12 @@ end;
 
 function GetPropData(TypeInfo : PTypeInfo; TypeData: PTypeData) : PPropData;
 var
-  AD: PAttributeData;
+  p: PtrUInt;
 begin
+  p := PtrUInt(@TypeData^.UnitInfo) + SizeOf(TypeData^.UnitInfo);
   if rmoHasAttributes in TypeData^.UnitInfo^.UnitOptions then
-    begin
-      AD := GetAttributeData(TypeInfo);
-      result := PPropData(pointer(AD)+SizeOf(AD^.AttributeCount)+(AD^.AttributeCount*SizeOf(TAttributeProc)));
-    end
-  else
-    result := aligntoptr(pointer(@TypeData^.UnitInfo)+sizeof(TypeData^.UnitInfo));
+    p := p + SizeOf(PAttributeData);
+  Result := PPropData(aligntoptr(Pointer(p)));
 end;
 
 function GetFirstTypeinfoFromUnit(AUnitInfo: PUnitInfo): PTypeInfo;
@@ -1121,7 +1121,7 @@ begin
                pd := GetPropData(ATypeInfo,td);
                p:=@pd^.PropList;
                for i:=1 to pd^.PropCount do
-                 p:=aligntoptr(pointer(@ppropinfo(p)^.Name)+byte(ppropinfo(p)^.Name[0])+(ppropinfo(p)^.AttributeCount*SizeOf(TAttributeProc))+1);
+                 p:=aligntoptr(pointer(@ppropinfo(p)^.Name)+byte(ppropinfo(p)^.Name[0]));
                end;
     tkInterface :
                begin
@@ -1150,26 +1150,16 @@ begin
     result := nil;
 end;
 
-function GetPropAttributeProclist(PropInfo: PPropInfo): PAttributeProcList;
-begin
-  if PropInfo^.AttributeCount=0 then
-    result := nil
-  else
-    begin
-      Result:=PAttributeProcList(aligntoptr(pointer(@PropInfo^.Name)+byte(PropInfo^.Name[0])+1));
-    end;
-end;
-
 function GetPropAttribute(PropInfo: PPropInfo; AttributeNr: byte): TObject;
 var
-  AttributeProcList: PAttributeProcList;
+  attrtable: PAttributeData;
 begin
-  if AttributeNr>=PropInfo^.AttributeCount then
-    result := nil
+  attrtable := PropInfo^.AttributeTable;
+  if not Assigned(attrtable) or (AttributeNr >= attrtable^.AttributeCount) then
+    result := Nil
   else
     begin
-      AttributeProcList := GetPropAttributeProclist(PropInfo);
-      result := AttributeProcList^[AttributeNr]();
+      result := attrtable^.AttributesList[AttributeNr]();
     end;
 end;
 
@@ -1491,7 +1481,7 @@ begin
           if ShortCompareText(Result^.Name, P) = 0 then
             exit;
           // skip to next property
-          Result:=PPropInfo(aligntoptr(pointer(@Result^.Name)+byte(Result^.Name[0])+(result^.AttributeCount*SizeOf(TAttributeProc))+1));
+          Result:=PPropInfo(aligntoptr(pointer(@Result^.Name)+byte(Result^.Name[0])+1));
         end;
       // parent class
       Typeinfo:=hp^.ParentInfo;
@@ -1654,7 +1644,7 @@ begin
           PropList^[TP^.NameIndex]:=TP;
         // Point to TP next propinfo record.
         // Located at Name[Length(Name)+1] !
-        TP:=aligntoptr(PPropInfo(pointer(@TP^.Name)+PByte(@TP^.Name)^+(TP^.AttributeCount*SizeOf(TAttributeProc))+1));
+        TP:=aligntoptr(PPropInfo(pointer(@TP^.Name)+PByte(@TP^.Name)^+1));
         Dec(Count);
       end;
     TypeInfo:=TD^.Parentinfo;