* The attribute-data is now stored inside the TTypeData structure instead of

   inside the TExtRTTIData. This particular change saves the memory for the
   reference from the TExtRTTIData to the actual TAttributeData.
 * With this change there is no need anymore for the reference from the
   TTypeInfo to the TExtRTTIData, so that one is removed.
 * The planned reference from the TExtRTTIData to the TUnitInfo is now
   implemented inside TTypeData.
 * Because of this change, there is no need anymore to store the UnitName inside
   TTypeData. For backwards-compatilibity a record-method called UnitName is
   implemented.
 * Although the TAttributeData is now stored inside the TTypeData structure, all
   direct references to the attribute-data were removed. To obtain the
   attribute-data, use GetAttributeData instead. This way it is possible to add
   the ability to switch off the generation of the attribute-data.
 * Each element can have op to 65k attributes assigned to it (was 255)
 * Renamed TExtRttiData.TypeData to TExtRttiData.TypeInfo
 * The TUnitUnfo has to be written for each unit, not only those with type-
   information
 * The TUnitInfo.unitinfosize now contins the size of the list with types.
   So excluding the size of the TUnitInfo structure itself.

git-svn-id: branches/joost/classattributes@25094 -

compiler/fmodule.pas

@@ -180,6 +180,9 @@ interface
         moduleoptions: tmoduleoptions;
         deprecatedmsg: pshortstring;
 
+        { contains a reference to the TUnitInfo rtti information for this module }
+        extrttiinfo : TAsmSymbol;
+
         { contains a list of types that are extended by helper types; the key is
           the full name of the type and the data is a TFPObjectList of
           tobjectdef instances (the helper defs) }
@@ -558,6 +561,7 @@ implementation
         deprecatedmsg:=nil;
         namespace:=nil;
         tcinitcode:=nil;
+        extrttiinfo:=nil;
         _exports:=TLinkedList.Create;
         dllscannerinputlist:=TFPHashList.Create;
         asmdata:=casmdata.create(realmodulename^);

compiler/ncgrtti.pas

@@ -46,12 +46,13 @@ interface
         procedure collect_propnamelist(propnamelist:TFPHashObjectList;objdef:tobjectdef);
         procedure write_rtti_name(def:tdef);
         procedure write_rtti_data(def:tdef;rt:trttitype);
-        procedure write_ext_rtti_data(def:tdef);
+        procedure write_attribute_data(def:tdef);
         procedure write_child_rtti_data(def:tdef;rt:trttitype);
         function  ref_rtti(def:tdef;rt:trttitype):tasmsymbol;
         procedure write_header(def: tdef; typekind: byte);
         procedure write_string(const s: string);
         procedure maybe_write_align;
+        procedure write_unitinfo_reference;
         procedure write_ext_rtti(def:tdef;rt:trttitype);
       public
         procedure write_rtti(def:tdef;rt:trttitype);
@@ -105,26 +106,16 @@ implementation
           current_asmdata.asmlists[al_rtti].concat(cai_align.Create(sizeof(TConstPtrUInt)));
       end;
 
-    procedure TRTTIWriter.write_ext_rtti(def: tdef; rt: trttitype);
-      var
-        extrttilab : tasmsymbol;
+    procedure TRTTIWriter.write_unitinfo_reference;
       begin
-        if def.owner.ExtRttiCount=0 then
-          start_write_unit_extrtti_info;
-
-        extrttilab:=current_asmdata.DefineAsmSymbol(tstoreddef(def).rtti_mangledname(extrtti),AB_GLOBAL,AT_DATA);
-
-        { Create a sec_extrtti section, because a normal data section could be
-          re-ordered by the linker }
-        new_section(current_asmdata.asmlists[al_ext_rtti],sec_extrtti,extrttilab.name,const_align(sizeof(pint)));
-        current_asmdata.asmlists[al_ext_rtti].concat(Tai_symbol.Create_global(extrttilab,0));
+      { write reference to TUnitInfo }
+        current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_sym(current_module.extrttiinfo));
+      end;
 
+    procedure TRTTIWriter.write_ext_rtti(def: tdef; rt: trttitype);
+      begin
         // Write reference to 'normal' typedata
         current_asmdata.asmlists[al_ext_rtti].concat(Tai_const.Createname(tstoreddef(def).rtti_mangledname(fullrtti),0));
-
-        write_ext_rtti_data(def);
-        current_asmdata.asmlists[al_ext_rtti].concat(Tai_symbol_end.Create(extrttilab));
-        inc(def.owner.ExtRttiCount);
       end;
 
     procedure TRTTIWriter.write_string(const s: string);
@@ -841,22 +832,12 @@ implementation
             { total number of unique properties }
             current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_16bit(propnamelist.count));
 
-            { total amount of class-attributes }
-            if assigned(def.rtti_attributesdef) then
-              attributecount:=def.rtti_attributesdef.get_attribute_count
-            else
-              attributecount:=0;
-            current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(attributecount));
+            { reference to unitinfo with unit-name }
+            write_unitinfo_reference;
 
-            { write unit name }
-            write_string(current_module.realmodulename^);
-            maybe_write_align;
-
-            for attributeindex:=0 to attributecount-1 do
-              begin
-                current_asmdata.asmlists[al_rtti].concat(Tai_const.createname(trtti_attribute(def.rtti_attributesdef.rtti_attributes[attributeindex]).symbolname,0));
-              end;
+            { TAttributeData }
             maybe_write_align;
+            write_attribute_data(def);
 
             { write published properties for this object }
             current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_16bit(published_properties_count(def.symtable)));
@@ -1003,36 +984,30 @@ implementation
         end;
       end;
 
-    procedure TRTTIWriter.write_ext_rtti_data(def: tdef);
+    procedure TRTTIWriter.write_attribute_data(def: tdef);
 
     var
-      attributecount: byte;
+      attributecount: word;
       attributeindex: byte;
-      attributeslab : tasmsymbol;
 
     begin
-      attributeslab := nil;
       if def.typ = objectdef then
         begin
           if assigned(tobjectdef(def).rtti_attributesdef) then
-            begin
-              attributecount:=tobjectdef(def).rtti_attributesdef.get_attribute_count;
-              attributeslab:=current_asmdata.DefineAsmSymbol(tstoreddef(def).rtti_mangledname(attribute),AB_GLOBAL,AT_DATA);
-              current_asmdata.asmlists[al_rtti].concat(Tai_symbol.Create_global(attributeslab,0));
-              current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(attributecount));
-
-              for attributeindex:=0 to attributecount-1 do
-                begin
-                  current_asmdata.asmlists[al_rtti].concat(Tai_const.createname(trtti_attribute(tobjectdef(def).rtti_attributesdef.rtti_attributes[attributeindex]).symbolname,0));
-                end;
-            end
+            attributecount:=tobjectdef(def).rtti_attributesdef.get_attribute_count
           else
             attributecount:=0;
         end
       else
         attributecount:=0;
 
-      current_asmdata.asmlists[al_ext_rtti].concat(Tai_const.Create_sym(attributeslab));
+      current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_16bit(attributecount));
+
+      if attributecount>0 then
+        for attributeindex:=0 to attributecount-1 do
+          begin
+            current_asmdata.asmlists[al_rtti].concat(Tai_const.createname(trtti_attribute(tobjectdef(def).rtti_attributesdef.rtti_attributes[attributeindex]).symbolname,0));
+          end;
     end;
 
     procedure TRTTIWriter.write_rtti_extrasyms(def:Tdef;rt:Trttitype;mainrtti:Tasmsymbol);
@@ -1313,9 +1288,6 @@ implementation
         rttilab:=current_asmdata.DefineAsmSymbol(tstoreddef(def).rtti_mangledname(rt),AB_GLOBAL,AT_DATA);
         maybe_new_object_file(current_asmdata.asmlists[al_rtti]);
         new_section(current_asmdata.asmlists[al_rtti],sec_rodata,rttilab.name,const_align(sizeof(pint)));
-        { write reference to extended rtti }
-        if rt=fullrtti then
-          current_asmdata.asmlists[al_rtti].concat(Tai_const.Createname(tstoreddef(def).rtti_mangledname(extrtti),0));
 
         current_asmdata.asmlists[al_rtti].concat(Tai_symbol.Create_global(rttilab,0));
         write_rtti_data(def,rt);
@@ -1342,8 +1314,34 @@ implementation
       end;
 
     procedure TRTTIWriter.start_write_unit_extrtti_info;
+      var
+        start_extrtti_symbollist,
+        end_extrtti_symbollist    : TAsmSymbol;
+        s                         : string;
       begin
-        new_section(current_asmdata.asmlists[al_ext_rtti],sec_extrtti,make_mangledname('EXTR',current_module.localsymtable,''),const_align(sizeof(pint)));
+        new_section(current_asmdata.asmlists[al_ext_rtti],sec_extrtti,make_mangledname('EXTRU',current_module.localsymtable,''),const_align(sizeof(pint)));
+
+        { Make symbol that point to the start of the TUnitInfo }
+        current_module.extrttiinfo := current_asmdata.DefineAsmSymbol(make_mangledname('EXTRU_',current_module.localsymtable,''),AB_GLOBAL,AT_DATA);
+        current_asmdata.asmlists[al_ext_rtti].Concat(Tai_symbol.Create_global(current_module.extrttiinfo,0));
+
+        { write TUnitInfo }
+
+        { Make symbols for the start and the end of the symbol-list, so that
+          the linker can calculate the size of the structure. This because
+          some types could be omitted due to smart-linking }
+        start_extrtti_symbollist := current_asmdata.DefineAsmSymbol(make_mangledname('EXTR',current_module.localsymtable,''),AB_GLOBAL,AT_DATA);
+        end_extrtti_symbollist := current_asmdata.DefineAsmSymbol(make_mangledname('EXTRE_',current_module.localsymtable,''),AB_GLOBAL,AT_DATA);
+        current_asmdata.AsmLists[al_ext_rtti].Concat(Tai_const.Create_rel_sym(aitconst_aint, start_extrtti_symbollist, end_extrtti_symbollist));
+
+        { Write the unit-name }
+        s := current_module.realmodulename^;
+        current_asmdata.AsmLists[al_ext_rtti].Concat(Tai_const.Create_8bit(length(s)));
+        current_asmdata.AsmLists[al_ext_rtti].Concat(Tai_string.Create(s));
+
+        maybe_write_align;
+
+        current_asmdata.AsmLists[al_ext_rtti].Concat(Tai_symbol.Create_global(start_extrtti_symbollist,0));
       end;
 
 
@@ -1358,29 +1356,10 @@ implementation
         unitname_item             : TLinkedListItem;
         s                         : string;
     begin
-      if st.extrtticount>0 then
+      if current_module.extrttiinfo<>nil then
         begin
-          { Make symbols for the start and the end of the unit-info, so that
-            the linker can calculate the size of the structure. This because
-            some types could be omitted due to smart-linking }
-          start_extrtti_symbollist := current_asmdata.DefineAsmSymbol(make_mangledname('EXTR',current_module.localsymtable,''),AB_GLOBAL,AT_DATA);
+          { Write the symbol to mark the end of the symbols-list }
           end_extrtti_symbollist := current_asmdata.DefineAsmSymbol(make_mangledname('EXTRE_',current_module.localsymtable,''),AB_GLOBAL,AT_DATA);
-          s := current_module.realmodulename^;
-
-          { Insert the TUnitInfo structure after the section-start, which is
-            added in start_write_unit_extrtti_info }
-          first_item := current_asmdata.asmlists[al_ext_rtti].First.Next;
-          start_extrtti_item := Tai_symbol.Create_global(start_extrtti_symbollist,0);
-          unitinfosize_item := Tai_const.Create_rel_sym(aitconst_aint, start_extrtti_symbollist, end_extrtti_symbollist);
-          unitnamelength_item := Tai_const.Create_8bit(length(s));
-          unitname_item := Tai_string.Create(s);
-
-          current_asmdata.asmlists[al_ext_rtti].InsertAfter(start_extrtti_item, first_item);
-          current_asmdata.asmlists[al_ext_rtti].InsertAfter(unitinfosize_item, start_extrtti_item);
-          current_asmdata.asmlists[al_ext_rtti].InsertAfter(unitnamelength_item, unitinfosize_item);
-          current_asmdata.asmlists[al_ext_rtti].InsertAfter(unitname_item, unitnamelength_item);
-
-          { Write the symbol to mark the end of the structure }
           current_asmdata.asmlists[al_ext_rtti].concat(Tai_symbol.Create_global(end_extrtti_symbollist,0));
           current_asmdata.asmlists[al_ext_rtti].concat(Tai_const.Create_8bit(0));
 

compiler/ngenutil.pas

@@ -658,7 +658,7 @@ implementation
        begin
          if (hp.u.flags and uf_extrtti) <> 0 then
            begin
-             unitinits.concat(Tai_const.Createname(make_mangledname('EXTR',hp.u.globalsymtable,''),0));
+             unitinits.concat(Tai_const.Createname(make_mangledname('EXTRU_',hp.u.globalsymtable,''),0));
              inc(count);
            end;
          hp:=tused_unit(hp.next);

compiler/ptype.pas

@@ -1679,8 +1679,10 @@ implementation
         { no Delphi-style RTTI }
         exit;
 {$endif jvm}
-        if st.symtabletype = globalsymtable then
-          st.extrtticount := 0;
+        { Always write the TUnitInfo, even if there is further no type
+          information for the module }
+        if current_module.extrttiinfo=nil then
+          RTTIWriter.start_write_unit_extrtti_info;
         for i:=0 to st.DefList.Count-1 do
           begin
             def:=tdef(st.DefList[i]);
@@ -1735,7 +1737,7 @@ implementation
                (ds_rtti_table_used in def.defstates) then
               RTTIWriter.write_rtti(def,fullrtti);
           end;
-        if st.symtabletype = globalsymtable then
+        if st.symtabletype = staticsymtable then
           RTTIWriter.after_write_unit_extrtti_info(st);
       end;
 

compiler/symbase.pas

@@ -101,7 +101,6 @@ interface
           { level of symtable, used for nested procedures }
           symtablelevel : byte;
           symtabletype  : TSymtabletype;
-          extrtticount : integer;
           constructor Create(const s:string);
           destructor  destroy;override;
           procedure freeinstance;override;

packages/fcl-base/src/rtti.pp

@@ -299,22 +299,22 @@ begin
       for TypeInd:=0 to l-1 do
         begin
         ExtRttiData := @UnitDataList^[TypeInd];
-        if Assigned(ExtRttiData^.TypeData) then
+        if Assigned(ExtRttiData^.TypeInfo) then
           begin
-          case ExtRttiData^.TypeData^.Kind of
-            tkClass   : ARttiType := TRttiInstanceType.Create(ExtRttiData^.TypeData);
+          case ExtRttiData^.TypeInfo^.Kind of
+            tkClass   : ARttiType := TRttiInstanceType.Create(ExtRttiData^.TypeInfo);
             tkSString,
             tkLString,
             tkAString,
             tkUString,
-            tkWString : ARttiType := TRttiStringType.Create(ExtRttiData^.TypeData);
-            tkFloat   : ARttiType := TRttiFloatType.Create(ExtRttiData^.TypeData);
+            tkWString : ARttiType := TRttiStringType.Create(ExtRttiData^.TypeInfo);
+            tkFloat   : ARttiType := TRttiFloatType.Create(ExtRttiData^.TypeInfo);
           else
-            ARttiType := TRttiType.Create(ExtRttiData^.TypeData);
+            ARttiType := TRttiType.Create(ExtRttiData^.TypeInfo);
           end; {case}
           end
         else
-          ARttiType := TRttiType.Create(ExtRttiData^.TypeData);
+          ARttiType := TRttiType.Create(ExtRttiData^.TypeInfo);
         FTypesList[UnitStartIndex+TypeInd] := ARttiType;
         end;
       end;
@@ -607,14 +607,14 @@ end;
 function TRttiType.GetAttributes: TAttributeArray;
 var
   i: Integer;
-  erd: PExtRTTIData;
+  ad: PAttributeData;
 begin
   if not FAttributesResolved then
     begin
-    erd := GetExtRTTIData(FTypeInfo);
-    setlength(FAttributes,FTypeData^.AttributeCount);
-    for i := 0 to FTypeData^.AttributeCount-1 do
-      FAttributes[i]:=GetClassAttribute(erd,i);
+    ad := GetAttributeData(FTypeInfo);
+    setlength(FAttributes,ad^.AttributeCount);
+    for i := 0 to ad^.AttributeCount-1 do
+      FAttributes[i]:=GetAttribute(ad,i);
     FAttributesResolved:=true;
     end;
   result := FAttributes;
@@ -629,7 +629,6 @@ function aligntoptr(p : pointer) : pointer;inline;
 {$endif FPC_REQUIRES_PROPER_ALIGNMENT}
    end;
 
-
 function TRttiType.GetProperties: TRttiPropertyArray;
 var
   propcount: integer;
@@ -638,8 +637,10 @@ var
   TypeInfo: PTypeInfo;
   TypeRttiType: TRttiType;
   TD: PTypeData;
+  PPD: PPropData;
   TP: PPropInfo;
   Count: longint;
+  AD: PAttributeData;
 begin
   if not FPropertiesResolved then
     begin
@@ -654,13 +655,12 @@ begin
         TD:=GetTypeData(TypeInfo);
 
         // published properties count for this object
-        TP:=aligntoptr(PPropInfo(aligntoptr((Pointer(@TD^.UnitName)+Length(TD^.UnitName)+1))));
         // skip the attribute-info if available
-        TP:=aligntoptr(pointer(TP)+(TD^.AttributeCount*sizeof(TAttributeProc)));
-        Count:=PWord(TP)^;
+        AD := GetAttributeData(TypeInfo);
+        PPD := PPropData(pointer(AD)+SizeOf(AD^.AttributeCount)+(AD^.AttributeCount*SizeOf(TAttributeProc)));
+        Count:=PPD^.PropCount;
         // Now point TP to first propinfo record.
-        Inc(Pointer(TP),SizeOF(Word));
-        TP:=aligntoptr(TP);
+        TP:=PPropInfo(@PPD^.PropList);
         While Count>0 do
           begin
             // Don't overwrite properties with the same name

rtl/inc/objpas.inc

@@ -930,13 +930,15 @@
 
       class function TObject.UnitName : ansistring;
         type
-          // from the typinfo unit
+          TUnitInfo = packed record
+            UnitInfoSize: LongInt;
+            UnitName: shortstring;
+          end;
           TClassTypeInfo = {$ifndef FPC_REQUIRES_PROPER_ALIGNMENT}packed{$endif}record
             ClassType: TClass;
             ParentInfo: Pointer;
             PropCount: SmallInt;
-            AttributeCount : byte;
-            UnitName: ShortString;
+            UnitInfo: ^TUnitInfo;
           end;
           PClassTypeInfo = ^TClassTypeInfo;
         var
@@ -950,7 +952,7 @@
             {$ifdef FPC_REQUIRES_PROPER_ALIGNMENT}
             classtypeinfo:=align(classtypeinfo,sizeof(classtypeinfo));
             {$endif}
-            result:=classtypeinfo^.UnitName;
+            result:=classtypeinfo^.UnitInfo^.UnitName;
           end
           else
             result:='';

rtl/objpas/typinfo.pp

@@ -22,6 +22,7 @@ unit typinfo;
 
 {$MODE objfpc}
 {$inline on}
+{$modeswitch advancedrecords}
 {$h+}
 
   uses SysUtils;
@@ -105,6 +106,12 @@ unit typinfo;
       end;
 
 {$PACKRECORDS 1}
+      PUnitInfo = ^TUnitInfo;
+      TUnitInfo = packed record
+        UnitInfoSize: LongInt;
+        UnitName: shortstring;
+      end;
+
       TTypeInfo = record
          Kind : TTypeKind;
          Name : ShortString;
@@ -121,6 +128,7 @@ unit typinfo;
       packed
 {$endif FPC_REQUIRES_PROPER_ALIGNMENT}
       record
+         function UnitName: string;
          case TTypeKind of
             tkUnKnown,tkLString,tkWString,tkAString,tkVariant,tkUString:
               ();
@@ -149,10 +157,9 @@ unit typinfo;
               (ClassType : TClass;
                ParentInfo : PTypeInfo;
                PropCount : SmallInt;
-               AttributeCount : byte;
-               UnitName : ShortString
-               // here the attributes follow as array of TAttributeProc
-               // followed by the properties as array of TPropInfo
+               UnitInfo: PUnitInfo;
+               // AttributeData: TAttributeData;
+               // here the properties follow as TPropData
               );
             tkHelper:
               (HelperParent : PTypeInfo;
@@ -215,6 +222,7 @@ unit typinfo;
         PropCount : Word;
         PropList : record _alignmentdummy : ptrint; end;
       end;
+      PPropData = ^TPropData;
 {$PACKRECORDS 1}
 
       PPropInfo = ^TPropInfo;
@@ -242,32 +250,25 @@ unit typinfo;
 
       TAttributeProc = function : TCustomAttribute;
       PAttributeProcList = ^TAttributeProcList;
-      TAttributeProcList = array[0..255] of TAttributeProc;
+      TAttributeProcList = array[0..$ffff] of TAttributeProc;
 
       PPropList = ^TPropList;
       TPropList = array[0..65535] of PPropInfo;
 
-      TClassAttributeData = record
-        AttributeCount: byte;
+      TAttributeData = record
+        AttributeCount: word;
         AttributesList: TAttributeProcList;
       end;
-      PClassAttributeData = ^TClassAttributeData;
+      PAttributeData = ^TAttributeData;
 
       TExtRTTIData = record
-        TypeData: PTypeInfo;
-        AttributeData: PClassAttributeData;
+        TypeInfo: PTypeInfo;
       end;
       PExtRTTIData = ^TExtRTTIData;
 
       PextRTTIDataList = ^TExtRTTIDataList;
       TExtRTTIDataList = array[0..65535] of TExtRTTIData;
 
-      PUnitInfo = ^TUnitInfo;
-      TUnitInfo = packed record
-        UnitInfoSize: LongInt;
-        UnitName: shortstring;
-      end;
-
       PUnitInfoList = ^TUnitInfoList;
       TUnitInfoList = record
         UnitCount: IntPtr;
@@ -390,7 +391,8 @@ procedure SetRawInterfaceProp(Instance: TObject; PropInfo: PPropInfo; const Valu
 
 // Extended RTTI
 function GetUnitList: PUnitInfoList;
-function GetExtRTTIData(TypeInfo : PTypeInfo) : PExtRTTIData;
+
+function GetAttributeData(TypeInfo: PTypeInfo): PAttributeData;
 
 function GetRTTIDataListForUnit(AUnitInfo: PUnitInfo): PExtRTTIDataList;
 function GetRTTIDataCountForUnit(AUnitInfo: PUnitInfo): longint;
@@ -398,9 +400,7 @@ function GetRTTIDataCountForUnit(AUnitInfo: PUnitInfo): longint;
 function GetPropAttributeProclist(PropInfo: PPropInfo): PAttributeProcList;
 function GetPropAttribute(PropInfo: PPropInfo; AttributeNr: byte): TObject;
 
-function GetClassAttributeCount(ExtRTTIData: PExtRTTIData): byte;
-function GetClassAttributeProclist(ExtRTTIData: PExtRTTIData): PAttributeProcList;
-function GetClassAttribute(ExtRTTIData: PExtRTTIData; AttributeNr: byte): TCustomAttribute;
+function GetAttribute(AttributeData: PAttributeData; AttributeNr: byte): TCustomAttribute;
 
 // Auxiliary routines, which may be useful
 Function GetEnumName(TypeInfo : PTypeInfo;Value : Integer) : string;
@@ -439,6 +439,15 @@ uses rtlconsts;
 type
   PMethod = ^TMethod;
 
+{ ---------------------------------------------------------------------
+  TTypeData methods
+  ---------------------------------------------------------------------}
+
+function TTypeData.UnitName: string;
+begin
+  result := UnitInfo^.UnitName
+end;
+
 { ---------------------------------------------------------------------
   Auxiliary methods
   ---------------------------------------------------------------------}
@@ -466,21 +475,21 @@ begin
 {$endif FPC_HAS_EXTENDED_RTTI}
 end;
 
-function GetExtRTTIData(TypeInfo: PTypeInfo): PExtRTTIData;
+function GetAttributeData(TypeInfo: PTypeInfo): PAttributeData;
 var
-  p: pointer;
+  TD: PTypeData;
 begin
-  p := pointer(TypeInfo) - sizeof(p);
-  result := PExtRTTIData(pointer(p)^);
+  td := GetTypeData(TypeInfo);
+  Result:=PAttributeData(aligntoptr(pointer(@TD^.UnitInfo)+sizeof(TD^.UnitInfo)));
 end;
 
 function GetRTTIDataListForUnit(AUnitInfo: PUnitInfo): PExtRTTIDataList;
 var
   p: pointer;
 begin
-  p := AUnitInfo;
-  inc(p,length(AUnitInfo^.UnitName)+1+sizeof(LongInt));
-  p := align(p,sizeof(p));
+  p := @AUnitInfo^.UnitName;
+  inc(p,length(AUnitInfo^.UnitName)+1);
+  p := aligntoptr(p);
   GetRTTIDataListForUnit := pExtRTTIDataList(p);
 end;
 
@@ -488,8 +497,7 @@ function GetRTTIDataCountForUnit(AUnitInfo: PUnitInfo): longint;
 var
   p: PtrInt;
 begin
-  p := PtrInt(GetRTTIDataListForUnit(AUnitInfo))-PtrInt(AUnitInfo);
-  GetRTTIDataCountForUnit := (AUnitInfo^.UnitInfoSize-p) div SizeOf(TExtRTTIData);
+  GetRTTIDataCountForUnit := (AUnitInfo^.UnitInfoSize) div SizeOf(TExtRTTIData);
 end;
 
 function GetPropAttributeProclist(PropInfo: PPropInfo): PAttributeProcList;
@@ -515,33 +523,15 @@ begin
     end;
 end;
 
-
-function GetClassAttributeCount(ExtRTTIData: PExtRTTIData): byte;
-begin
-  if not assigned(ExtRTTIData^.AttributeData) then
-    result := 0
-  else
-    result := ExtRTTIData^.AttributeData^.AttributeCount;
-end;
-
-function GetClassAttributeProclist(ExtRTTIData: PExtRTTIData): PAttributeProcList;
-begin
-  if GetClassAttributeCount(ExtRTTIData) = 0 then
-    result := nil
-  else
-    result := @ExtRTTIData^.AttributeData^.AttributesList;
-end;
-
-function GetClassAttribute(ExtRTTIData: PExtRTTIData; AttributeNr: byte): TCustomAttribute;
+function GetAttribute(AttributeData: PAttributeData; AttributeNr: byte): TCustomAttribute;
 var
-  AttributeProcList: PAttributeProcList;
+  AttributeProcList: TAttributeProcList;
 begin
-  if AttributeNr>=GetClassAttributeCount(ExtRTTIData) then
+  if AttributeNr>=AttributeData^.AttributeCount then
     result := nil
   else
     begin
-      AttributeProcList := GetClassAttributeProclist(ExtRTTIData);
-      result := AttributeProcList^[AttributeNr]();
+      result := AttributeData^.AttributesList[AttributeNr]();
     end;
 end;
 
@@ -749,23 +739,27 @@ end;
 { ---------------------------------------------------------------------
   Basic Type information functions.
   ---------------------------------------------------------------------}
+function GetPropData(TypeInfo : PTypeInfo; TypeData: PTypeData) : PPropData;
+var
+  AD: PAttributeData;
+begin
+  AD := GetAttributeData(TypeInfo);
+  result := PPropData(pointer(AD)+SizeOf(AD^.AttributeCount)+(AD^.AttributeCount*SizeOf(TAttributeProc)));
+end;
 
 Function GetPropInfo(TypeInfo : PTypeInfo;const PropName : string) : PPropInfo;
 var
   hp : PTypeData;
   i : longint;
   p : shortstring;
-  pd : ^TPropData;
+  pd : PPropData;
 begin
   P:=PropName;  // avoid Ansi<->short conversion in a loop
   while Assigned(TypeInfo) do
     begin
       // skip the name
       hp:=GetTypeData(Typeinfo);
-      // the class info rtti the property rtti follows immediatly
-      pd:=aligntoptr(pointer(pointer(@hp^.UnitName)+Length(hp^.UnitName)+1));
-      // also skip the attribute-information
-      pd:=aligntoptr(pointer(pd)+(hp^.AttributeCount*sizeof(TAttributeProc)));
+      pd := GetPropData(TypeInfo,hp);
       Result:=PPropInfo(@pd^.PropList);
       for i:=1 to pd^.PropCount do
         begin
@@ -895,9 +889,7 @@ begin
   repeat
     TD:=GetTypeData(TypeInfo);
     // published properties count for this object
-    TP:=aligntoptr(PPropInfo(aligntoptr((Pointer(@TD^.UnitName)+Length(TD^.UnitName)+1))));
-    // skip the attribute-info if available
-    TP:=aligntoptr(pointer(TP)+(TD^.AttributeCount*sizeof(TAttributeProc)));
+    TP:=PPropInfo(GetPropData(TypeInfo, TD));
     Count:=PWord(TP)^;
     // Now point TP to first propinfo record.
     Inc(Pointer(TP),SizeOF(Word));

tests/test/tclassattribute1.pp

@@ -19,7 +19,7 @@ type
   end;
 
 var
-  rtd: PExtRTTIData;
+  ad: PAttributeData;
   AClassAttribute: TCustomAttribute;
 
 { tmyt }
@@ -30,11 +30,11 @@ begin
 end;
 
 begin
-  rtd := GetExtRTTIData(TMyObject.ClassInfo);
-  if GetClassAttributeCount(rtd)<>1 then
+  ad := GetAttributeData(TMyObject.ClassInfo);
+  if ad^.AttributeCount<>1 then
     halt(1);
 
-  AClassAttribute := GetClassAttribute(rtd,0) as TCustomAttribute;
+  AClassAttribute := GetAttribute(ad,0);
   if AClassAttribute = nil then
     halt(2);
   writeln('ok');

tests/test/tclassattribute4.pp

@@ -23,7 +23,7 @@ type
   end;
 
 var
-  rtd: PExtRTTIData;
+  rtd: PAttributeData;
   AClassAttribute: tmyt;
 
 { tmyt }
@@ -34,18 +34,18 @@ begin
 end;
 
 begin
-  rtd := GetExtRTTIData(TMyObject.ClassInfo);
+  rtd := GetAttributeData(TMyObject.ClassInfo);
 
-  if GetClassAttributeCount(rtd)<>2 then
+  if rtd^.AttributeCount<>2 then
     halt(1);
 
-  AClassAttribute := GetClassAttribute(rtd,1) as tmyt;
+  AClassAttribute := GetAttribute(rtd,1) as tmyt;
   if AClassAttribute = nil then
     halt(2);
   if AClassAttribute.FID<>1425 then
     halt(3);
 
-  AClassAttribute := GetClassAttribute(rtd,0) as tmyt;
+  AClassAttribute := GetAttribute(rtd,0) as tmyt;
   if AClassAttribute = nil then
     halt(2);
   if AClassAttribute.FID<>924 then

tests/test/tclassattribute8.pp

@@ -1,3 +1,4 @@
+{ %fail }
 program tclassattribute8;
 
 {$mode objfpc}{$H+}