From 3b0168ae162ff2b7a57aeb9114ad6beb42c8b02b Mon Sep 17 00:00:00 2001 From: florian Date: Wed, 14 Oct 2020 20:08:10 +0000 Subject: [PATCH] * (slightly) modified (formatting, warning) patch by Jan Bruns to speed up overloading search, resolves #36666 git-svn-id: trunk@47111 - --- compiler/htypechk.pas | 248 +++++++++++++++++++++++++++++++++++++++++- compiler/symdef.pas | 6 + 2 files changed, 253 insertions(+), 1 deletion(-) diff --git a/compiler/htypechk.pas b/compiler/htypechk.pas index 425dec407c..38e2a4af74 100644 --- a/compiler/htypechk.pas +++ b/compiler/htypechk.pas @@ -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; diff --git a/compiler/symdef.pas b/compiler/symdef.pas index d638236a4d..67fee52ff0 100644 --- a/compiler/symdef.pas +++ b/compiler/symdef.pas @@ -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;