* more fixes to rtti after attribute branch merging

git-svn-id: trunk@42476 -

compiler/ncgrtti.pas

@@ -1178,8 +1178,13 @@ implementation
              defaultpacking,reqalign,
              targetinfos[target_info.system]^.alignment.recordalignmin);
            write_common_rtti_data(tcb,def,rt);
+           tcb.begin_anonymous_record(
+             internaltypeprefixName[itp_rtti_float],
+             defaultpacking,reqalign,
+             targetinfos[target_info.system]^.alignment.recordalignmin);
            tcb.emit_ord_const(translate[def.floattype],u8inttype);
            tcb.end_anonymous_record;
+           tcb.end_anonymous_record;
         end;
 
 
@@ -1249,7 +1254,13 @@ implementation
                  internaltypeprefixName[itp_rtti_normal_array]+tostr(dimcount),
                  defaultpacking,reqalign,
                  targetinfos[target_info.system]^.alignment.recordalignmin);
+
                write_common_rtti_data(tcb,def,rt);
+
+               tcb.begin_anonymous_record(internaltypeprefixName[itp_rtti_normal_array_inner]+tostr(dimcount),
+                 defaultpacking,reqalign,
+                 targetinfos[target_info.system]^.alignment.recordalignmin);
+
                { total size = elecount * elesize of the first arraydef }
                tcb.emit_tai(Tai_const.Create_sizeint(def.elecount*def.elesize),sizeuinttype);
                { total element count }
@@ -1280,7 +1291,15 @@ implementation
                  internaltypeprefixName[itp_rtti_dyn_array],
                  defaultpacking,reqalign,
                  targetinfos[target_info.system]^.alignment.recordalignmin);
+
                write_common_rtti_data(tcb,def,rt);
+
+               { record in TypInfo is aligned differently from init rtti }
+               tcb.begin_anonymous_record(
+                 internaltypeprefixName[itp_rtti_dyn_array_inner],
+                 defaultpacking,reqalign,
+                 targetinfos[target_info.system]^.alignment.recordalignmin);
+
                { size of elements }
                tcb.emit_tai(Tai_const.Create_sizeint(def.elesize),sizeuinttype);
                { element type }
@@ -1295,6 +1314,8 @@ implementation
                { write unit name }
                tcb.emit_shortstring_const(current_module.realmodulename^);
              end;
+
+          tcb.end_anonymous_record;
           tcb.end_anonymous_record;
         end;
 
@@ -1306,8 +1327,13 @@ implementation
             defaultpacking,reqalign,
             targetinfos[target_info.system]^.alignment.recordalignmin);
           write_common_rtti_data(tcb,def,rt);
+          tcb.begin_anonymous_record(
+            internaltypeprefixName[itp_rtti_classref],
+            defaultpacking,reqalign,
+            targetinfos[target_info.system]^.alignment.recordalignmin);
           write_rtti_reference(tcb,def.pointeddef,rt);
           tcb.end_anonymous_record;
+          tcb.end_anonymous_record;
         end;
 
         procedure pointerdef_rtti(def:tpointerdef);
@@ -1318,8 +1344,13 @@ implementation
             defaultpacking,reqalign,
             targetinfos[target_info.system]^.alignment.recordalignmin);
           write_common_rtti_data(tcb,def,rt);
+          tcb.begin_anonymous_record(
+            internaltypeprefixName[itp_rtti_pointer],
+            defaultpacking,reqalign,
+            targetinfos[target_info.system]^.alignment.recordalignmin);
           write_rtti_reference(tcb,def.pointeddef,rt);
           tcb.end_anonymous_record;
+          tcb.end_anonymous_record;
         end;
 
         procedure recorddef_rtti(def:trecorddef);
@@ -1339,7 +1370,7 @@ implementation
 
             tcb.begin_anonymous_record(
               rttilab.Name,
-              defaultpacking,reqalign,
+              defaultpacking,min(reqalign,SizeOf(PInt)),
               targetinfos[target_info.system]^.alignment.recordalignmin
             );
 
@@ -1372,15 +1403,19 @@ implementation
            { 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)) }
-           tcb.begin_anonymous_record('',defaultpacking,reqalign,
+           tcb.begin_anonymous_record('',
+             defaultpacking,reqalign,
              targetinfos[target_info.system]^.alignment.recordalignmin);
 
            write_common_rtti_data(tcb,def,rt);
 
+           tcb.begin_anonymous_record('',
+             defaultpacking,reqalign,
+             targetinfos[target_info.system]^.alignment.recordalignmin);
            { store special terminator for init table for more optimal rtl operations
              strictly related to RecordRTTI procedure in rtti.inc (directly 
              related to RTTIRecordRttiInfoToInitInfo function) }
-           if (rt=initrtti) then
+           if rt=initrtti then
              tcb.emit_tai(Tai_const.Create_nil_dataptr,voidpointertype)
            else
              { we use a direct reference as the init RTTI is always in the same
@@ -1390,7 +1425,7 @@ implementation
            tcb.emit_ord_const(def.size,u32inttype);
 
            { store rtti management operators only for init table }
-           if (rt=initrtti) then
+           if rt=initrtti then
              begin
                { for now records don't have the initializer table }
                tcb.emit_tai(Tai_const.Create_nil_dataptr,voidpointertype);
@@ -1404,6 +1439,7 @@ implementation
 
            fields_write_rtti_data(tcb,def,rt);
            tcb.end_anonymous_record;
+           tcb.end_anonymous_record;
 
            { write pointers to operators if needed }
            if (rt=initrtti) and (trecordsymtable(def.symtable).managementoperators<>[]) then
@@ -1457,6 +1493,9 @@ implementation
 
                write_common_rtti_data(tcb,def,rt);
 
+               tcb.begin_anonymous_record('',
+                 defaultpacking,reqalign,
+                 targetinfos[target_info.system]^.alignment.recordalignmin);
                { write kind of method }
                methodkind:=write_methodkind(tcb,def);
 
@@ -1491,6 +1530,7 @@ implementation
                      write_rtti_reference(tcb,tparavarsym(def.paras[i]).vardef,fullrtti);
                  end;
                tcb.end_anonymous_record;
+               tcb.end_anonymous_record;
             end
           else
             begin
@@ -1500,6 +1540,9 @@ implementation
 
               write_common_rtti_data(tcb,def,rt);
 
+              tcb.begin_anonymous_record('',
+                defaultpacking,reqalign,
+                targetinfos[target_info.system]^.alignment.recordalignmin);
               { flags }
               tcb.emit_ord_const(0,u8inttype);
               { write calling convention }
@@ -1512,6 +1555,7 @@ implementation
               for i:=0 to def.paras.count-1 do
                 write_procedure_param(tparavarsym(def.paras[i]));
               tcb.end_anonymous_record;
+              tcb.end_anonymous_record;
             end;
         end;
 
@@ -1520,6 +1564,9 @@ implementation
 
           procedure objectdef_rtti_fields(def:tobjectdef);
           begin
+            tcb.begin_anonymous_record('',defaultpacking,reqalign,
+              targetinfos[target_info.system]^.alignment.recordalignmin);
+
             { - for compatiblity with record RTTI we need to write a terminator-
                 Nil pointer for initrtti as well for objects
               - for RTTI consistency for objects we need point from fullrtti
@@ -1549,6 +1596,8 @@ implementation
               end;
             { enclosing record takes care of alignment }
             fields_write_rtti_data(tcb,def,rt);
+
+            tcb.end_anonymous_record;
           end;
 
           procedure objectdef_rtti_interface_init(def:tobjectdef);
@@ -1564,6 +1613,9 @@ implementation
             propnamelist:=TFPHashObjectList.Create;
             collect_propnamelist(propnamelist,def);
 
+            tcb.begin_anonymous_record('',defaultpacking,reqalign,
+              targetinfos[target_info.system]^.alignment.recordalignmin);
+
             if not is_objectpascal_helper(def) then
               if (oo_has_vmt in def.objectoptions) then
                 tcb.emit_tai(
@@ -1591,6 +1643,8 @@ implementation
             { write published properties for this object }
             published_properties_write_rtti_data(tcb,propnamelist,def.symtable);
 
+            tcb.end_anonymous_record;
+
             propnamelist.free;
           end;
 
@@ -1691,6 +1745,9 @@ implementation
                end;
              fullrtti :
                begin
+                 tcb.begin_anonymous_record('',
+                   defaultpacking,reqalign,
+                   targetinfos[target_info.system]^.alignment.recordalignmin);
                  case def.objecttype of
                    odt_helper,
                    odt_class:
@@ -1700,6 +1757,7 @@ implementation
                  else
                    objectdef_rtti_interface_full(def);
                  end;
+                 tcb.end_anonymous_record;
                end;
              else
                ;

compiler/symconst.pas

@@ -738,7 +738,12 @@ type
     itp_rtti_ord_inner,
     itp_rtti_ord_64bit,
     itp_rtti_normal_array,
+    itp_rtti_normal_array_inner,
     itp_rtti_dyn_array,
+    itp_rtti_dyn_array_inner,
+    itp_rtti_pointer,
+    itp_rtti_classref,
+    itp_rtti_float,
     itp_rtti_proc_param,
     itp_rtti_enum_size_start_rec,
     itp_rtti_enum_size_start_rec2,
@@ -748,6 +753,8 @@ type
     itp_rtti_set_outer,
     itp_rtti_set_middle,
     itp_rtti_set_inner,
+    itp_rtti_record,
+    itp_rtti_record_inner,
     itp_init_record_operators,
     itp_init_mop_offset_entry,
     itp_threadvar_record,
@@ -883,7 +890,12 @@ inherited_objectoptions : tobjectoptions = [oo_has_virtual,oo_has_private,oo_has
        '$rtti_ord_inner$',
        '$rtti_ord_64bit$',
        '$rtti_normal_array$',
+       '$rtti_normal_array_inner$',
        '$rtti_dyn_array$',
+       '$rtti_dyn_array_inner$',
+       '$rtti_dyn_pointer$',
+       '$rtti_dyn_classref$',
+       '$rtti_dyn_float$',
        '$rtti_proc_param$',
        '$rtti_enum_size_start_rec$',
        '$rtti_enum_size_start_rec2$',
@@ -893,6 +905,8 @@ inherited_objectoptions : tobjectoptions = [oo_has_virtual,oo_has_private,oo_has
        '$rtti_set_outer$',
        '$rtti_set_middle$',
        '$rtti_set_inner$',
+       '$rtti_record$',
+       '$rtti_record_inner$',
        '$init_record_operators$',
        '$init_mop_offset_entry$',
        '$threadvar_record$',

rtl/inc/dynarr.inc

@@ -42,18 +42,25 @@ type
      {$if declared(TRttiDataCommon)}
      common: TRttiDataCommon;
      {$endif declared TRttiDataCommon}
-     elSize : SizeUInt;
-     {$ifdef VER3_0}
-     elType2 : Pointer;
-     {$else}
-     elType2 : PPointer;
-     {$endif}
-     varType : Longint;
-     {$ifdef VER3_0}
-     elType : Pointer;
-     {$else}
-     elType : PPointer;
-     {$endif}
+     case TTypeKind of
+       tkArray: (
+         elSize : SizeUInt;
+         {$ifdef VER3_0}
+         elType2 : Pointer;
+         {$else}
+         elType2 : PPointer;
+         {$endif}
+         varType : Longint;
+         {$ifdef VER3_0}
+         elType : Pointer;
+         {$else}
+         elType : PPointer;
+         {$endif}
+       );
+       { include for proper alignment }
+       tkInt64: (
+         dummy : Int64
+       );
    end;
 
 procedure fpc_dynarray_rangecheck(p : pointer;i : tdynarrayindex);[Public,Alias:'FPC_DYNARRAY_RANGECHECK']; compilerproc;

rtl/inc/rtti.inc

@@ -127,7 +127,8 @@ begin
   typeInfo:=aligntoqword(typeInfo+2+PByte(typeInfo)[1]);
 {$endif VER3_0}
   Count:=PRecordInfoInit(typeInfo)^.Count;
-  Inc(PRecordInfoInit(typeInfo));
+  { Get element info, hacky, but what else can we do? }
+  typeInfo:=Pointer(@PRecordInfoInit(typeInfo)^.Count)+SizeOf(PRecordInfoInit(typeInfo)^.Count);
   { Process elements }
   for i:=1 to count Do
     begin
@@ -332,7 +333,7 @@ var
   Temp: pbyte;
   copiedsize,
   expectedoffset,
-  count,
+  EleCount,
   offset,
   i: SizeInt;
   info: pointer;
@@ -365,15 +366,15 @@ begin
         Result:=PArrayInfo(Temp)^.Size*PArrayInfo(Temp)^.ElCount;
       {$else}
         Result:=PArrayInfo(Temp)^.Size;
-        Count:=PArrayInfo(Temp)^.ElCount;
+        EleCount:=PArrayInfo(Temp)^.ElCount;
         { no elements to process => exit }
-        if Count = 0 then
+        if EleCount = 0 then
           Exit;
         Info:=PArrayInfo(Temp)^.ElInfo{$ifndef VER3_0}^{$endif};
-        copiedsize:=Result div Count;
+        copiedsize:=Result div EleCount;
         Offset:=0;
         { Process elements }
-        for I:=1 to Count do
+        for I:=1 to EleCount do
           begin
             fpc_Copy_internal(Src+Offset,Dest+Offset,Info);
             inc(Offset,copiedsize);
@@ -400,16 +401,14 @@ begin
           recordop^.Copy(Src,Dest)
         else
           begin
-            Result:=Size;
-            Inc(PRecordInfoInit(Temp));
-{$else VER3_0}
-            Result:=PRecordInfoFull(Temp)^.Size;
-            Count:=PRecordInfoFull(Temp)^.Count;
-            Inc(PRecordInfoFull(Temp));
 {$endif VER3_0}
+            Result:=PRecordInfoFull(Temp)^.Size;
+            EleCount:=PRecordInfoFull(Temp)^.Count;
+            { Get element info, hacky, but what else can we do? }
+            Temp:=Pointer(@PRecordInfoFull(Temp)^.Count)+SizeOf(PRecordInfoFull(Temp)^.Count);
             expectedoffset:=0;
             { Process elements with rtti }
-            for i:=1 to Count Do
+            for i:=1 to EleCount Do
               begin
                 Info:=PRecordElement(Temp)^.TypeInfo{$ifndef VER3_0}^{$endif};
                 Offset:=PRecordElement(Temp)^.Offset;

rtl/inc/rttidecl.inc

@@ -70,12 +70,19 @@ type
 {$if declared(TRttiDataCommon)}
     Common: TRttiDataCommon;
 {$endif declared TRttiDataCommon}
+    case TTypeKind of
+      tkRecord: (
 {$ifndef VER3_0}
-    InitTable: Pointer;
+        InitTable: Pointer;
 {$endif VER3_0}
-    Size: Longint;
-    Count: Longint;
-    { Elements: array[count] of TRecordElement }
+        Size: Longint;
+        Count: Longint;
+        { Elements: array[count] of TRecordElement }
+      );
+      { include for proper alignment }
+      tkInt64: (
+        dummy : Int64
+      );
   end;
 
   PRecordInfoInit=^TRecordInfoInit;
@@ -122,14 +129,21 @@ type
 {$if declared(TRttiDataCommon)}
     Common: TRttiDataCommon;
 {$endif declared TRttiDataCommon}
-    Terminator: Pointer;
-    Size: Longint;
+    case TTypeKind of
+      tkRecord: (
+        Terminator: Pointer;
+        Size: Longint;
 {$ifndef VER3_0}
-    InitRecordOpTable: PRTTIRecordOpOffsetTable;
-    RecordOp: PRTTIRecordOpVMT;
+        InitRecordOpTable: PRTTIRecordOpOffsetTable;
+        RecordOp: PRTTIRecordOpVMT;
 {$endif VER3_0}
-    Count: Longint;
-    { Elements: array[count] of TRecordElement }
+        Count: Longint;
+        { Elements: array[count] of TRecordElement }
+      );
+      { include for proper alignment }
+      tkInt64: (
+        dummy : Int64
+      );
   end;
 {$else VER3_0}
   TRecordInfoInit=TRecordInfoFull;
@@ -144,15 +158,22 @@ type
 {$if declared(TRttiDataCommon)}
     Common: TRttiDataCommon;
 {$endif declared TRttiDataCommon}
-    Size: SizeInt;
-    ElCount: SizeInt;
+    case TTypeKind of
+      tkArray: (
+        Size: SizeInt;
+        ElCount: SizeInt;
 {$ifdef VER3_0}
-    ElInfo: Pointer;
+        ElInfo: Pointer;
 {$else}
-    ElInfo: PPointer;
+        ElInfo: PPointer;
 {$endif}
-    DimCount: Byte;
-    Dims:array[0..255] of Pointer;
+        DimCount: Byte;
+        Dims:array[0..255] of Pointer;
+      );
+      { include for proper alignment }
+      tkInt64: (
+        dummy : Int64
+      );
   end;
 
 

rtl/objpas/typinfo.pp

@@ -470,14 +470,21 @@ unit TypInfo;
         {$ifdef PROVIDE_ATTR_TABLE}
         AttributeTable : PAttributeTable;
         {$endif}
-        Terminator: Pointer;
-        Size: Integer;
+        case TTypeKind of
+          tkRecord: (
+            Terminator: Pointer;
+            Size: Integer;
 {$ifndef VER3_0}
-        InitOffsetOp: PRecOpOffsetTable;
-        ManagementOp: Pointer;
+            InitOffsetOp: PRecOpOffsetTable;
+            ManagementOp: Pointer;
 {$endif}
-        ManagedFieldCount: Integer;
-        { ManagedFields: array[0..ManagedFieldCount - 1] of TInitManagedField ; }
+            ManagedFieldCount: Integer;
+          { ManagedFields: array[0..ManagedFieldCount - 1] of TInitManagedField ; }
+          );
+          { include for proper alignment }
+          tkInt64: (
+            dummy : Int64
+          );
       end;
 
       PInterfaceData = ^TInterfaceData;
@@ -491,19 +498,31 @@ unit TypInfo;
         function GetPropertyTable: PPropData; inline;
         function GetMethodTable: PIntfMethodTable; inline;
       public
-        {$ifdef PROVIDE_ATTR_TABLE}
-        AttributeTable : PAttributeTable;
-        {$endif}
-        Parent: PPTypeInfo;
-        Flags: TIntfFlagsBase;
-        GUID: TGUID;
         property UnitName: ShortString read GetUnitName;
         property PropertyTable: PPropData read GetPropertyTable;
         property MethodTable: PIntfMethodTable read GetMethodTable;
-      private
-        UnitNameField: ShortString;
-        { PropertyTable: TPropData }
-        { MethodTable: TIntfMethodTable }
+      public
+      {$ifdef PROVIDE_ATTR_TABLE}
+        AttributeTable : PAttributeTable;
+      {$endif}
+      case TTypeKind of
+        tkInterface: (
+          Parent: PPTypeInfo;
+          Flags: TIntfFlagsBase;
+          GUID: TGUID;
+          UnitNameField: ShortString;
+          { PropertyTable: TPropData }
+          { MethodTable: TIntfMethodTable }
+        );
+        { include for proper alignment }
+        tkInt64: (
+          dummy : Int64
+        );
+{$ifndef FPUNONE}
+        tkFloat:
+          (FloatType : TFloatType
+        );
+{$endif}
       end;
 
       PInterfaceRawData = ^TInterfaceRawData;
@@ -518,20 +537,32 @@ unit TypInfo;
         function GetPropertyTable: PPropData; inline;
         function GetMethodTable: PIntfMethodTable; inline;
       public
-        {$ifdef PROVIDE_ATTR_TABLE}
-        AttributeTable : PAttributeTable;
-        {$endif}
-        Parent: PPTypeInfo;
-        Flags : TIntfFlagsBase;
-        IID: TGUID;
         property UnitName: ShortString read GetUnitName;
         property IIDStr: ShortString read GetIIDStr;
         property PropertyTable: PPropData read GetPropertyTable;
         property MethodTable: PIntfMethodTable read GetMethodTable;
-      private
-        UnitNameField: ShortString;
-        { IIDStr: ShortString; }
-        { PropertyTable: TPropData }
+      public
+      case TTypeKind of
+        tkInterface: (
+        {$ifdef PROVIDE_ATTR_TABLE}
+          AttributeTable : PAttributeTable;
+        {$endif}
+          Parent: PPTypeInfo;
+          Flags : TIntfFlagsBase;
+          IID: TGUID;
+          UnitNameField: ShortString;
+          { IIDStr: ShortString; }
+          { PropertyTable: TPropData }
+        );
+        { include for proper alignment }
+        tkInt64: (
+          dummy : Int64
+        );
+{$ifndef FPUNONE}
+        tkFloat:
+          (FloatType : TFloatType
+        );
+{$endif}
       end;
 
       PClassData = ^TClassData;