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

* (slightly) modified (formatting, warning) patch by Jan Bruns to speed up overloading search, resolves #36666

Browse Source 
git-svn-id: trunk@47111 -
This commit is contained in:
florian 2020-10-14 20:08:10 +00:00
parent eb7158d250
commit 3b0168ae16
2 changed files with 253 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

248
compiler/htypechk.pas
View File

@ -62,7 +62,10 @@ interface
cl6_count,
coper_count : integer; { should be signed }
ordinal_distance : double;
invalid : boolean;
invalid : boolean;
{$ifndef DISABLE_FAST_OVERLOAD_PATCH}
saved_validity : boolean;
{$endif}
wrongparanr : byte;
end;
@ -2585,7 +2588,11 @@ implementation
{ only when the # of parameter are supported by the procedure and
it is visible }
{$ifdef DISABLE_FAST_OVERLOAD_PATCH}
if (FParalength>=pd.minparacount) and
{$else}
if (pd.seenmarker<>pointer(self)) and (FParalength>=pd.minparacount) and
{$endif}
(
(
allowdefaultparas and
@ -2625,6 +2632,7 @@ implementation
cpoptions:=cpoptions+[cpo_rtlproc];
found:=false;
hp:=FCandidateProcs;
{$ifdef DISABLE_FAST_OVERLOAD_PATCH}
while assigned(hp) do
begin
if (compare_paras(hp^.data.paras,pd.paras,cp_value_equal_const,cpoptions)>=te_equal) and
@ -2636,10 +2644,14 @@ implementation
end;
hp:=hp^.next;
end;
{$endif}
if not found then
begin
proc_add(st,pd,objcidcall);
added:=true;
{$ifndef DISABLE_FAST_OVERLOAD_PATCH}
pd.seenmarker:=self;
{$endif}
end;
end;
@ -2653,6 +2665,14 @@ implementation
pd.free;
end;
end;
{$ifndef DISABLE_FAST_OVERLOAD_PATCH}
{cleanup modified duplicate pd markers}
hp := FCandidateProcs;
while assigned(hp) do begin
hp^.data.seenmarker := nil;
hp := hp^.next;
end;
{$endif}
calc_distance(st,objcidcall);
@ -3239,6 +3259,8 @@ implementation
end;
function is_better_candidate(currpd,bestpd:pcandidate):integer;
var
res : integer;
@ -3489,6 +3511,9 @@ implementation
end;
{$ifdef DISABLE_FAST_OVERLOAD_PATCH}
function tcallcandidates.choose_best(var bestpd:tabstractprocdef; singlevariant: boolean):integer;
var
pd: tprocdef;
@ -3576,6 +3601,227 @@ implementation
end;
{$else}
function compare_by_old_sortout_check(pd,bestpd:pcandidate):integer;
var cpoptions : tcompare_paras_options;
begin
{ don't add duplicates, only compare visible parameters for the user }
cpoptions:=[cpo_ignorehidden];
if (po_compilerproc in bestpd^.data.procoptions) then
cpoptions:=cpoptions+[cpo_compilerproc];
if (po_rtlproc in bestpd^.data.procoptions) then
cpoptions:=cpoptions+[cpo_rtlproc];
compare_by_old_sortout_check := 0; // can't decide, bestpd probably wasn't sorted out in unpatched
if (compare_paras(pd^.data.paras,bestpd^.data.paras,cp_value_equal_const,cpoptions)>=te_equal) and
(not(po_objc in bestpd^.data.procoptions) or (bestpd^.data.messageinf.str^=pd^.data.messageinf.str^)) then
compare_by_old_sortout_check := 1; // bestpd was sorted out before patch
end;
function decide_restart(pd,bestpd:pcandidate) : boolean;
begin
decide_restart := false;
if assigned(bestpd) then
begin
{ don't restart if bestpd is marked invalid already }
if not bestpd^.invalid then
decide_restart := compare_by_old_sortout_check(pd,bestpd)<>0;
end;
end;
procedure save_validity(c : pcandidate);
begin
while assigned(c) do
begin
c^.saved_validity := c^.invalid;
c := c^.next;
end;
end;
procedure restore_validity(c : pcandidate);
begin
while assigned(c) do begin
c^.invalid := c^.saved_validity;
c := c^.next;
end;
end;
function tcallcandidates.choose_best(var bestpd:tabstractprocdef; singlevariant: boolean):integer;
var
pd: tprocdef;
besthpstart,
hp,hp2 : pcandidate;
cntpd,
res : integer;
restart : boolean;
begin
res:=0;
{
Returns the number of candidates left and the
first candidate is returned in pdbest
}
if not(assigned(FCandidateProcs)) then
begin
choose_best := 0;
exit;
end;
bestpd:=FCandidateProcs^.data;
if FCandidateProcs^.invalid then
cntpd:=0
else
cntpd:=1;
if assigned(FCandidateProcs^.next) then
begin
save_validity(FCandidateProcs);
restart := false;
{ keep restarting, until there wasn't a sorted-out besthpstart }
repeat
besthpstart:=FCandidateProcs;
bestpd:=FCandidateProcs^.data;
if restart then
begin
restore_validity(FCandidateProcs);
restart := false;
end;
{ Setup the first procdef as best, only count it as a result
when it is valid }
if FCandidateProcs^.invalid then
cntpd:=0
else
cntpd:=1;
hp:=FCandidateProcs^.next;
while assigned(hp) and not(restart) do
begin
restart := decide_restart(hp,besthpstart);
if not restart then
begin
if not singlevariant then
res:=is_better_candidate(hp,besthpstart)
else
res:=is_better_candidate_single_variant(hp,besthpstart);
end;
if restart then
begin
{ mark the sorted out invalid globally }
besthpstart^.saved_validity := true;
end
else if (res>0) then
begin
{ hp is better, flag all procs to be incompatible }
while (besthpstart<>hp) do
begin
besthpstart^.invalid:=true;
besthpstart:=besthpstart^.next;
end;
{ besthpstart is already set to hp }
bestpd:=besthpstart^.data;
cntpd:=1;
end
else if (res<0) then
begin
{ besthpstart is better, flag current hp to be incompatible }
hp^.invalid:=true;
end
else
begin
{ res=0, both are valid }
if not hp^.invalid then
inc(cntpd);
end;
hp:=hp^.next;
end;
until not(restart);
end;
{ check the alternate choices if they would have been sorted out before patch... }
{ note we have procadded the candidates, so order is reversed procadd order here.
this was also used above: each sorted-out always has an "outsorter" counterpart
deeper down the next chain
}
{ for the intial implementation, let's first do some more consistency checking}
res := 0;
hp := FCandidateProcs;
while assigned(hp) do
begin
if not(hp^.invalid) then
inc(res);
hp := hp^.next;
end;
if (res<>cntpd) then
internalerror(202002161);
{ check all valid choices for sortout }
cntpd := 0;
hp := FCandidateProcs;
while assigned(hp) do
begin
if not(hp^.invalid) then
begin
hp2 := hp^.next;
while assigned(hp2) do begin
if compare_by_old_sortout_check(hp2,hp)<>0 then
begin
hp^.invalid := true;
hp2 := nil;
end
else
hp2:=hp2^.next;
end;
if not(hp^.invalid) then
begin
inc(cntpd);
{ check for the impossible event bestpd had become invalid}
if (cntpd=1) and (hp^.data<>bestpd) then
internalerror(202002162);
end;
end;
hp := hp^.next;
end;
{ if we've found one, check the procdefs ignored for overload choosing
to see whether they contain one from a child class with the same
parameters (so the overload choosing was not influenced by their
presence, but now that we've decided which overloaded version to call,
make sure we call the version closest in terms of visibility }
if cntpd=1 then
begin
for res:=0 to FIgnoredCandidateProcs.count-1 do
begin
pd:=tprocdef(FIgnoredCandidateProcs[res]);
{ stop searching when we start comparing methods of parent of
the struct in which the current best method was found }
if assigned(pd.struct) and
(pd.struct<>tprocdef(bestpd).struct) and
def_is_related(tprocdef(bestpd).struct,pd.struct) then
break;
if (pd.proctypeoption=bestpd.proctypeoption) and
((pd.procoptions*[po_classmethod,po_methodpointer])=(bestpd.procoptions*[po_classmethod,po_methodpointer])) and
(compare_paras(pd.paras,bestpd.paras,cp_all,[cpo_ignorehidden,cpo_ignoreuniv,cpo_openequalisexact])=te_exact) then
begin
{ first one encountered is closest in terms of visibility }
bestpd:=pd;
break;
end;
end;
end;
result:=cntpd;
end;
{$endif}
procedure tcallcandidates.find_wrong_para;
var
currparanr : smallint;

6
compiler/symdef.pas
View File

@ -865,6 +865,9 @@ interface
a routine that has to be internally generated by the compiler }
synthetickind: tsynthetickind;
visibility : tvisibility;
{$ifndef DISABLE_FAST_OVERLOAD_PATCH}
seenmarker : pointer; // used for filtering in tcandidate
{$endif}
constructor create(level:byte;doregister:boolean);virtual;
constructor ppuload(ppufile:tcompilerppufile);
destructor destroy;override;
@ -6103,6 +6106,9 @@ implementation
{$else symansistr}
_mangledname:=nil;
{$endif symansistr}
{$ifndef DISABLE_FAST_OVERLOAD_PATCH}
seenmarker := nil;
{$endif}
fileinfo:=current_filepos;
extnumber:=$ffff;
aliasnames:=TCmdStrList.create;