* integration of Part 2 patch of Mantis 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 -
This commit is contained in:
svenbarth 2016-12-13 23:03:11 +00:00
parent 43212c4507
commit 12dba952f0
5 changed files with 100 additions and 11 deletions

1
.gitattributes vendored
View File

@ -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

View File

@ -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);

View File

@ -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

View File

@ -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
tests/test/trtti10.pp Normal file
View File

@ -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.