* as attributes can be part of any type they are best suited in a common part of TTypeData

git-svn-id: trunk@42375 -

compiler/ncgrtti.pas

@@ -56,6 +56,7 @@ interface
           in the same unit as the current one }
         function ref_rtti(def:tdef;rt:trttitype;indirect:boolean;suffix:tsymstr):tasmsymbol;
         procedure write_rtti_name(tcb: ttai_typedconstbuilder; def: tdef);
+        procedure write_common_rtti_data(tcb:ttai_typedconstbuilder;def:tdef;rt:trttitype);
         procedure write_rtti_data(tcb: ttai_typedconstbuilder; def:tdef; rt: trttitype);
         procedure write_attribute_data(tcb: ttai_typedconstbuilder;attr_list:trtti_attribute_list);
         procedure write_child_rtti_data(def:tdef;rt:trttitype);
@@ -301,6 +302,7 @@ implementation
           InternalError(201012211);
         tcb.emit_tai(Tai_const.Create_8bit(typekind),u8inttype);
         tcb.emit_shortstring_const(name);
+
         tcb.end_anonymous_record;
       end;
 
@@ -565,6 +567,28 @@ implementation
            tcb.emit_shortstring_const('');
       end;
 
+
+    procedure TRTTIWriter.write_common_rtti_data(tcb:ttai_typedconstbuilder;def:tdef;rt:trttitype);
+      begin
+        { important: we need to align this the same way as the type data itself
+          is aligned }
+       tcb.begin_anonymous_record(
+          internaltypeprefixName[itp_rtti_common_data],
+          defaultpacking,reqalign,
+          targetinfos[target_info.system]^.alignment.recordalignmin,
+          targetinfos[target_info.system]^.alignment.maxCrecordalign);
+        if rt<>fullrtti then
+          begin
+            write_attribute_data(tcb,nil);
+          end
+        else
+          begin
+            write_attribute_data(tcb,tstoreddef(def).rtti_attribute_list);
+          end;
+        tcb.end_anonymous_record;
+      end;
+
+
     { writes a 32-bit count followed by array of field infos for given symtable }
     procedure TRTTIWriter.fields_write_rtti_data(tcb: ttai_typedconstbuilder; def: tabstractrecorddef; rt: trttitype);
       var
@@ -918,11 +942,13 @@ implementation
         begin
           tcb.emit_ord_const(tkUnknown,u8inttype);
           write_rtti_name(tcb,def);
+          write_common_rtti_data(tcb,def,rt);
         end;
 
         procedure variantdef_rtti(def:tvariantdef);
         begin
           write_header(tcb,def,tkVariant);
+          write_common_rtti_data(tcb,def,rt);
         end;
 
         procedure stringdef_rtti(def:tstringdef);
@@ -931,6 +957,7 @@ implementation
             st_ansistring:
               begin
                 write_header(tcb,def,tkAString);
+                write_common_rtti_data(tcb,def,rt);
                 { align }
                 tcb.begin_anonymous_record(
                   internaltypeprefixName[itp_rtti_ansistr],
@@ -942,17 +969,27 @@ implementation
               end;
 
             st_widestring:
-              write_header(tcb,def,tkWString);
+              begin
+                write_header(tcb,def,tkWString);
+                write_common_rtti_data(tcb,def,rt);
+              end;
 
             st_unicodestring:
-              write_header(tcb,def,tkUString);
+              begin
+                write_header(tcb,def,tkUString);
+                write_common_rtti_data(tcb,def,rt);
+              end;
 
             st_longstring:
-              write_header(tcb,def,tkLString);
+              begin
+                write_common_rtti_data(tcb,def,rt);
+                write_header(tcb,def,tkLString);
+              end;
 
             st_shortstring:
               begin
                  write_header(tcb,def,tkSString);
+                 write_common_rtti_data(tcb,def,rt);
                  tcb.emit_ord_const(def.len,u8inttype);
               end;
           end;
@@ -964,6 +1001,7 @@ implementation
            hp : tenumsym;
         begin
           write_header(tcb,def,tkEnumeration);
+          write_common_rtti_data(tcb,def,rt);
           { align; the named fields are so that we can let the compiler
             calculate the string offsets later on }
           tcb.next_field_name:='size_start_rec';
@@ -1039,6 +1077,7 @@ implementation
               deftrans: byte;
           begin
             write_header(tcb,def,typekind);
+            write_common_rtti_data(tcb,def,rt);
             deftrans:=trans[def.ordtype];
             case deftrans of
               otUQWord,
@@ -1130,6 +1169,7 @@ implementation
             scurrency:
               begin
                 write_header(tcb,def,tkFloat);
+                write_common_rtti_data(tcb,def,rt);
                 tcb.begin_anonymous_record(
                   internaltypeprefixName[itp_1byte],
                   defaultpacking,reqalign,
@@ -1151,6 +1191,7 @@ implementation
              (ftSingle,ftDouble,ftExtended,ftExtended,ftComp,ftCurr,ftFloat128);
         begin
            write_header(tcb,def,tkFloat);
+           write_common_rtti_data(tcb,def,rt);
            tcb.begin_anonymous_record(
              internaltypeprefixName[itp_1byte],
              defaultpacking,reqalign,
@@ -1164,6 +1205,7 @@ implementation
         procedure setdef_rtti(def:tsetdef);
         begin
            write_header(tcb,def,tkSet);
+           write_common_rtti_data(tcb,def,rt);
            tcb.begin_anonymous_record(
              internaltypeprefixName[itp_rtti_set_outer],
              defaultpacking,reqalign,
@@ -1203,6 +1245,7 @@ implementation
            else
              tcb.emit_ord_const(tkArray,u8inttype);
            write_rtti_name(tcb,def);
+           write_common_rtti_data(tcb,def,rt);
 
            if not(ado_IsDynamicArray in def.arrayoptions) then
              begin
@@ -1275,6 +1318,7 @@ implementation
         procedure classrefdef_rtti(def:tclassrefdef);
         begin
           write_header(tcb,def,tkClassRef);
+          write_common_rtti_data(tcb,def,rt);
           tcb.begin_anonymous_record(
             internaltypeprefixName[itp_rtti_ref],
             defaultpacking,reqalign,
@@ -1287,6 +1331,7 @@ implementation
         procedure pointerdef_rtti(def:tpointerdef);
         begin
           write_header(tcb,def,tkPointer);
+          write_common_rtti_data(tcb,def,rt);
           tcb.begin_anonymous_record(
             internaltypeprefixName[itp_rtti_ref],
             defaultpacking,reqalign,
@@ -1344,6 +1389,7 @@ implementation
 
         begin
            write_header(tcb,def,tkRecord);
+           write_common_rtti_data(tcb,def,rt);
            { need extra reqalign record, because otherwise the u32 int will
              only be aligned to 4 even on 64 bit target (while the rtti code
              in typinfo expects alignments to sizeof(pointer)) }
@@ -1427,6 +1473,7 @@ implementation
             begin
                { write method id and name }
                write_header(tcb,def,tkMethod);
+               write_common_rtti_data(tcb,def,rt);
                tcb.begin_anonymous_record('',defaultpacking,reqalign,
                  targetinfos[target_info.system]^.alignment.recordalignmin,
                  targetinfos[target_info.system]^.alignment.maxCrecordalign);
@@ -1469,6 +1516,7 @@ implementation
           else
             begin
               write_header(tcb,def,tkProcvar);
+              write_common_rtti_data(tcb,def,rt);
               tcb.begin_anonymous_record('',defaultpacking,reqalign,
                 targetinfos[target_info.system]^.alignment.recordalignmin,
                 targetinfos[target_info.system]^.alignment.maxCrecordalign);
@@ -1558,9 +1606,6 @@ implementation
             { total number of unique properties }
             tcb.emit_ord_const(propnamelist.count,u16inttype);
 
-            { TAttributeData }
-            write_attribute_data(tcb, def.rtti_attribute_list);
-
             { write unit name }
             tcb.emit_shortstring_const(current_module.realmodulename^);
 
@@ -1654,6 +1699,8 @@ implementation
            { generate the name }
            tcb.emit_shortstring_const(def.objrealname^);
 
+           write_common_rtti_data(tcb,def,rt);
+
            tcb.begin_anonymous_record('',defaultpacking,reqalign,
              targetinfos[target_info.system]^.alignment.recordalignmin,
              targetinfos[target_info.system]^.alignment.maxCrecordalign);

compiler/symconst.pas

@@ -730,6 +730,7 @@ type
     itp_vmt_afterconstruction_local,
     itp_rttidef,
     itp_rtti_header,
+    itp_rtti_common_data,
     itp_rtti_prop,
     itp_rtti_ansistr,
     itp_rtti_ord_outer,
@@ -870,6 +871,7 @@ inherited_objectoptions : tobjectoptions = [oo_has_virtual,oo_has_private,oo_has
        '$vmt_afterconstruction_local',
        '$rttidef$',
        '$rtti_header$',
+       '$rtti_common_data$',
        '$rtti_prop$',
        '$rtti_ansistr$',
        '$rtti_ord_outer$',

rtl/inc/dynarr.inc

@@ -39,6 +39,9 @@ type
 
 {$endif FPC_REQUIRES_PROPER_ALIGNMENT}
    record
+     {$if declared(TRttiDataCommon)}
+     common: TRttiDataCommon;
+     {$endif declared TRttiDataCommon}
      elSize : SizeUInt;
      {$ifdef VER3_0}
      elType2 : Pointer;

rtl/inc/objpas.inc

@@ -979,6 +979,7 @@
       class function TObject.UnitName : {$ifdef FPC_HAS_FEATURE_ANSISTRINGS}ansistring{$else FPC_HAS_FEATURE_ANSISTRINGS}shortstring{$endif FPC_HAS_FEATURE_ANSISTRINGS};
         type
           TClassTypeInfo = {$ifndef FPC_REQUIRES_PROPER_ALIGNMENT}packed{$endif}record
+            Attributes: Pointer;
             ClassType: TClass;
             ParentInfo: Pointer;
             PropCount: SmallInt;

rtl/inc/rttidecl.inc

@@ -67,6 +67,9 @@ type
   packed
 {$endif USE_PACKED}
   record
+{$if declared(TRttiDataCommon)}
+    Common: TRttiDataCommon;
+{$endif declared TRttiDataCommon}
 {$ifndef VER3_0}
     InitTable: Pointer;
 {$endif VER3_0}
@@ -116,6 +119,9 @@ type
   packed
 {$endif USE_PACKED}
   record
+{$if declared(TRttiDataCommon)}
+    Common: TRttiDataCommon;
+{$endif declared TRttiDataCommon}
     Terminator: Pointer;
     Size: Longint;
 {$ifndef VER3_0}
@@ -135,6 +141,9 @@ type
   packed
 {$endif USE_PACKED}
   record
+{$if declared(TRttiDataCommon)}
+    Common: TRttiDataCommon;
+{$endif declared TRttiDataCommon}
     Size: SizeInt;
     ElCount: SizeInt;
 {$ifdef VER3_0}

rtl/inc/system.inc

@@ -488,6 +488,19 @@ function aligntoqword(p : pointer) : pointer;inline;
                   Run-Time Type Information (RTTI) declarations
 ****************************************************************************}
 
+{$if defined(FPC_HAS_FEATURE_RTTI) or defined(FPC_HAS_FEATURE_DYNARRAYS)}
+{$if not defined(VER3_0) and not defined(VER3_2)}
+type
+  TRttiDataCommon =
+{$ifdef FPC_REQUIRES_PROPER_ALIGNMENT}
+  packed
+{$endif}
+  record
+    Attrs: Pointer;
+  end;
+{$endif not VER3_0 and not VER3_2}
+{$endif FPC_HAS_FEATURE_RTTI or FPC_HAS_FEATURE_DYNARRAYS}
+
 {$ifdef FPC_HAS_FEATURE_RTTI}
 {$i rttidecl.inc}
 {$endif FPC_HAS_FEATURE_RTTI}

rtl/objpas/typinfo.pp

@@ -451,6 +451,7 @@ unit TypInfo;
       packed
       {$endif FPC_REQUIRES_PROPER_ALIGNMENT}
       record
+        AttributeTable : PAttributeTable;
         Terminator: Pointer;
         Size: Integer;
 {$ifndef VER3_0}
@@ -472,6 +473,7 @@ unit TypInfo;
         function GetPropertyTable: PPropData; inline;
         function GetMethodTable: PIntfMethodTable; inline;
       public
+        AttributeTable : PAttributeTable;
         Parent: PPTypeInfo;
         Flags: TIntfFlagsBase;
         GUID: TGUID;
@@ -496,6 +498,7 @@ unit TypInfo;
         function GetPropertyTable: PPropData; inline;
         function GetMethodTable: PIntfMethodTable; inline;
       public
+        AttributeTable : PAttributeTable;
         Parent: PPTypeInfo;
         Flags : TIntfFlagsBase;
         IID: TGUID;
@@ -519,10 +522,10 @@ unit TypInfo;
         function GetUnitName: ShortString; inline;
         function GetPropertyTable: PPropData; inline;
       public
+        AttributeTable : PAttributeTable;
         ClassType : TClass;
         Parent : PPTypeInfo;
         PropCount : SmallInt;
-        AttributeTable : PAttributeTable;
         property UnitName: ShortString read GetUnitName;
         property PropertyTable: PPropData read GetPropertyTable;
       private
@@ -579,6 +582,7 @@ unit TypInfo;
         { tkPointer }
         property RefType: PTypeInfo read GetRefType;
       public
+         AttributeTable : PAttributeTable;
          case TTypeKind of
             tkUnKnown,tkLString,tkWString,tkVariant,tkUString:
               ();
@@ -625,7 +629,6 @@ unit TypInfo;
               (ClassType : TClass;
                ParentInfoRef : TypeInfoPtr;
                PropCount : SmallInt;
-               AttributeTable : PAttributeTable;
                UnitName : ShortString;
                // here the properties follow as array of TPropInfo
               );
@@ -980,13 +983,8 @@ function GetAttributeTable(TypeInfo: PTypeInfo): PAttributeTable;
 var
   TD: PTypeData;
 begin
-  if TypeInfo^.Kind<>tkClass then
-    result := nil
-  else
-    begin
-      TD := GetTypeData(TypeInfo);
-      Result:=TD^.AttributeTable;
-    end;
+  TD := GetTypeData(TypeInfo);
+  Result:=TD^.AttributeTable;
 end;
 
 function GetPropData(TypeInfo : PTypeInfo; TypeData: PTypeData) : PPropData; inline;