paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-09-04 19:30:32 +02:00
Code Issues Packages Projects Releases Wiki Activity

* optimize class initialization by calling RTTIRecord() only when required for a non-trivial initialization

Browse Source 
git-svn-id: trunk@39256 -
This commit is contained in:
svenbarth 2018-06-20 19:00:21 +00:00
parent ac0322c323
commit 4d0ab82ef7
3 changed files with 27 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
rtl/inc/objpas.inc
View File

@ -383,6 +383,7 @@
var var
vmt : PVmt; vmt : PVmt;
temp : pointer; temp : pointer;
flags : TRecordInfoInitFlags;
{$endif FPC_HAS_MANAGEMENT_OPERATORS} {$endif FPC_HAS_MANAGEMENT_OPERATORS}
begin begin
{ the size is saved at offset 0 } { the size is saved at offset 0 }
@ -399,10 +400,19 @@
while vmt<>nil do while vmt<>nil do
begin begin
Temp:= vmt^.vInitTable; Temp:= vmt^.vInitTable;
{ The RTTI format matches one for records, except the type is tkClass. if assigned(Temp) then
Since RecordRTTI does not check the type, calling it yields the desired result. } begin
if Assigned(Temp) then flags:=RecordRTTIInitFlags(Temp);
if riifNonTrivialChild in flags then
{ The RTTI format matches one for records, except the type
is tkClass. Since RecordRTTI does not check the type,
calling it yields the desired result. }
RecordRTTI(Instance,Temp,@int_initialize); RecordRTTI(Instance,Temp,@int_initialize);
{ no need to continue complex initializing up the inheritance
tree if none of the parents require it anyway }
if not (riifParentHasNonTrivialChild in flags) then
break;
end;
vmt:= vmt^.vParent; vmt:= vmt^.vParent;
end; end;
{$endif FPC_HAS_MANAGEMENT_OPERATORS} {$endif FPC_HAS_MANAGEMENT_OPERATORS}

9
rtl/inc/rtti.inc
View File

@ -137,6 +137,15 @@ begin
end; end;
{$ifndef VER3_0}
function RecordRTTIInitFlags(ti: Pointer): TRecordInfoInitFlags;
begin
ti:=aligntoqword(ti+2+PByte(ti)[1]);
Result:=PRecordInfoInit(ti)^.Flags;
end;
{$endif VER3_0}
{ if you modify this procedure, fpc_copy must be probably modified as well } { if you modify this procedure, fpc_copy must be probably modified as well }
{$ifdef VER2_6} {$ifdef VER2_6}
procedure ArrayRTTI(Data,TypeInfo:Pointer;rttiproc:TRTTIProc); procedure ArrayRTTI(Data,TypeInfo:Pointer;rttiproc:TRTTIProc);

4
rtl/inc/rttidecl.inc
View File

@ -149,6 +149,10 @@ type
end; end;
{$ifndef VER3_0}
function RecordRTTIInitFlags(ti: Pointer): TRecordInfoInitFlags; forward;
{$endif VER3_0}
{$ifdef VER3_0} {$ifdef VER3_0}
{$MINENUMSIZE DEFAULT} {$MINENUMSIZE DEFAULT}
{$PACKSET DEFAULT} {$PACKSET DEFAULT}