From d137e06ade00a851a5370367243c11fcc79043ea Mon Sep 17 00:00:00 2001 From: svenbarth Date: Fri, 12 Jul 2019 22:05:29 +0000 Subject: [PATCH] * instead of embedding the attributes inside the class' and property's type data only store a reference to a table of attributes git-svn-id: trunk@42365 - --- compiler/ncgrtti.pas | 80 ++++++++++++++++++----------- packages/rtl-objpas/src/inc/rtti.pp | 18 ++++--- rtl/objpas/typinfo.pp | 68 +++++++++++------------- 3 files changed, 90 insertions(+), 76 deletions(-) diff --git a/compiler/ncgrtti.pas b/compiler/ncgrtti.pas index 4ae22ed33a..0a5e90398f 100644 --- a/compiler/ncgrtti.pas +++ b/compiler/ncgrtti.pas @@ -57,7 +57,7 @@ interface function ref_rtti(def:tdef;rt:trttitype;indirect:boolean;suffix:tsymstr):tasmsymbol; procedure write_rtti_name(tcb: ttai_typedconstbuilder; def: tdef); procedure write_rtti_data(tcb: ttai_typedconstbuilder; def:tdef; rt: trttitype); - procedure write_attribute_data(tcb: ttai_typedconstbuilder; def:tdef); + procedure write_attribute_data(tcb: ttai_typedconstbuilder;attr_list:trtti_attribute_list); procedure write_unit_info_reference(tcb: ttai_typedconstbuilder); procedure write_child_rtti_data(def:tdef;rt:trttitype); procedure write_rtti_reference(tcb: ttai_typedconstbuilder; def: tdef; rt: trttitype); @@ -761,9 +761,6 @@ implementation proctypesinfo : byte; propnameitem : tpropnamelistitem; propdefname : string; - attridx: ShortInt; - attrcount: byte; - attr: trtti_attribute; procedure writeaccessproc(pap:tpropaccesslisttypes; shiftvalue : byte; unsetvalue: byte); var @@ -909,22 +906,12 @@ implementation tcb.emit_ord_const(propnameitem.propindex,u16inttype); tcb.emit_ord_const(proctypesinfo,u8inttype); - { Write property attribute count } - if assigned(tpropertysym(sym).rtti_attribute_list) then - attrcount:=tpropertysym(sym).rtti_attribute_list.get_attribute_count - else - attrcount:=0; - tcb.emit_ord_const(attrcount,u8inttype); + { write reference to attribute table } + write_attribute_data(tcb,tpropertysym(sym).rtti_attribute_list); { Write property name } tcb.emit_shortstring_const(tpropertysym(sym).realname); - { Write property attributes } - for attridx := 0 to attrcount-1 do - begin - attr := trtti_attribute(tpropertysym(sym).rtti_attribute_list.rtti_attributes[attridx]); - tcb.emit_tai(Tai_const.Createname(attr.symbolname,AT_DATA_FORCEINDIRECT,0), cpointerdef.getreusable(ttypesym(attr.typesym).typedef)); - end; tcb.end_anonymous_record; end; end; @@ -1583,7 +1570,7 @@ implementation { TAttributeData } if rmo_hasattributes in current_module.rtti_options then - write_attribute_data(tcb, def); + write_attribute_data(tcb, def.rtti_attribute_list); { write published properties for this object } published_properties_write_rtti_data(tcb,propnamelist,def.symtable); @@ -1746,26 +1733,57 @@ implementation end; end; - procedure TRTTIWriter.write_attribute_data(tcb: ttai_typedconstbuilder; def: tdef); + procedure TRTTIWriter.write_attribute_data(tcb:ttai_typedconstbuilder;attr_list:trtti_attribute_list); var - count: word; - idx: byte; - attr: trtti_attribute; + count, i: word; + attr : trtti_attribute; + tbltcb : ttai_typedconstbuilder; + tbllab : tasmlabel; + tbldef : tdef; begin - if (def.typ = objectdef) and (assigned(tobjectdef(def).rtti_attribute_list)) then - count:=tobjectdef(def).rtti_attribute_list.get_attribute_count + if assigned(attr_list) then + count:=attr_list.get_attribute_count else count:=0; - tcb.emit_ord_const(count,u16inttype); + if count=0 then + begin + { write a Nil reference } + tcb.emit_tai(Tai_const.Create_nil_dataptr,voidpointertype); + exit; + end; - if count>0 then - for idx:=0 to count-1 do - begin - attr := trtti_attribute(tobjectdef(def).rtti_attribute_list.rtti_attributes[idx]); - tcb.emit_tai(Tai_const.Createname(attr.symbolname,AT_DATA_FORCEINDIRECT,0), cpointerdef.getreusable(ttypesym(attr.typesym).typedef)); - end; - end; + { first write the attribute list as a separate table } + current_asmdata.getglobaldatalabel(tbllab); + + tbltcb:=ctai_typedconstbuilder.create([tcalo_is_lab,tcalo_make_dead_strippable,tcalo_apply_constalign]); + + tbltcb.begin_anonymous_record('',defaultpacking,min(reqalign,SizeOf(PInt)), + targetinfos[target_info.system]^.alignment.recordalignmin, + targetinfos[target_info.system]^.alignment.maxCrecordalign); + tbltcb.emit_ord_const(count,u16inttype); + for i:=0 to count-1 do + begin + tbltcb.begin_anonymous_record('',defaultpacking,min(reqalign,SizeOf(PInt)), + targetinfos[target_info.system]^.alignment.recordalignmin, + targetinfos[target_info.system]^.alignment.maxCrecordalign); + attr:=trtti_attribute(attr_list.rtti_attributes[i]); + + tbltcb.emit_tai(tai_const.Createname(attr.symbolname,AT_DATA_FORCEINDIRECT,0),cpointerdef.getreusable(ttypesym(attr.typesym).typedef)); + + tbltcb.end_anonymous_record; + end; + tbldef:=tbltcb.end_anonymous_record; + + current_asmdata.asmlists[al_rtti].concatlist( + tbltcb.get_final_asmlist(tbllab,tbldef,sec_rodata,tbllab.name,const_align(sizeof(pint))) + ); + + tbltcb.free; + + { write the reference to the attribute table } + tcb.emit_tai(Tai_const.Create_sym(tbllab),voidpointertype); + end; procedure TRTTIWriter.write_unit_info_reference(tcb: ttai_typedconstbuilder); begin diff --git a/packages/rtl-objpas/src/inc/rtti.pp b/packages/rtl-objpas/src/inc/rtti.pp index dcfc81c201..ed321d315b 100644 --- a/packages/rtl-objpas/src/inc/rtti.pp +++ b/packages/rtl-objpas/src/inc/rtti.pp @@ -3398,13 +3398,16 @@ end; function TRttiProperty.GetAttributes: specialize TArray; var i: Integer; + ad: PAttributeData; begin if not FAttributesResolved then begin - setlength(FAttributes,FPropInfo^.AttributeCount); - for i := 0 to FPropInfo^.AttributeCount-1 do + ad := FPropInfo^.AttributeTable; + if Assigned(ad) then begin - FAttributes[i]:=TCustomAttribute(GetPropAttribute(FPropInfo,i)); + SetLength(FAttributes, FPropInfo^.AttributeTable^.AttributeCount); + for i := 0 to High(FAttributes) do + FAttributes[i] := TCustomAttribute(GetPropAttribute(FPropInfo, i)); end; FAttributesResolved:=true; end; @@ -3631,9 +3634,12 @@ begin if not FAttributesResolved then begin ad := GetAttributeData(FTypeInfo); - setlength(FAttributes,ad^.AttributeCount); - for i := 0 to ad^.AttributeCount-1 do - FAttributes[i]:=GetAttribute(ad,i); + if Assigned(ad) then + begin + setlength(FAttributes,ad^.AttributeCount); + for i := 0 to ad^.AttributeCount-1 do + FAttributes[i]:=GetAttribute(ad,i); + end; FAttributesResolved:=true; end; result := FAttributes; diff --git a/rtl/objpas/typinfo.pp b/rtl/objpas/typinfo.pp index 120e1ad8bb..e269e6a390 100644 --- a/rtl/objpas/typinfo.pp +++ b/rtl/objpas/typinfo.pp @@ -526,6 +526,20 @@ unit TypInfo; { PropertyTable: TPropData } end; + TAttributeProc = function : TCustomAttribute; + PAttributeProcList = ^TAttributeProcList; + TAttributeProcList = array[0..$ffff] of TAttributeProc; + + TAttributeData = +{$ifndef FPC_REQUIRES_PROPER_ALIGNMENT} + packed +{$endif} + record + AttributeCount: word; + AttributesList: TAttributeProcList; + end; + PAttributeData = ^TAttributeData; + PTypeData = ^TTypeData; TTypeData = {$ifndef FPC_REQUIRES_PROPER_ALIGNMENT} @@ -623,7 +637,7 @@ unit TypInfo; ParentInfoRef : TypeInfoPtr; PropCount : SmallInt; UnitInfo : PUnitInfo - // AttributeData: TAttributeData; + // AttributeTable: PAttributeData; // here the properties follow as array of TPropInfo ); tkRecord: @@ -741,7 +755,7 @@ unit TypInfo; // 6 : true, constant index property PropProcs : Byte; - AttributeCount : Byte; + AttributeTable : PAttributeData; Name : ShortString; property PropType: PTypeInfo read GetPropType; property Tail: Pointer read GetTail; @@ -750,19 +764,9 @@ unit TypInfo; TProcInfoProc = Procedure(PropInfo : PPropInfo) of object; - TAttributeProc = function : TCustomAttribute; - PAttributeProcList = ^TAttributeProcList; - TAttributeProcList = array[0..$ffff] of TAttributeProc; - PPropList = ^TPropList; TPropList = array[0..{$ifdef cpu16}(32768 div sizeof(PPropInfo))-2{$else}65535{$endif}] of PPropInfo; - TAttributeData = record - AttributeCount: word; - AttributesList: TAttributeProcList; - end; - PAttributeData = ^TAttributeData; - PUnitInfoList = ^TUnitInfoList; TUnitInfoList = record UnitCount: IntPtr; @@ -912,7 +916,6 @@ function GetNextTypeInfo(ATypeInfo: PTypeInfo): PTypeInfo; function GetAttributeData(TypeInfo: PTypeInfo): PAttributeData; -function GetPropAttributeProclist(PropInfo: PPropInfo): PAttributeProcList; function GetPropAttribute(PropInfo: PPropInfo; AttributeNr: byte): TObject; function GetAttribute(AttributeData: PAttributeData; AttributeNr: byte): TCustomAttribute; @@ -1027,7 +1030,7 @@ begin begin TD := GetTypeData(TypeInfo); if (rmoHasAttributes in td^.UnitInfo^.UnitOptions) then - Result:=PAttributeData(aligntoptr(pointer(@TD^.UnitInfo)+sizeof(TD^.UnitInfo))) + Result:=PAttributeData(PPointer(aligntoptr(pointer(@TD^.UnitInfo)+sizeof(TD^.UnitInfo)))^) else result := nil; end; @@ -1035,15 +1038,12 @@ end; function GetPropData(TypeInfo : PTypeInfo; TypeData: PTypeData) : PPropData; var - AD: PAttributeData; + p: PtrUInt; begin + p := PtrUInt(@TypeData^.UnitInfo) + SizeOf(TypeData^.UnitInfo); if rmoHasAttributes in TypeData^.UnitInfo^.UnitOptions then - begin - AD := GetAttributeData(TypeInfo); - result := PPropData(pointer(AD)+SizeOf(AD^.AttributeCount)+(AD^.AttributeCount*SizeOf(TAttributeProc))); - end - else - result := aligntoptr(pointer(@TypeData^.UnitInfo)+sizeof(TypeData^.UnitInfo)); + p := p + SizeOf(PAttributeData); + Result := PPropData(aligntoptr(Pointer(p))); end; function GetFirstTypeinfoFromUnit(AUnitInfo: PUnitInfo): PTypeInfo; @@ -1121,7 +1121,7 @@ begin pd := GetPropData(ATypeInfo,td); p:=@pd^.PropList; for i:=1 to pd^.PropCount do - p:=aligntoptr(pointer(@ppropinfo(p)^.Name)+byte(ppropinfo(p)^.Name[0])+(ppropinfo(p)^.AttributeCount*SizeOf(TAttributeProc))+1); + p:=aligntoptr(pointer(@ppropinfo(p)^.Name)+byte(ppropinfo(p)^.Name[0])); end; tkInterface : begin @@ -1150,26 +1150,16 @@ begin result := nil; end; -function GetPropAttributeProclist(PropInfo: PPropInfo): PAttributeProcList; -begin - if PropInfo^.AttributeCount=0 then - result := nil - else - begin - Result:=PAttributeProcList(aligntoptr(pointer(@PropInfo^.Name)+byte(PropInfo^.Name[0])+1)); - end; -end; - function GetPropAttribute(PropInfo: PPropInfo; AttributeNr: byte): TObject; var - AttributeProcList: PAttributeProcList; + attrtable: PAttributeData; begin - if AttributeNr>=PropInfo^.AttributeCount then - result := nil + attrtable := PropInfo^.AttributeTable; + if not Assigned(attrtable) or (AttributeNr >= attrtable^.AttributeCount) then + result := Nil else begin - AttributeProcList := GetPropAttributeProclist(PropInfo); - result := AttributeProcList^[AttributeNr](); + result := attrtable^.AttributesList[AttributeNr](); end; end; @@ -1491,7 +1481,7 @@ begin if ShortCompareText(Result^.Name, P) = 0 then exit; // skip to next property - Result:=PPropInfo(aligntoptr(pointer(@Result^.Name)+byte(Result^.Name[0])+(result^.AttributeCount*SizeOf(TAttributeProc))+1)); + Result:=PPropInfo(aligntoptr(pointer(@Result^.Name)+byte(Result^.Name[0])+1)); end; // parent class Typeinfo:=hp^.ParentInfo; @@ -1654,7 +1644,7 @@ begin PropList^[TP^.NameIndex]:=TP; // Point to TP next propinfo record. // Located at Name[Length(Name)+1] ! - TP:=aligntoptr(PPropInfo(pointer(@TP^.Name)+PByte(@TP^.Name)^+(TP^.AttributeCount*SizeOf(TAttributeProc))+1)); + TP:=aligntoptr(PPropInfo(pointer(@TP^.Name)+PByte(@TP^.Name)^+1)); Dec(Count); end; TypeInfo:=TD^.Parentinfo;