Browse Source

Turn TCallCandidates into an object, make it create FIgnoredCandidateProcs on demand, and outline such adding on demand into dedicated TFPList.AddOnDemand.

Rika Ichinose 3 years ago
parent
commit
326776c7fa
4 changed files with 60 additions and 54 deletions
  1. 27 0
      compiler/cclasses.pas
  2. 25 32
      compiler/htypechk.pas
  3. 4 5
      compiler/ncal.pas
  4. 4 17
      compiler/pgenutil.pas

+ 27 - 0
compiler/cclasses.pas

@@ -110,6 +110,12 @@ type
     property Capacity: Integer read FCapacity write SetCapacity;
     property Capacity: Integer read FCapacity write SetCapacity;
     property Count: Integer read FCount write SetCount;
     property Count: Integer read FCount write SetCount;
     property Items[Index: Integer]: Pointer read Get write Put; default;
     property Items[Index: Integer]: Pointer read Get write Put; default;
+
+    { Add to list, creating it if required. }
+    class procedure AddOnDemand(var Lst: TFPList; Item: Pointer); static;
+
+    { FreeAndNil the list, and its items as TObjects. }
+    class procedure FreeAndNilObjects(var Lst: TFPList); static;
   end;
   end;
 
 
 
 
@@ -1031,6 +1037,27 @@ begin
     end;
     end;
 end;
 end;
 
 
+class procedure TFPList.AddOnDemand(var Lst: TFPList; Item: Pointer);
+begin
+  if not Assigned(Lst) then
+      Lst := TFPList.Create;
+  Lst.Add(Item);
+end;
+
+class procedure TFPList.FreeAndNilObjects(var Lst: TFPList);
+var
+  Lp: PPointer;
+  I: SizeInt;
+begin
+  if not Assigned(Lst) then
+    exit;
+  Lp := Lst.FList;
+  for I := 0 to Lst.Count-1 do
+    TObject(Lp[I]).Free;
+  Lst.Free;
+  Lst := nil;
+end;
+
 
 
 {*****************************************************************************
 {*****************************************************************************
             TFPObjectList (Copied from rtl/objpas/classes/lists.inc)
             TFPObjectList (Copied from rtl/objpas/classes/lists.inc)

+ 25 - 32
compiler/htypechk.pas

@@ -69,13 +69,13 @@ interface
          wrongparanr : byte;
          wrongparanr : byte;
       end;
       end;
 
 
-      tcallcandidates = class
+      tcallcandidates = object
       private
       private
         FProcsym     : tprocsym;
         FProcsym     : tprocsym;
         FProcsymtable : tsymtable;
         FProcsymtable : tsymtable;
         FOperator    : ttoken;
         FOperator    : ttoken;
         FCandidateProcs    : pcandidate;
         FCandidateProcs    : pcandidate;
-        FIgnoredCandidateProcs: tfpobjectlist;
+        FIgnoredCandidateProcs : tfplist;
         FProcCnt    : integer;
         FProcCnt    : integer;
         FParaNode   : tnode;
         FParaNode   : tnode;
         FParaLength : smallint;
         FParaLength : smallint;
@@ -87,9 +87,9 @@ interface
         procedure calc_distance(st_root:tsymtable;objcidcall: boolean);
         procedure calc_distance(st_root:tsymtable;objcidcall: boolean);
         function  proc_add(st:tsymtable;pd:tprocdef;objcidcall: boolean):pcandidate;
         function  proc_add(st:tsymtable;pd:tprocdef;objcidcall: boolean):pcandidate;
       public
       public
-        constructor create(sym:tprocsym;st:TSymtable;ppn:tnode;ignorevisibility,allowdefaultparas,objcidcall,explicitunit,searchhelpers,anoninherited:boolean;spezcontext:tspecializationcontext);
-        constructor create_operator(op:ttoken;ppn:tnode);
-        destructor destroy;override;
+        constructor init(sym:tprocsym;st:TSymtable;ppn:tnode;ignorevisibility,allowdefaultparas,objcidcall,explicitunit,searchhelpers,anoninherited:boolean;spezcontext:tspecializationcontext);
+        constructor init_operator(op:ttoken;ppn:tnode);
+        destructor done;
         procedure list(all:boolean);
         procedure list(all:boolean);
 {$ifdef EXTDEBUG}
 {$ifdef EXTDEBUG}
         procedure dump_info(lvl:longint);
         procedure dump_info(lvl:longint);
@@ -804,12 +804,12 @@ implementation
             ppn:=ccallparanode.create(tunarynode(t).left.getcopy,nil);
             ppn:=ccallparanode.create(tunarynode(t).left.getcopy,nil);
             ppn.get_paratype;
             ppn.get_paratype;
           end;
           end;
-        candidates:=tcallcandidates.create_operator(optoken,ppn);
+        candidates.init_operator(optoken,ppn);
 
 
         { stop when there are no operators found }
         { stop when there are no operators found }
         if candidates.count=0 then
         if candidates.count=0 then
           begin
           begin
-            candidates.free;
+            candidates.done;
             ppn.free;
             ppn.free;
             if not (ocf_check_only in ocf) then
             if not (ocf_check_only in ocf) then
               begin
               begin
@@ -830,7 +830,7 @@ implementation
         { exit when no overloads are found }
         { exit when no overloads are found }
         if cand_cnt=0 then
         if cand_cnt=0 then
           begin
           begin
-            candidates.free;
+            candidates.done;
             ppn.free;
             ppn.free;
             if not (ocf_check_only in ocf) then
             if not (ocf_check_only in ocf) then
               begin
               begin
@@ -852,7 +852,7 @@ implementation
             { we'll just use the first candidate to make the
             { we'll just use the first candidate to make the
               call }
               call }
           end;
           end;
-        candidates.free;
+        candidates.done;
 
 
         if ocf_check_only in ocf then
         if ocf_check_only in ocf then
           begin
           begin
@@ -889,13 +889,13 @@ implementation
             { generate parameter nodes }
             { generate parameter nodes }
             ppn:=ccallparanode.create(tbinarynode(t).right.getcopy,ccallparanode.create(tbinarynode(t).left.getcopy,nil));
             ppn:=ccallparanode.create(tbinarynode(t).right.getcopy,ccallparanode.create(tbinarynode(t).left.getcopy,nil));
             ppn.get_paratype;
             ppn.get_paratype;
-            candidates:=tcallcandidates.create_operator(optoken,ppn);
+            candidates.init_operator(optoken,ppn);
 
 
             { for commutative operators we can swap arguments and try again }
             { for commutative operators we can swap arguments and try again }
             if (candidates.count=0) and
             if (candidates.count=0) and
                not(optoken in non_commutative_op_tokens) then
                not(optoken in non_commutative_op_tokens) then
               begin
               begin
-                candidates.free;
+                candidates.done;
                 reverseparameters(ppn);
                 reverseparameters(ppn);
                 { reverse compare operators }
                 { reverse compare operators }
                 case optoken of
                 case optoken of
@@ -910,7 +910,7 @@ implementation
                   else
                   else
                     ;
                     ;
                 end;
                 end;
-                candidates:=tcallcandidates.create_operator(optoken,ppn);
+                candidates.init_operator(optoken,ppn);
               end;
               end;
 
 
             { stop when there are no operators found }
             { stop when there are no operators found }
@@ -918,7 +918,7 @@ implementation
             if (result=0) and generror then
             if (result=0) and generror then
               begin
               begin
                 CGMessage(parser_e_operator_not_overloaded);
                 CGMessage(parser_e_operator_not_overloaded);
-                candidates.free;
+                candidates.done;
                 ppn.free;
                 ppn.free;
                 ppn:=nil;
                 ppn:=nil;
                 exit;
                 exit;
@@ -939,7 +939,7 @@ implementation
             if (result=0) and generror then
             if (result=0) and generror then
               begin
               begin
                 CGMessage3(parser_e_operator_not_overloaded_3,ld.GetTypeName,arraytokeninfo[optoken].str,rd.GetTypeName);
                 CGMessage3(parser_e_operator_not_overloaded_3,ld.GetTypeName,arraytokeninfo[optoken].str,rd.GetTypeName);
-                candidates.free;
+                candidates.done;
                 ppn.free;
                 ppn.free;
                 ppn:=nil;
                 ppn:=nil;
                 exit;
                 exit;
@@ -957,7 +957,7 @@ implementation
                 { we'll just use the first candidate to make the
                 { we'll just use the first candidate to make the
                   call }
                   call }
               end;
               end;
-            candidates.free;
+            candidates.done;
           end;
           end;
 
 
       begin
       begin
@@ -2194,7 +2194,7 @@ implementation
                            TCallCandidates
                            TCallCandidates
 ****************************************************************************}
 ****************************************************************************}
 
 
-    constructor tcallcandidates.create(sym:tprocsym;st:TSymtable;ppn:tnode;ignorevisibility,allowdefaultparas,objcidcall,explicitunit,searchhelpers,anoninherited:boolean;spezcontext:tspecializationcontext);
+    constructor tcallcandidates.init(sym:tprocsym;st:TSymtable;ppn:tnode;ignorevisibility,allowdefaultparas,objcidcall,explicitunit,searchhelpers,anoninherited:boolean;spezcontext:tspecializationcontext);
       begin
       begin
         if not assigned(sym) then
         if not assigned(sym) then
           internalerror(200411015);
           internalerror(200411015);
@@ -2202,23 +2202,21 @@ implementation
         FProcsym:=sym;
         FProcsym:=sym;
         FProcsymtable:=st;
         FProcsymtable:=st;
         FParanode:=ppn;
         FParanode:=ppn;
-        FIgnoredCandidateProcs:=tfpobjectlist.create(false);
         create_candidate_list(ignorevisibility,allowdefaultparas,objcidcall,explicitunit,searchhelpers,anoninherited,spezcontext);
         create_candidate_list(ignorevisibility,allowdefaultparas,objcidcall,explicitunit,searchhelpers,anoninherited,spezcontext);
       end;
       end;
 
 
 
 
-    constructor tcallcandidates.create_operator(op:ttoken;ppn:tnode);
+    constructor tcallcandidates.init_operator(op:ttoken;ppn:tnode);
       begin
       begin
         FOperator:=op;
         FOperator:=op;
         FProcsym:=nil;
         FProcsym:=nil;
         FProcsymtable:=nil;
         FProcsymtable:=nil;
         FParanode:=ppn;
         FParanode:=ppn;
-        FIgnoredCandidateProcs:=tfpobjectlist.create(false);
         create_candidate_list(false,false,false,false,false,false,nil);
         create_candidate_list(false,false,false,false,false,false,nil);
       end;
       end;
 
 
 
 
-    destructor tcallcandidates.destroy;
+    destructor tcallcandidates.done;
       var
       var
         hpnext,
         hpnext,
         hp : pcandidate;
         hp : pcandidate;
@@ -2229,12 +2227,7 @@ implementation
         FIgnoredCandidateProcs.free;
         FIgnoredCandidateProcs.free;
         { free any symbols for anonymous parameter types that we're used for
         { free any symbols for anonymous parameter types that we're used for
           specialization when no specialization was picked }
           specialization when no specialization was picked }
-        if assigned(FParaAnonSyms) then
-          begin
-            for i := 0 to FParaAnonSyms.count-1 do
-              tsym(FParaAnonSyms[i]).free;
-            FParaAnonSyms.free;
-          end;
+        TFPList.FreeAndNilObjects(FParaAnonSyms);
         hp:=FCandidateProcs;
         hp:=FCandidateProcs;
         while assigned(hp) do
         while assigned(hp) do
          begin
          begin
@@ -2284,7 +2277,7 @@ implementation
                 continue;
                 continue;
               if (po_ignore_for_overload_resolution in pd.procoptions) then
               if (po_ignore_for_overload_resolution in pd.procoptions) then
                 begin
                 begin
-                  FIgnoredCandidateProcs.add(pd);
+                  TFPList.AddOnDemand(FIgnoredCandidateProcs,pd);
                   continue;
                   continue;
                 end;
                 end;
               { in case of anonymous inherited, only match procdefs identical
               { in case of anonymous inherited, only match procdefs identical
@@ -2517,7 +2510,7 @@ implementation
                           continue;
                           continue;
                         if (po_ignore_for_overload_resolution in pd.procoptions) then
                         if (po_ignore_for_overload_resolution in pd.procoptions) then
                           begin
                           begin
-                            FIgnoredCandidateProcs.add(pd);
+                            TFPList.AddOnDemand(FIgnoredCandidateProcs,pd);
                             continue;
                             continue;
                           end;
                           end;
                         { Store first procsym found }
                         { Store first procsym found }
@@ -2626,7 +2619,7 @@ implementation
 {$ifdef DISABLE_FAST_OVERLOAD_PATCH}
 {$ifdef DISABLE_FAST_OVERLOAD_PATCH}
             if (FParalength>=pd.minparacount) and
             if (FParalength>=pd.minparacount) and
 {$else}
 {$else}
-            if (pd.seenmarker<>pointer(self)) and (FParalength>=pd.minparacount) and
+            if (pd.seenmarker<>pointer(@self)) and (FParalength>=pd.minparacount) and
 {$endif}
 {$endif}
                (
                (
                 (
                 (
@@ -2685,7 +2678,7 @@ implementation
                     proc_add(st,pd,objcidcall);
                     proc_add(st,pd,objcidcall);
                     added:=true;
                     added:=true;
 {$ifndef DISABLE_FAST_OVERLOAD_PATCH}
 {$ifndef DISABLE_FAST_OVERLOAD_PATCH}
-                    pd.seenmarker:=self;
+                    pd.seenmarker:=pointer(@self);
 {$endif}
 {$endif}
                   end;
                   end;
               end;
               end;
@@ -3636,7 +3629,7 @@ implementation
           parameters (so the overload choosing was not influenced by their
           parameters (so the overload choosing was not influenced by their
           presence, but now that we've decided which overloaded version to call,
           presence, but now that we've decided which overloaded version to call,
           make sure we call the version closest in terms of visibility }
           make sure we call the version closest in terms of visibility }
-        if cntpd=1 then
+        if (cntpd=1) and assigned(FIgnoredCandidateProcs) then
           begin
           begin
             for res:=0 to FIgnoredCandidateProcs.count-1 do
             for res:=0 to FIgnoredCandidateProcs.count-1 do
               begin
               begin
@@ -3864,7 +3857,7 @@ implementation
           parameters (so the overload choosing was not influenced by their
           parameters (so the overload choosing was not influenced by their
           presence, but now that we've decided which overloaded version to call,
           presence, but now that we've decided which overloaded version to call,
           make sure we call the version closest in terms of visibility }
           make sure we call the version closest in terms of visibility }
-        if cntpd=1 then
+        if (cntpd=1) and assigned(FIgnoredCandidateProcs) then
           begin
           begin
             for res:=0 to FIgnoredCandidateProcs.count-1 do
             for res:=0 to FIgnoredCandidateProcs.count-1 do
               begin
               begin

+ 4 - 5
compiler/ncal.pas

@@ -3963,7 +3963,6 @@ implementation
         invokesym : tsym;
         invokesym : tsym;
       begin
       begin
          result:=nil;
          result:=nil;
-         candidates:=nil;
 
 
          oldcallnode:=aktcallnode;
          oldcallnode:=aktcallnode;
          aktcallnode:=self;
          aktcallnode:=self;
@@ -4083,7 +4082,7 @@ implementation
                    ignorevisibility:=(nf_isproperty in flags) or
                    ignorevisibility:=(nf_isproperty in flags) or
                                      ((m_delphi in current_settings.modeswitches) and (cnf_anon_inherited in callnodeflags)) or
                                      ((m_delphi in current_settings.modeswitches) and (cnf_anon_inherited in callnodeflags)) or
                                      (cnf_ignore_visibility in callnodeflags);
                                      (cnf_ignore_visibility in callnodeflags);
-                   candidates:=tcallcandidates.create(symtableprocentry,symtableproc,left,ignorevisibility,
+                   candidates.init(symtableprocentry,symtableproc,left,ignorevisibility,
                      not(nf_isproperty in flags),cnf_objc_id_call in callnodeflags,cnf_unit_specified in callnodeflags,
                      not(nf_isproperty in flags),cnf_objc_id_call in callnodeflags,cnf_unit_specified in callnodeflags,
                      callnodeflags*[cnf_anon_inherited,cnf_inherited]=[],cnf_anon_inherited in callnodeflags,spezcontext);
                      callnodeflags*[cnf_anon_inherited,cnf_inherited]=[],cnf_anon_inherited in callnodeflags,spezcontext);
 
 
@@ -4128,7 +4127,7 @@ implementation
                               symtableprocentry.write_parameter_lists(nil);
                               symtableprocentry.write_parameter_lists(nil);
                             end;
                             end;
                         end;
                         end;
-                      candidates.free;
+                      candidates.done;
                       exit;
                       exit;
                     end;
                     end;
 
 
@@ -4203,7 +4202,7 @@ implementation
 {$endif EXTDEBUG}
 {$endif EXTDEBUG}
 
 
                       { We can not proceed, release all procs and exit }
                       { We can not proceed, release all procs and exit }
-                      candidates.free;
+                      candidates.done;
                       exit;
                       exit;
                     end;
                     end;
 
 
@@ -4213,7 +4212,7 @@ implementation
                    if procdefinition.is_specialization and (procdefinition.typ=procdef) then
                    if procdefinition.is_specialization and (procdefinition.typ=procdef) then
                      maybe_add_pending_specialization(procdefinition,candidates.para_anon_syms);
                      maybe_add_pending_specialization(procdefinition,candidates.para_anon_syms);
 
 
-                   candidates.free;
+                   candidates.done;
                  end; { end of procedure to call determination }
                  end; { end of procedure to call determination }
              end;
              end;
 
 

+ 4 - 17
compiler/pgenutil.pas

@@ -1227,11 +1227,7 @@ uses
                   sym:=create_unnamed_typesym(caller_def);
                   sym:=create_unnamed_typesym(caller_def);
                   { add the unnamed sym to the list but only it was allocated manually }
                   { add the unnamed sym to the list but only it was allocated manually }
                   if sym.owner=caller_def.owner then
                   if sym.owner=caller_def.owner then
-                    begin
-                      if not assigned(unnamed_syms) then
-                        unnamed_syms:=tfplist.create;
-                      unnamed_syms.add(sym);
-                    end;
+                    TFPList.AddOnDemand(unnamed_syms,sym);
                   genericparams.add(target_key,sym);
                   genericparams.add(target_key,sym);
                 end
                 end
               else
               else
@@ -1267,11 +1263,7 @@ uses
                   result.insert(0,sym);
                   result.insert(0,sym);
                   { add the unnamed sym to the list but only if it was allocated manually }
                   { add the unnamed sym to the list but only if it was allocated manually }
                   if sym.owner=paradef.owner then
                   if sym.owner=paradef.owner then
-                    begin
-                      if not assigned(unnamed_syms) then
-                        unnamed_syms:=tfplist.create;
-                      unnamed_syms.add(sym);
-                    end;
+                    TFPList.AddOnDemand(unnamed_syms,sym);
                 end
                 end
               else
               else
                 result.insert(0,paradef.typesym);
                 result.insert(0,paradef.typesym);
@@ -1280,7 +1272,7 @@ uses
         end;
         end;
 
 
       var
       var
-        i,j,k : integer;
+        i,j : integer;
         srsym : tprocsym;
         srsym : tprocsym;
         callerparams : tfplist;
         callerparams : tfplist;
         pd : tprocdef;
         pd : tprocdef;
@@ -1333,12 +1325,7 @@ uses
                 else
                 else
                   begin
                   begin
                     { the specialization was not chosen so clean up any unnamed syms }
                     { the specialization was not chosen so clean up any unnamed syms }
-                    if pd_unnamed_syms<>nil then
-                      begin
-                        for k:=0 to pd_unnamed_syms.count-1 do
-                          tsym(pd_unnamed_syms[k]).free;
-                        pd_unnamed_syms.free;
-                      end;
+                    TFPList.FreeAndNilObjects(pd_unnamed_syms);
                   end;
                   end;
               end;
               end;
           end;
           end;