From 217ae6e4bbd0c927967c8d5d2effcb9f621ea89e Mon Sep 17 00:00:00 2001 From: florian Date: Sun, 21 Jul 2019 08:28:29 +0000 Subject: [PATCH] * more fixes to rtti after attribute branch merging git-svn-id: trunk@42476 - --- compiler/ncgrtti.pas | 66 +++++++++++++++++++++++++++++++--- compiler/symconst.pas | 14 ++++++++ rtl/inc/dynarr.inc | 31 +++++++++------- rtl/inc/rtti.inc | 25 +++++++------ rtl/inc/rttidecl.inc | 53 ++++++++++++++++++--------- rtl/objpas/typinfo.pp | 83 +++++++++++++++++++++++++++++-------------- 6 files changed, 201 insertions(+), 71 deletions(-) diff --git a/compiler/ncgrtti.pas b/compiler/ncgrtti.pas index 8088692210..11f2f0bceb 100644 --- a/compiler/ncgrtti.pas +++ b/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 ; diff --git a/compiler/symconst.pas b/compiler/symconst.pas index 6894409d52..f85bd692b4 100644 --- a/compiler/symconst.pas +++ b/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$', diff --git a/rtl/inc/dynarr.inc b/rtl/inc/dynarr.inc index 04a54678a2..72a6d7c451 100644 --- a/rtl/inc/dynarr.inc +++ b/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; diff --git a/rtl/inc/rtti.inc b/rtl/inc/rtti.inc index 46cae4c2dd..7ab12902bc 100644 --- a/rtl/inc/rtti.inc +++ b/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; diff --git a/rtl/inc/rttidecl.inc b/rtl/inc/rttidecl.inc index a141e193b9..207e8f8a91 100644 --- a/rtl/inc/rttidecl.inc +++ b/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; diff --git a/rtl/objpas/typinfo.pp b/rtl/objpas/typinfo.pp index f742fd465b..94604a6bb0 100644 --- a/rtl/objpas/typinfo.pp +++ b/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;