* Do not generate a list of all types anymore, but get a list of all types

   by iterating over all rtti type-data. For this the GetFirstTypeinfoFromUnit
   and GetNextTypeInfo functions are introoduced
 * To ease iterating over the type data, the enumeration helper-tables are
   placed in the al_init asmlist
 * The type data sections are now sec_extrtti sections, so that the linker
   will maintain their order.

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

compiler/aasmdata.pas

@@ -58,7 +58,6 @@ interface
         al_resources,
         al_rtti,
         al_init,
-        al_ext_rtti,
         al_dwarf_frame,
         al_dwarf_info,
         al_dwarf_abbrev,
@@ -110,7 +109,6 @@ interface
         'al_resources',
         'al_rtti',
         'al_init',
-        'al_ext_rtti',
         'al_dwarf_frame',
         'al_dwarf_info',
         'al_dwarf_abbrev',

compiler/ncgrtti.pas

@@ -53,7 +53,6 @@ interface
         procedure write_string(const s: string;rt:trttitype);
         procedure maybe_write_align(rt:trttitype);
         procedure write_unitinfo_reference;
-        procedure write_ext_rtti(def:tdef;rt:trttitype);
         function  rtti_asmlist(rt:trttitype):TAsmListType;
       public
         procedure write_rtti(def:tdef;rt:trttitype);
@@ -113,12 +112,6 @@ implementation
         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));
-      end;
-
     function TRTTIWriter.rtti_asmlist(rt: trttitype): TAsmListType;
     begin
       if rt=initrtti then
@@ -1080,10 +1073,13 @@ implementation
           with current_asmdata do
             begin
               rttilab:=defineasmsymbol(Tstoreddef(def).rtti_mangledname(rt)+'_o2s',AB_GLOBAL,AT_DATA);
-              maybe_new_object_file(asmlists[al_rtti]);
-              new_section(asmlists[al_rtti],sec_rodata,rttilab.name,const_align(sizeof(pint)));
-              asmlists[al_rtti].concat(Tai_symbol.create_global(rttilab,0));
-              asmlists[al_rtti].concat(Tai_const.create_32bit(longint(mode)));
+              { Place this helper table in al_init, so that it is
+                not in the way while iterating through the typeinfo to get a
+                list of all types, as done in typinfo.GetNextTypeInfo }
+              maybe_new_object_file(asmlists[al_init]);
+              new_section(asmlists[al_init],sec_rodata,rttilab.name,const_align(sizeof(pint)));
+              asmlists[al_init].concat(Tai_symbol.create_global(rttilab,0));
+              asmlists[al_init].concat(Tai_const.create_32bit(longint(mode)));
               if mode=lookup then
                 begin
                   maybe_write_align(rt);
@@ -1092,26 +1088,26 @@ implementation
                     begin
                       while o<syms[i].value do
                         begin
-                          asmlists[al_rtti].concat(Tai_const.create_pint(0));
+                          asmlists[al_init].concat(Tai_const.create_pint(0));
                           inc(o);
                         end;
                       inc(o);
-                      asmlists[al_rtti].concat(Tai_const.create_sym_offset(mainrtti,st+offsets[i]));
+                      asmlists[al_init].concat(Tai_const.create_sym_offset(mainrtti,st+offsets[i]));
                     end;
                 end
               else
                 begin
                   maybe_write_align(rt);
-                  asmlists[al_rtti].concat(Tai_const.create_32bit(sym_count));
+                  asmlists[al_init].concat(Tai_const.create_32bit(sym_count));
                   for i:=0 to sym_count-1 do
                     begin
                       maybe_write_align(rt);
-                      asmlists[al_rtti].concat(Tai_const.create_32bit(syms[i].value));
+                      asmlists[al_init].concat(Tai_const.create_32bit(syms[i].value));
                       maybe_write_align(rt);
-                      asmlists[al_rtti].concat(Tai_const.create_sym_offset(mainrtti,st+offsets[i]));
+                      asmlists[al_init].concat(Tai_const.create_sym_offset(mainrtti,st+offsets[i]));
                     end;
                 end;
-              asmlists[al_rtti].concat(Tai_symbol_end.create(rttilab));
+              asmlists[al_init].concat(Tai_symbol_end.create(rttilab));
             end;
         end;
 
@@ -1128,21 +1124,24 @@ implementation
           with current_asmdata do
             begin
               rttilab:=defineasmsymbol(Tstoreddef(def).rtti_mangledname(rt)+'_s2o',AB_GLOBAL,AT_DATA);
-              maybe_new_object_file(asmlists[al_rtti]);
-              new_section(asmlists[al_rtti],sec_rodata,rttilab.name,const_align(sizeof(pint)));
-              asmlists[al_rtti].concat(Tai_symbol.create_global(rttilab,0));
-              asmlists[al_rtti].concat(Tai_const.create_32bit(sym_count));
+              { Place this helper table in al_init, so that it is
+                not in the way while iterating through the typeinfo to get a
+                list of all types, as done in typinfo.GetNextTypeInfo }
+              maybe_new_object_file(asmlists[al_init]);
+              new_section(asmlists[al_init],sec_rodata,rttilab.name,const_align(sizeof(pint)));
+              asmlists[al_init].concat(Tai_symbol.create_global(rttilab,0));
+              asmlists[al_init].concat(Tai_const.create_32bit(sym_count));
               { need to align the entry record according to the largest member }
               maybe_write_align(rt);
               for i:=0 to sym_count-1 do
                 begin
                   if (tf_requires_proper_alignment in target_info.flags) then
-                    current_asmdata.asmlists[al_rtti].concat(cai_align.Create(4));  // necessary?
-                  asmlists[al_rtti].concat(Tai_const.create_32bit(syms[i].value));
+                    current_asmdata.asmlists[al_init].concat(cai_align.Create(4));  // necessary?
+                  asmlists[al_init].concat(Tai_const.create_32bit(syms[i].value));
                   maybe_write_align(rt);
-                  asmlists[al_rtti].concat(Tai_const.create_sym_offset(mainrtti,st+offsets[i]));
+                  asmlists[al_init].concat(Tai_const.create_sym_offset(mainrtti,st+offsets[i]));
                 end;
-              asmlists[al_rtti].concat(Tai_symbol_end.create(rttilab));
+              asmlists[al_init].concat(Tai_symbol_end.create(rttilab));
             end;
         end;
 
@@ -1299,12 +1298,13 @@ implementation
         { write rtti data }
         rttilab:=current_asmdata.DefineAsmSymbol(tstoreddef(def).rtti_mangledname(rt),AB_GLOBAL,AT_DATA);
         maybe_new_object_file(current_asmdata.asmlists[rtti_asmlist(rt)]);
-        new_section(current_asmdata.asmlists[rtti_asmlist(rt)],sec_rodata,rttilab.name,const_align(sizeof(pint)));
+        if rt=fullrtti then
+          new_section(current_asmdata.asmlists[rtti_asmlist(rt)],sec_extrtti,make_mangledname('EXTRU',current_module.localsymtable,''),const_align(sizeof(pint)))
+        else
+          new_section(current_asmdata.asmlists[rtti_asmlist(rt)],sec_rodata,make_mangledname('EXTRU',current_module.localsymtable,''),const_align(sizeof(pint)));
 
         current_asmdata.asmlists[rtti_asmlist(rt)].concat(Tai_symbol.Create_global(rttilab,0));
         write_rtti_data(def,rt);
-        if rt=fullrtti then
-          write_ext_rtti(def, rt);
         current_asmdata.asmlists[rtti_asmlist(rt)].concat(Tai_symbol_end.Create(rttilab));
         write_rtti_extrasyms(def,rt,rttilab);
       end;
@@ -1327,36 +1327,25 @@ implementation
 
     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('EXTRU',current_module.localsymtable,''),const_align(sizeof(pint)));
+        new_section(current_asmdata.asmlists[al_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));
+        current_asmdata.asmlists[al_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 TRTTIUnitOptions }
-        current_asmdata.AsmLists[al_ext_rtti].Concat(tai_const.Create_8bit(byte(longint(current_module.rtti_options))));
+        current_asmdata.AsmLists[al_rtti].Concat(tai_const.Create_8bit(byte(longint(current_module.rtti_options))));
 
         { 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));
+        current_asmdata.AsmLists[al_rtti].Concat(Tai_const.Create_8bit(length(s)));
+        current_asmdata.AsmLists[al_rtti].Concat(Tai_string.Create(s));
 
         maybe_write_align(fullrtti);
-
-        current_asmdata.AsmLists[al_ext_rtti].Concat(Tai_symbol.Create_global(start_extrtti_symbollist,0));
       end;
 
 
@@ -1373,10 +1362,9 @@ implementation
     begin
       if current_module.extrttiinfo<>nil then
         begin
-          { 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);
-          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));
+          { Write a trailing 255 to mark the end of the symbols-list }
+          current_asmdata.asmlists[al_rtti].concat(cai_align.Create(sizeof(TConstPtrUInt)));
+          current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(255));
 
           current_module.flags:=current_module.flags+uf_extrtti;
         end;

packages/fcl-base/src/rtti.pp

@@ -319,49 +319,46 @@ var
   UnitList        : PUnitInfoList;
   UnitInd, TypeInd: longint;
   UnitInfo        : PUnitInfo;
-  UnitDataList    : PextRTTIDataList;
-  ExtRttiData     : PExtRTTIData;
+  TypeInfo        : PTypeInfo;
   TypelistUnitInd : longint;
   ARttiType       : TRttiType;
-  UnitStartIndex  : LongInt;
-  l               : LongInt;
+  Index           : longint;
 
 begin
   if not FAllTypesResolved then
     begin
-    UnitList:=GetUnitList;
-    TypelistUnitInd:=0;
-    SetLength(FTypesList,0);
-    for UnitInd:=0 to UnitList^.UnitCount-1 do
-      begin
-      UnitInfo := UnitList^.Units[UnitInd];
-      UnitDataList := GetRTTIDataListForUnit(UnitInfo);
-      l := GetRTTIDataCountForUnit(UnitInfo);
-      UnitStartIndex := length(FTypesList);
-      SetLength(FTypesList,UnitStartIndex+l);
-      for TypeInd:=0 to l-1 do
+      UnitList:=GetUnitList;
+      TypelistUnitInd:=0;
+      SetLength(FTypesList,0);
+      Index := -1;
+      for UnitInd:=0 to UnitList^.UnitCount-1 do
         begin
-        ExtRttiData := @UnitDataList^[TypeInd];
-        if Assigned(ExtRttiData^.TypeInfo) then
-          begin
-          case ExtRttiData^.TypeInfo^.Kind of
-            tkClass   : ARttiType := TRttiInstanceType.Create(ExtRttiData^.TypeInfo);
-            tkSString,
-            tkLString,
-            tkAString,
-            tkUString,
-            tkWString : ARttiType := TRttiStringType.Create(ExtRttiData^.TypeInfo);
-            tkFloat   : ARttiType := TRttiFloatType.Create(ExtRttiData^.TypeInfo);
-          else
-            ARttiType := TRttiType.Create(ExtRttiData^.TypeInfo);
-          end; {case}
-          end
-        else
-          ARttiType := TRttiType.Create(ExtRttiData^.TypeInfo);
-        FTypesList[UnitStartIndex+TypeInd] := ARttiType;
+          UnitInfo := UnitList^.Units[UnitInd];
+          TypeInfo := GetFirstTypeinfoFromUnit(UnitInfo);
+          while assigned(TypeInfo) do
+            begin
+              case TypeInfo^.Kind of
+                tkClass   : ARttiType := TRttiInstanceType.Create(TypeInfo);
+                tkSString,
+                tkLString,
+                tkAString,
+                tkUString,
+                tkWString : ARttiType := TRttiStringType.Create(TypeInfo);
+                tkFloat   : ARttiType := TRttiFloatType.Create(TypeInfo);
+              else
+                ARttiType := TRttiType.Create(TypeInfo);
+              end; {case}
+            end;
+
+          inc(index);
+          if index=length(FTypesList) then
+            setlength(FTypesList,length(FTypesList)+10);
+          FTypesList[Index] := ARttiType;
+
+          TypeInfo := GetNextTypeInfo(TypeInfo);
         end;
-      end;
-    FAllTypesResolved:=true;
+      FAllTypesResolved:=true;
+      setlength(FTypesList, index+1);
     end;
   result := FTypesList;
 end;

rtl/inc/objpas.inc

@@ -931,7 +931,6 @@
       class function TObject.UnitName : ansistring;
         type
           TUnitInfo = packed record
-            UnitInfoSize: LongInt;
             UnitOptions: byte;
             UnitName: shortstring;
           end;

rtl/objpas/typinfo.pp

@@ -111,7 +111,6 @@ unit typinfo;
 {$PACKRECORDS 1}
       PUnitInfo = ^TUnitInfo;
       TUnitInfo = packed record
-        UnitInfoSize: LongInt;
         UnitOptions: TRTTIUnitOptions;
         UnitName: shortstring;
       end;
@@ -265,14 +264,6 @@ unit typinfo;
       end;
       PAttributeData = ^TAttributeData;
 
-      TExtRTTIData = record
-        TypeInfo: PTypeInfo;
-      end;
-      PExtRTTIData = ^TExtRTTIData;
-
-      PextRTTIDataList = ^TExtRTTIDataList;
-      TExtRTTIDataList = array[0..65535] of TExtRTTIData;
-
       PUnitInfoList = ^TUnitInfoList;
       TUnitInfoList = record
         UnitCount: IntPtr;
@@ -395,12 +386,11 @@ procedure SetRawInterfaceProp(Instance: TObject; PropInfo: PPropInfo; const Valu
 
 // Extended RTTI
 function GetUnitList: PUnitInfoList;
+function GetFirstTypeinfoFromUnit(AUnitInfo: PUnitInfo): PTypeInfo;
+function GetNextTypeInfo(ATypeInfo: PTypeInfo): PTypeInfo;
 
 function GetAttributeData(TypeInfo: PTypeInfo): PAttributeData;
 
-function GetRTTIDataListForUnit(AUnitInfo: PUnitInfo): PExtRTTIDataList;
-function GetRTTIDataCountForUnit(AUnitInfo: PUnitInfo): longint;
-
 function GetPropAttributeProclist(PropInfo: PPropInfo): PAttributeProcList;
 function GetPropAttribute(PropInfo: PPropInfo; AttributeNr: byte): TObject;
 
@@ -495,21 +485,121 @@ begin
     end;
 end;
 
-function GetRTTIDataListForUnit(AUnitInfo: PUnitInfo): PExtRTTIDataList;
+function GetPropData(TypeInfo : PTypeInfo; TypeData: PTypeData) : PPropData;
 var
-  p: pointer;
+  AD: PAttributeData;
 begin
-  p := @AUnitInfo^.UnitName;
-  inc(p,length(AUnitInfo^.UnitName)+1);
-  p := aligntoptr(p);
-  GetRTTIDataListForUnit := pExtRTTIDataList(p);
+  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));
 end;
 
-function GetRTTIDataCountForUnit(AUnitInfo: PUnitInfo): longint;
-var
-  p: PtrInt;
+function GetFirstTypeinfoFromUnit(AUnitInfo: PUnitInfo): PTypeInfo;
 begin
-  GetRTTIDataCountForUnit := (AUnitInfo^.UnitInfoSize) div SizeOf(TExtRTTIData);
+  result := align(pointer(@AUnitInfo^.UnitName)+1+byte(AUnitInfo^.UnitName[0]), sizeof(Pointer));
+end;
+
+function GetNextTypeInfo(ATypeInfo: PTypeInfo): PTypeInfo;
+type
+  TEnumTableMode=(lookup,search);
+var
+  p: pointer;
+  td: PTypeData;
+  pd: ppropdata;
+  i: longint;
+  fc: longint;
+  minv,maxv: longint;
+  EnumTableMode: TEnumTableMode;
+  count: pword;
+begin
+  td := GetTypeData(ATypeInfo);
+  p := GetTypeData(ATypeInfo);
+  case ATypeInfo^.Kind of
+    tkEnumeration:
+               begin
+               p := aligntoptr(p + 1);     { OrdType }
+               minv := PLongInt(p)^;
+               p := p + SizeOf(LongInt); { MinValue }
+               maxv := PLongInt(p)^;
+               p := p + SizeOf(LongInt); { MaxValue }
+               p := p + SizeOf(PTypeInfo); { basetype }
+               for i := minv to maxv do
+                 p := p + 1 + pbyte(p)^; { NameList: shortstring length + length of string }
+               p := p + 1 + pbyte(p)^; { UnitName: shortstring length + length of string }
+               p := p + 1; { trailing zero }
+               end;
+    tkInteger,
+    tkChar,
+    tkWChar,
+    tkBool   : begin
+               p := aligntoptr(p + 1);     { OrdType }
+               p := p + SizeOf(LongInt) + SizeOf(LongInt); { MinValue + MaxValue }
+               end;
+    tkSet    : begin
+               p := aligntoptr(p + 1);     { OrdType }
+               p := p + sizeof(PTypeInfo); { CompType }
+               end;
+    tkQWord  : p := p + SizeOf(QWord) + SizeOf(QWord); { MinQWordValue, MaxQWordValue }
+    tkInt64  : p := p + SizeOf(Int64) + SizeOf(Int64); { MinInt64Value, MaxInt64Value }
+    tkSString: p := P + SizeOf(Byte); { MaxLength }
+    tkArray  : begin
+               p := p + sizeof(Ptrint); { Element size }
+               p := p + sizeof(PtrInt); { Element count }
+               p := p + sizeof(pointer); { Element type }
+               p := p + sizeof(longint); { Variant type }
+               end;
+    tkDynArray:begin
+               p := p + sizeof(Ptrint); { Element size }
+               p := p + sizeof(PtrInt); { Element type 2 }
+               p := p + sizeof(longint); { Variant type }
+               p := p + sizeof(pointer); { Element type }
+               p := p + 1 + pbyte(p)^; { unitname: shortstring length + length of string }
+               end;
+    tkFloat  : begin
+               p := p + sizeof(TFloatType); { Float type }
+               end;
+    tkObject,
+    tkRecord : begin
+               p := p + 4; { Size }
+               fc := plongint(p)^;
+               p := p + 4; { Fieldcount }
+               p := p + (fc * (sizeof(pointer) + 4)); { Fieldcount * (element type  + field offset) }
+               end;
+    tkClass  : 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);
+               end;
+    tkInterface :
+               begin
+               p := aligntoptr(pointer(@td^.IntfUnit)+byte(td^.IntfUnit[0])+1);
+               p := p+pbyte(p)^+1; { IIDStr }
+               end;
+    tkMethod : begin
+               p := @td^.ParamList[0];
+               for i := 0 to td^.ParamCount-1 do
+                 begin
+                 p := aligntoptr(p + sizeof(TParamFlags)); { TParamFlags }
+                 p := aligntoptr(p +pbyte(p)^+1); { paramname }
+                 p := aligntoptr(p +pbyte(p)^+1); { typename }
+                 end;
+               if td^.MethodKind in [mkFunction, mkClassFunction] then
+                 begin
+                 p := aligntoptr(p +pbyte(p)^+1); { resulttype }
+                 p := p + sizeof(PPTypeInfo); { resulttyperef }
+                 end;
+               p := aligntoptr(p + sizeof(TCallConv)); { cc }
+               p := p + (td^.ParamCount * sizeof(PPTypeInfo));
+               end;
+  end;
+  result := PTypeInfo(align(p,sizeof(p)));
+  if PByte(result)^=255 then
+    result := nil;
 end;
 
 function GetPropAttributeProclist(PropInfo: PPropInfo): PAttributeProcList;
@@ -751,18 +841,6 @@ end;
 { ---------------------------------------------------------------------
   Basic Type information functions.
   ---------------------------------------------------------------------}
-function GetPropData(TypeInfo : PTypeInfo; TypeData: PTypeData) : PPropData;
-var
-  AD: PAttributeData;
-begin
-  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));
-end;
 
 Function GetPropInfo(TypeInfo : PTypeInfo;const PropName : string) : PPropInfo;
 var