Переглянути джерело

* integration of Part 2 patch of Mantis #30687 with a few adjustments:
- indentation in ncgrtti.pas
- fewer ifdefs in rtti.inc
- InitTable/Terminator field as first field to avoid padding on targets that require proper alignment and have SizeOf(Pointer) > 4

Original message by Maciej Izak:

Breaking change for rtti layout for record rtti. Init table
is always accessible from regular rtti. Rtti table contains indirect
reference to init table, additionally init table contains nil-terminator (for
rtl purposes - the only way to determine kind of info : init or rtti). Pros:

* will be possible to create more Delphi compatible code for RTTI, finally end-user can access to *real* managed fields of records (some work on TypInfo.pp is still required but is not necessary).
* important step forward for management operators (anyway this commit is not directly related to management operators)
* much more optimal memory allocation/initialization/finalization for records created/destroyed by InitializeArray/FinalizeArray, for example:

type
TBar = record
f1,f2,f3,f4,f5,f6,f7,f8,f9: byte;
s: string;
end;

previously:

GetMem(PB, SizeOf(TBar));
InitializeArray(PB, TypeInfo(TBar), 1); // FPC_INITIALIZE was executed 10 times

now:

GetMem(PB, SizeOf(TBar));
InitializeArray(PB, TypeInfo(TBar), 1); // FPC_INITIALIZE is executed just once

+ test attached

git-svn-id: trunk@35125 -

svenbarth 8 роки тому
батько
коміт
12dba952f0
5 змінених файлів з 100 додано та 11 видалено
  1. 1 0
      .gitattributes
  2. 26 0
      compiler/ncgrtti.pas
  3. 55 11
      rtl/inc/rtti.inc
  4. 3 0
      rtl/objpas/typinfo.pp
  5. 15 0
      tests/test/trtti10.pp

+ 1 - 0
.gitattributes

@@ -13006,6 +13006,7 @@ tests/test/trstr6.pp svneol=native#text/plain
 tests/test/trstr7.pp svneol=native#text/plain
 tests/test/trstr8.pp svneol=native#text/plain
 tests/test/trtti1.pp svneol=native#text/plain
+tests/test/trtti10.pp svneol=native#text/pascal
 tests/test/trtti2.pp svneol=native#text/plain
 tests/test/trtti3.pp svneol=native#text/plain
 tests/test/trtti4.pp svneol=native#text/plain

+ 26 - 0
compiler/ncgrtti.pas

@@ -851,9 +851,30 @@ implementation
            tcb.begin_anonymous_record('',defaultpacking,reqalign,
              targetinfos[target_info.system]^.alignment.recordalignmin,
              targetinfos[target_info.system]^.alignment.maxCrecordalign);
+
+           { 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
+             tcb.emit_tai(Tai_const.Create_nil_dataptr,voidpointertype)
+           else
+             begin
+               { point to more optimal init table }
+               include(def.defstates,ds_init_table_used);
+               write_rtti_reference(tcb,def,initrtti);
+             end;
+
            tcb.emit_ord_const(def.size,u32inttype);
+
            fields_write_rtti_data(tcb,def,rt);
            tcb.end_anonymous_record;
+
+           { guarantee initrtti for any record for fpc_initialize, fpc_finalize }
+           if (rt=fullrtti) and
+               (ds_init_table_used in def.defstates) and
+               not (ds_init_table_written in def.defstates)
+               then
+             write_rtti(def, initrtti);
         end;
 
 
@@ -1036,6 +1057,11 @@ implementation
 
           procedure objectdef_rtti_fields(def:tobjectdef);
           begin
+            { - for compatiblity with record RTTI we need to write a terminator-
+                Nil pointer as well for objects
+              - classes are assumed to have the same INIT RTTI as records
+                (see TObject.CleanupInstance) }
+            tcb.emit_tai(Tai_const.Create_nil_dataptr,voidpointertype);
             tcb.emit_ord_const(def.size, u32inttype);
             { enclosing record takes care of alignment }
             fields_write_rtti_data(tcb,def,rt);

+ 55 - 11
rtl/inc/rtti.inc

@@ -42,17 +42,36 @@ type
     {$endif}
   end;
 
-  PRecordInfo=^TRecordInfo;
-  TRecordInfo=
+  PRecordInfoFull=^TRecordInfoFull;
+  TRecordInfoFull=
 {$ifdef USE_PACKED}
   packed
 {$endif USE_PACKED}
   record
+{$ifndef VER3_0}
+    InitTable: PPointer;
+{$endif VER3_0}
     Size: Longint;
     Count: Longint;
     { Elements: array[count] of TRecordElement }
   end;
 
+  PRecordInfoInit=^TRecordInfoInit;
+{$ifndef VER3_0}
+  TRecordInfoInit=
+{$ifdef USE_PACKED}
+  packed
+{$endif USE_PACKED}
+  record
+    Terminator: Pointer;
+    Size: Longint;
+    Count: Longint;
+    { Elements: array[count] of TRecordElement }
+  end;
+{$else VER3_0}
+  TRecordInfoInit=TRecordInfoFull;
+{$endif VER3_0}
+
   PArrayInfo=^TArrayInfo;
   TArrayInfo=
 {$ifdef USE_PACKED}
@@ -83,7 +102,22 @@ end;
 function RTTIRecordSize(typeInfo: Pointer): SizeInt;
 begin
   typeInfo:=aligntoptr(typeInfo+2+PByte(typeInfo)[1]);
-  result:=PRecordInfo(typeInfo)^.Size;
+  { for size field init table is compatible with rtti table }
+  result:=PRecordInfoFull(typeInfo)^.Size;
+end;
+
+function RTTIRecordRttiInfoToInitInfo(typeInfo: Pointer): Pointer; inline;
+begin
+  result:=typeInfo;
+{$ifndef VER3_0}
+  { find init table }
+  typeInfo:=aligntoptr(typeInfo+2+PByte(typeInfo)[1]);
+
+  { check terminator, maybe we are already in init table }
+  if Assigned(PRecordInfoInit(typeInfo)^.Terminator) then
+    { point to more optimal initrtti }
+    result:=PRecordInfoFull(result)^.InitTable^;
+{$endif VER3_0}
 end;
 
 function RTTISize(typeInfo: Pointer): SizeInt;
@@ -112,8 +146,8 @@ var
   i : longint;
 begin
   typeInfo:=aligntoptr(typeInfo+2+PByte(typeInfo)[1]);
-  Count:=PRecordInfo(typeInfo)^.Count;
-  Inc(PRecordInfo(typeInfo));
+  Count:=PRecordInfoInit(typeInfo)^.Count;
+  Inc(PRecordInfoInit(typeInfo));
   { Process elements }
   for i:=1 to count Do
     begin
@@ -173,7 +207,10 @@ begin
     tkObject,
 {$endif FPC_HAS_FEATURE_OBJECTS}
     tkRecord:
-      recordrtti(data,typeinfo,@int_initialize);
+      begin
+        typeinfo:=RTTIRecordRttiInfoToInitInfo(typeinfo);
+        recordrtti(data,typeinfo,@int_initialize);
+      end;
 {$ifdef FPC_HAS_FEATURE_VARIANTS}
     tkVariant:
       variant_init(PVarData(Data)^);
@@ -203,7 +240,10 @@ begin
     tkObject,
 {$endif FPC_HAS_FEATURE_OBJECTS}
     tkRecord:
-      recordrtti(data,typeinfo,@int_finalize);
+      begin
+        typeinfo:=RTTIRecordRttiInfoToInitInfo(typeinfo);
+        recordrtti(data,typeinfo,@int_finalize);
+      end;
     tkInterface:
       Intf_Decr_Ref(PPointer(Data)^);
 {$ifdef FPC_HAS_FEATURE_DYNARRAYS}
@@ -239,7 +279,10 @@ begin
     tkobject,
 {$endif FPC_HAS_FEATURE_OBJECTS}
     tkrecord :
-      recordrtti(data,typeinfo,@int_addref);
+      begin
+        typeinfo:=RTTIRecordRttiInfoToInitInfo(typeinfo);
+        recordrtti(data,typeinfo,@int_addref);
+      end;
 {$ifdef FPC_HAS_FEATURE_DYNARRAYS}
     tkDynArray:
       fpc_dynarray_incr_ref(PPointer(Data)^);
@@ -311,11 +354,12 @@ begin
 {$endif FPC_HAS_FEATURE_OBJECTS}
     tkrecord:
       begin
+        typeInfo:=RTTIRecordRttiInfoToInitInfo(typeInfo);
         Temp:=aligntoptr(typeInfo+2+PByte(typeInfo)[1]);
 
-        Result:=PRecordInfo(Temp)^.Size;
-        Count:=PRecordInfo(Temp)^.Count;
-        Inc(PRecordInfo(Temp));
+        Result:=PRecordInfoInit(Temp)^.Size;
+        Count:=PRecordInfoInit(Temp)^.Count;
+        Inc(PRecordInfoInit(Temp));
         expectedoffset:=0;
         { Process elements with rtti }
         for i:=1 to count Do

+ 3 - 0
rtl/objpas/typinfo.pp

@@ -269,6 +269,9 @@ unit typinfo;
               );
             tkRecord:
               (
+{$ifndef VER3_0}
+                RecInitTable: PPointer;
+{$endif VER3_0}
                 RecSize: Integer;
                 ManagedFldCount: Integer;
                 {ManagedFields: array[1..ManagedFldCount] of TManagedField}

+ 15 - 0
tests/test/trtti10.pp

@@ -0,0 +1,15 @@
+program trtti10;
+
+{$MODE DELPHI}
+
+uses
+  TypInfo;
+
+type
+  TFoo = record
+  end;
+
+begin
+  if GetTypeData(TypeInfo(TFoo)).RecInitTable = nil then
+    Halt(1);
+end.