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 Count: Integer read FCount write SetCount;
     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;
 
 
@@ -1031,6 +1037,27 @@ begin
     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)

+ 25 - 32
compiler/htypechk.pas

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

+ 4 - 5
compiler/ncal.pas

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

+ 4 - 17
compiler/pgenutil.pas

@@ -1227,11 +1227,7 @@ uses
                   sym:=create_unnamed_typesym(caller_def);
                   { add the unnamed sym to the list but only it was allocated manually }
                   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);
                 end
               else
@@ -1267,11 +1263,7 @@ uses
                   result.insert(0,sym);
                   { add the unnamed sym to the list but only if it was allocated manually }
                   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
               else
                 result.insert(0,paradef.typesym);
@@ -1280,7 +1272,7 @@ uses
         end;
 
       var
-        i,j,k : integer;
+        i,j : integer;
         srsym : tprocsym;
         callerparams : tfplist;
         pd : tprocdef;
@@ -1333,12 +1325,7 @@ uses
                 else
                   begin
                     { 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;