Browse Source

* Added TUnitInfo.UnitOptions, to determine if there is attribute-
information for this unit
* Do not generate any attribute-rtti information for units without any
attributes defined

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

joost 12 years ago
parent
commit
c6707fecef
6 changed files with 41 additions and 8 deletions
  1. 4 0
      compiler/fmodule.pas
  2. 8 2
      compiler/ncgrtti.pas
  3. 2 0
      compiler/pdecl.pas
  4. 4 1
      packages/fcl-base/src/rtti.pp
  5. 1 0
      rtl/inc/objpas.inc
  6. 22 5
      rtl/objpas/typinfo.pp

+ 4 - 0
compiler/fmodule.pas

@@ -68,6 +68,9 @@ interface
       );
       );
       tmoduleoptions = set of tmoduleoption;
       tmoduleoptions = set of tmoduleoption;
 
 
+      trtti_moduleoption = (rmo_hasattributes);
+      trtti_moduleoptions = set of trtti_moduleoption;
+
       tlinkcontaineritem=class(tlinkedlistitem)
       tlinkcontaineritem=class(tlinkedlistitem)
       public
       public
          data : TPathStr;
          data : TPathStr;
@@ -182,6 +185,7 @@ interface
 
 
         { contains a reference to the TUnitInfo rtti information for this module }
         { contains a reference to the TUnitInfo rtti information for this module }
         extrttiinfo : TAsmSymbol;
         extrttiinfo : TAsmSymbol;
+        rtti_options : trtti_moduleoptions;
 
 
         { contains a list of types that are extended by helper types; the key is
         { 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
           the full name of the type and the data is a TFPObjectList of

+ 8 - 2
compiler/ncgrtti.pas

@@ -836,8 +836,11 @@ implementation
             write_unitinfo_reference;
             write_unitinfo_reference;
 
 
             { TAttributeData }
             { TAttributeData }
-            maybe_write_align;
-            write_attribute_data(def);
+            if rmo_hasattributes in current_module.rtti_options then
+              begin
+                maybe_write_align;
+                write_attribute_data(def);
+              end;
 
 
             { write published properties for this object }
             { write published properties for this object }
             current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_16bit(published_properties_count(def.symtable)));
             current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_16bit(published_properties_count(def.symtable)));
@@ -1334,6 +1337,9 @@ implementation
         end_extrtti_symbollist := current_asmdata.DefineAsmSymbol(make_mangledname('EXTRE_',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));
         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))));
+
         { Write the unit-name }
         { Write the unit-name }
         s := current_module.realmodulename^;
         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_const.Create_8bit(length(s)));

+ 2 - 0
compiler/pdecl.pas

@@ -423,6 +423,8 @@ implementation
           if not assigned(rtti_attributes) then
           if not assigned(rtti_attributes) then
             rtti_attributes := trtti_attributesdef.create;
             rtti_attributes := trtti_attributesdef.create;
           rtti_attributes.addattribute(typesym,p1);
           rtti_attributes.addattribute(typesym,p1);
+
+          Include(current_module.rtti_options, rmo_hasattributes);
           end;
           end;
         p.free;
         p.free;
         consume(_RECKKLAMMER);
         consume(_RECKKLAMMER);

+ 4 - 1
packages/fcl-base/src/rtti.pp

@@ -657,7 +657,10 @@ begin
         // published properties count for this object
         // published properties count for this object
         // skip the attribute-info if available
         // skip the attribute-info if available
         AD := GetAttributeData(TypeInfo);
         AD := GetAttributeData(TypeInfo);
-        PPD := PPropData(pointer(AD)+SizeOf(AD^.AttributeCount)+(AD^.AttributeCount*SizeOf(TAttributeProc)));
+        if assigned(AD) then
+          PPD := PPropData(pointer(AD)+SizeOf(AD^.AttributeCount)+(AD^.AttributeCount*SizeOf(TAttributeProc)))
+        else
+          PPD := PPropData((pointer(@TD^.UnitInfo)+sizeof(TD^.UnitInfo)));
         Count:=PPD^.PropCount;
         Count:=PPD^.PropCount;
         // Now point TP to first propinfo record.
         // Now point TP to first propinfo record.
         TP:=PPropInfo(@PPD^.PropList);
         TP:=PPropInfo(@PPD^.PropList);

+ 1 - 0
rtl/inc/objpas.inc

@@ -932,6 +932,7 @@
         type
         type
           TUnitInfo = packed record
           TUnitInfo = packed record
             UnitInfoSize: LongInt;
             UnitInfoSize: LongInt;
+            UnitOptions: byte;
             UnitName: shortstring;
             UnitName: shortstring;
           end;
           end;
           TClassTypeInfo = {$ifndef FPC_REQUIRES_PROPER_ALIGNMENT}packed{$endif}record
           TClassTypeInfo = {$ifndef FPC_REQUIRES_PROPER_ALIGNMENT}packed{$endif}record

+ 22 - 5
rtl/objpas/typinfo.pp

@@ -105,10 +105,14 @@ unit typinfo;
         Fields: array[0..0] of TVmtFieldEntry
         Fields: array[0..0] of TVmtFieldEntry
       end;
       end;
 
 
+      TRTTIUnitOption = (rmoHasAttributes);
+      TRTTIUnitOptions = set of TRTTIUnitOption;
+
 {$PACKRECORDS 1}
 {$PACKRECORDS 1}
       PUnitInfo = ^TUnitInfo;
       PUnitInfo = ^TUnitInfo;
       TUnitInfo = packed record
       TUnitInfo = packed record
         UnitInfoSize: LongInt;
         UnitInfoSize: LongInt;
+        UnitOptions: TRTTIUnitOptions;
         UnitName: shortstring;
         UnitName: shortstring;
       end;
       end;
 
 
@@ -479,8 +483,16 @@ function GetAttributeData(TypeInfo: PTypeInfo): PAttributeData;
 var
 var
   TD: PTypeData;
   TD: PTypeData;
 begin
 begin
-  td := GetTypeData(TypeInfo);
-  Result:=PAttributeData(aligntoptr(pointer(@TD^.UnitInfo)+sizeof(TD^.UnitInfo)));
+  if TypeInfo^.Kind<>tkClass then
+    result := nil
+  else
+    begin
+      TD := GetTypeData(TypeInfo);
+      if (rmoHasAttributes in td^.UnitInfo^.UnitOptions) then
+        Result:=PAttributeData(aligntoptr(pointer(@TD^.UnitInfo)+sizeof(TD^.UnitInfo)))
+      else
+        result := nil;
+    end;
 end;
 end;
 
 
 function GetRTTIDataListForUnit(AUnitInfo: PUnitInfo): PExtRTTIDataList;
 function GetRTTIDataListForUnit(AUnitInfo: PUnitInfo): PExtRTTIDataList;
@@ -527,7 +539,7 @@ function GetAttribute(AttributeData: PAttributeData; AttributeNr: byte): TCustom
 var
 var
   AttributeProcList: TAttributeProcList;
   AttributeProcList: TAttributeProcList;
 begin
 begin
-  if AttributeNr>=AttributeData^.AttributeCount then
+  if (AttributeData=nil) or (AttributeNr>=AttributeData^.AttributeCount) then
     result := nil
     result := nil
   else
   else
     begin
     begin
@@ -743,8 +755,13 @@ function GetPropData(TypeInfo : PTypeInfo; TypeData: PTypeData) : PPropData;
 var
 var
   AD: PAttributeData;
   AD: PAttributeData;
 begin
 begin
-  AD := GetAttributeData(TypeInfo);
-  result := PPropData(pointer(AD)+SizeOf(AD^.AttributeCount)+(AD^.AttributeCount*SizeOf(TAttributeProc)));
+  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;
 end;
 
 
 Function GetPropInfo(TypeInfo : PTypeInfo;const PropName : string) : PPropInfo;
 Function GetPropInfo(TypeInfo : PTypeInfo;const PropName : string) : PPropInfo;