* operator overload chooses rewrite

  * overload choosing is now generic and moved to htypechk

compiler/defcmp.pas

@@ -1117,8 +1117,10 @@ implementation
         eq,lowesteq : tequaltype;
         hpd      : tprocdef;
         convtype : tconverttype;
+        cdoptions : tcompare_defs_options;
       begin
          compare_paras:=te_incompatible;
+         cdoptions:=[cdo_check_operator,cdo_allow_variant];
          { we need to parse the list from left-right so the
            not-default parameters are checked first }
          lowesteq:=high(tequaltype);
@@ -1154,7 +1156,8 @@ implementation
                  begin
                    if (currpara1.paratyp<>currpara2.paratyp) then
                     exit;
-                   eq:=compare_defs(currpara1.paratype.def,currpara2.paratype.def,nothingn);
+                   eq:=compare_defs_ext(currpara1.paratype.def,currpara2.paratype.def,nothingn,
+                                        convtype,hpd,cdoptions);
                  end;
               end
              else
@@ -1168,20 +1171,22 @@ implementation
                             (currpara2.paratyp in [vs_var,vs_out]))
                           ) then
                          exit;
-                       eq:=compare_defs(currpara1.paratype.def,currpara2.paratype.def,nothingn);
+                       eq:=compare_defs_ext(currpara1.paratype.def,currpara2.paratype.def,nothingn,
+                                            convtype,hpd,cdoptions);
                     end;
                   cp_all :
                     begin
                        if (currpara1.paratyp<>currpara2.paratyp) then
                          exit;
-                       eq:=compare_defs(currpara1.paratype.def,currpara2.paratype.def,nothingn);
+                       eq:=compare_defs_ext(currpara1.paratype.def,currpara2.paratype.def,nothingn,
+                                            convtype,hpd,cdoptions);
                     end;
                   cp_procvar :
                     begin
                        if (currpara1.paratyp<>currpara2.paratyp) then
                          exit;
                        eq:=compare_defs_ext(currpara1.paratype.def,currpara2.paratype.def,nothingn,
-                                            convtype,hpd,[cdo_check_operator,cdo_allow_variant]);
+                                            convtype,hpd,cdoptions);
                        if (eq>te_incompatible) and
                           (eq<te_equal) and
                           not(
@@ -1193,7 +1198,8 @@ implementation
                         end;
                     end;
                   else
-                    eq:=compare_defs(currpara1.paratype.def,currpara2.paratype.def,nothingn);
+                    eq:=compare_defs_ext(currpara1.paratype.def,currpara2.paratype.def,nothingn,
+                                         convtype,hpd,cdoptions);
                  end;
                end;
               { check type }
@@ -1267,7 +1273,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.46  2004-02-15 12:18:22  peter
+  Revision 1.47  2004-02-24 16:12:39  peter
+    * operator overload chooses rewrite
+    * overload choosing is now generic and moved to htypechk
+
+  Revision 1.46  2004/02/15 12:18:22  peter
     * allow real_2_real conversion for realconstn, fixes 2971
 
   Revision 1.45  2004/02/13 15:42:21  peter

compiler/htypechk.pas

@@ -27,9 +27,9 @@ unit htypechk;
 interface
 
     uses
-      tokens,
+      tokens,cpuinfo,
       node,
-      symconst,symtype,symdef;
+      symconst,symtype,symdef,symsym,symbase;
 
     type
       Ttok2nodeRec=record
@@ -38,6 +38,48 @@ interface
         op_overloading_supported : boolean;
       end;
 
+      pcandidate = ^tcandidate;
+      tcandidate = record
+         next        : pcandidate;
+         data        : tprocdef;
+         wrongpara,
+         firstpara   : tparaitem;
+         exact_count,
+         equal_count,
+         cl1_count,
+         cl2_count,
+         cl3_count,
+         coper_count : integer; { should be signed }
+         ordinal_distance : bestreal;
+         invalid     : boolean;
+         wrongparanr : byte;
+      end;
+
+      tcallcandidates = class
+      private
+        FProcSym    : tprocsym;
+        FProcs      : pcandidate;
+        FProcVisibleCnt,
+        FProcCnt    : integer;
+        FParaNode   : tnode;
+        FParaLength : smallint;
+        FAllowVariant : boolean;
+        function proc_add(pd:tprocdef):pcandidate;
+      public
+        constructor create(sym:tprocsym;st:tsymtable;ppn:tnode;isprop:boolean);
+        constructor create_operator(op:ttoken;ppn:tnode);
+        destructor destroy;override;
+        procedure list(all:boolean);
+{$ifdef EXTDEBUG}
+        procedure dump_info(lvl:longint);
+{$endif EXTDEBUG}
+        procedure get_information;
+        function  choose_best(var bestpd:tabstractprocdef):integer;
+        procedure find_wrong_para;
+        property  Count:integer read FProcCnt;
+        property  VisibleCount:integer read FProcVisibleCnt;
+      end;
+
     const
       tok2nodes=25;
       tok2node:array[1..tok2nodes] of ttok2noderec=(
@@ -74,16 +116,9 @@ interface
 {$endif def extdebug}
        allow_array_constructor : boolean = false;
 
-    { is overloading of this operator allowed for this
-      binary operator }
-    function isbinaryoperatoroverloadable(treetyp:tnodetype;ld:tdef;lt:tnodetype;rd:tdef;rt:tnodetype) : boolean;
-
-    { is overloading of this operator allowed for this
-      unary operator }
-    function isunaryoperatoroverloadable(rd,dd : tdef; treetyp : tnodetype) : boolean;
-
     { check operator args and result type }
     function isoperatoracceptable(pf : tprocdef; optoken : ttoken) : boolean;
+    function isunaryoverloaded(var t : tnode) : boolean;
     function isbinaryoverloaded(var t : tnode) : boolean;
 
     { Register Allocation }
@@ -112,10 +147,9 @@ implementation
     uses
        globtype,systems,
        cutils,verbose,globals,
-       symsym,symtable,
+       symtable,
        defutil,defcmp,
-       ncnv,nld,
-       nmem,ncal,nmat,
+       pass_1,ncnv,nld,nmem,ncal,nmat,nutils,
        cgbase,procinfo
        ;
 
@@ -260,63 +294,39 @@ implementation
       end;
 
 
-    function isunaryoperatoroverloadable(rd,dd : tdef; treetyp : tnodetype) : boolean;
-      var
-        eq : tequaltype;
-        conv : tconverttype;
-        pd : tprocdef;
+    function isunaryoperatoroverloadable(treetyp : tnodetype;ld : tdef) : boolean;
       begin
-        isunaryoperatoroverloadable:=false;
+        result:=false;
         case treetyp of
-          assignn :
-            begin
-              eq:=compare_defs_ext(rd,dd,nothingn,conv,pd,[cdo_explicit]);
-              if eq<>te_incompatible then
-               begin
-                 isunaryoperatoroverloadable:=false;
-                 exit;
-               end;
-              isunaryoperatoroverloadable:=true;
-            end;
-
-          subn :
+          subn,
+          unaryminusn :
             begin
-              if is_integer(rd) or
-                 (rd.deftype=floatdef) then
-               begin
-                 isunaryoperatoroverloadable:=false;
-                 exit;
-               end;
+              if is_integer(ld) or
+                 (ld.deftype=floatdef) then
+                exit;
 
 {$ifdef SUPPORT_MMX}
               if (cs_mmx in aktlocalswitches) and
-                 is_mmx_able_array(rd) then
-               begin
-                 isunaryoperatoroverloadable:=false;
-                 exit;
-               end;
+                 is_mmx_able_array(ld) then
+                exit;
 {$endif SUPPORT_MMX}
-              isunaryoperatoroverloadable:=true;
+
+              result:=true;
             end;
 
           notn :
             begin
-              if is_integer(rd) or
-                 is_boolean(rd) then
-               begin
-                 isunaryoperatoroverloadable:=false;
-                 exit;
-               end;
+              if is_integer(ld) or
+                 is_boolean(ld) then
+                exit;
 
 {$ifdef SUPPORT_MMX}
               if (cs_mmx in aktlocalswitches) and
-                 is_mmx_able_array(rd) then
-               begin
-                 isunaryoperatoroverloadable:=false;
-                 exit;
-               end;
+                 is_mmx_able_array(ld) then
+                exit;
 {$endif SUPPORT_MMX}
-              isunaryoperatoroverloadable:=true;
+
+              result:=true;
             end;
         end;
       end;
@@ -324,135 +334,274 @@ implementation
 
     function isoperatoracceptable(pf : tprocdef; optoken : ttoken) : boolean;
       var
-        ld,rd,dd : tdef;
+        ld,rd : tdef;
         i : longint;
+        eq : tequaltype;
+        conv : tconverttype;
+        pd : tprocdef;
       begin
+        result:=false;
         case pf.parast.symindex.count of
+          1 : begin
+                ld:=tvarsym(pf.parast.symindex.first).vartype.def;
+                { assignment is a special case }
+                if optoken=_ASSIGNMENT then
+                  begin
+                    eq:=compare_defs_ext(ld,pf.rettype.def,nothingn,conv,pd,[cdo_explicit]);
+                    result:=(eq=te_incompatible);
+                  end
+                else
+                  begin
+                    for i:=1 to tok2nodes do
+                      if tok2node[i].tok=optoken then
+                        begin
+                          result:=
+                            tok2node[i].op_overloading_supported and
+                            isunaryoperatoroverloadable(tok2node[i].nod,ld);
+                          break;
+                        end;
+                  end;
+              end;
           2 : begin
-                isoperatoracceptable:=false;
                 for i:=1 to tok2nodes do
                   if tok2node[i].tok=optoken then
                     begin
                       ld:=tvarsym(pf.parast.symindex.first).vartype.def;
                       rd:=tvarsym(pf.parast.symindex.first.indexnext).vartype.def;
-                      dd:=pf.rettype.def;
-                      isoperatoracceptable:=
+                      result:=
                         tok2node[i].op_overloading_supported and
                         isbinaryoperatoroverloadable(tok2node[i].nod,ld,nothingn,rd,nothingn);
                       break;
                     end;
               end;
-          1 : begin
-                rd:=tvarsym(pf.parast.symindex.first).vartype.def;
-                dd:=pf.rettype.def;
-                for i:=1 to tok2nodes do
-                  if tok2node[i].tok=optoken then
-                    begin
-                      isoperatoracceptable:=
-                        tok2node[i].op_overloading_supported and
-                        isunaryoperatoroverloadable(rd,dd,tok2node[i].nod);
-                      break;
-                    end;
-              end;
-          else
-            isoperatoracceptable:=false;
+        end;
+      end;
+
+
+    function isunaryoverloaded(var t : tnode) : boolean;
+      var
+        ld      : tdef;
+        optoken : ttoken;
+        operpd  : tprocdef;
+        ppn     : tcallparanode;
+        candidates : tcallcandidates;
+        cand_cnt : integer;
+      begin
+        result:=false;
+        operpd:=nil;
+        { load easier access variables }
+        ld:=tunarynode(t).left.resulttype.def;
+        if not isunaryoperatoroverloadable(t.nodetype,ld) then
+          exit;
+
+        case t.nodetype of
+           notn:
+             optoken:=_OP_NOT;
+           unaryminusn:
+             optoken:=_MINUS;
+           else
+             exit;
+        end;
+
+        { generate parameter nodes }
+        ppn:=ccallparanode.create(tunarynode(t).left.getcopy,nil);
+        ppn.get_paratype;
+        candidates:=tcallcandidates.create_operator(optoken,ppn);
+
+        { stop when there are no operators found }
+        if candidates.count=0 then
+          begin
+            CGMessage(parser_e_operator_not_overloaded);
+            candidates.free;
+            ppn.free;
+            exit;
           end;
+
+        { Retrieve information about the candidates }
+        candidates.get_information;
+{$ifdef EXTDEBUG}
+        { Display info when multiple candidates are found }
+        candidates.dump_info(V_Debug);
+{$endif EXTDEBUG}
+        cand_cnt:=candidates.choose_best(operpd);
+
+        { exit when no overloads are found }
+        if cand_cnt=0 then
+          begin
+            candidates.free;
+            ppn.free;
+            result:=false;
+            exit;
+          end;
+
+        { Multiple candidates left? }
+        if cand_cnt>1 then
+          begin
+            CGMessage(cg_e_cant_choose_overload_function);
+{$ifdef EXTDEBUG}
+            candidates.dump_info(V_Hint);
+{$else EXTDEBUG}
+            candidates.list(false);
+{$endif EXTDEBUG}
+            { we'll just use the first candidate to make the
+              call }
+          end;
+        candidates.free;
+
+        inc(operpd.procsym.refs);
+
+        { the nil as symtable signs firstcalln that this is
+          an overloaded operator }
+        t:=ccallnode.create(ppn,Tprocsym(operpd.procsym),nil,nil);
+
+        { we already know the procdef to use, so it can
+          skip the overload choosing in callnode.det_resulttype }
+        tcallnode(t).procdefinition:=operpd;
+
+        result:=true;
       end;
 
 
     function isbinaryoverloaded(var t : tnode) : boolean;
-
-     var
-         rd,ld   : tdef;
-         optoken : ttoken;
-         operpd  : tprocdef;
-         ht      : tnode;
+      var
+        rd,ld   : tdef;
+        optoken : ttoken;
+        operpd  : tprocdef;
+        ht      : tnode;
+        ppn     : tcallparanode;
+        candidates : tcallcandidates;
+        cand_cnt : integer;
       begin
         isbinaryoverloaded:=false;
         operpd:=nil;
         { load easier access variables }
         ld:=tbinarynode(t).left.resulttype.def;
         rd:=tbinarynode(t).right.resulttype.def;
-        if isbinaryoperatoroverloadable(t.nodetype,ld,tbinarynode(t).left.nodetype,rd,tbinarynode(t).right.nodetype) then
+        if not isbinaryoperatoroverloadable(t.nodetype,ld,tbinarynode(t).left.nodetype,rd,tbinarynode(t).right.nodetype) then
+          exit;
+
+        isbinaryoverloaded:=true;
+        case t.nodetype of
+           equaln,
+           unequaln :
+             optoken:=_EQUAL;
+           addn:
+             optoken:=_PLUS;
+           subn:
+             optoken:=_MINUS;
+           muln:
+             optoken:=_STAR;
+           starstarn:
+             optoken:=_STARSTAR;
+           slashn:
+             optoken:=_SLASH;
+           ltn:
+             optoken:=_LT;
+           gtn:
+             optoken:=_GT;
+           lten:
+             optoken:=_LTE;
+           gten:
+             optoken:=_GTE;
+           symdifn :
+             optoken:=_SYMDIF;
+           modn :
+             optoken:=_OP_MOD;
+           orn :
+             optoken:=_OP_OR;
+           xorn :
+             optoken:=_OP_XOR;
+           andn :
+             optoken:=_OP_AND;
+           divn :
+             optoken:=_OP_DIV;
+           shln :
+             optoken:=_OP_SHL;
+           shrn :
+             optoken:=_OP_SHR;
+           else
+             exit;
+        end;
+
+        { 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);
+
+        { for commutative operators we can swap arguments and try again }
+        if (candidates.count=0) and
+           not(optoken in [_OP_SHL,_OP_SHR,_OP_DIV,_OP_MOD,_STARSTAR,_SLASH,_MINUS]) then
           begin
-             isbinaryoverloaded:=true;
-             case t.nodetype of
-                equaln,
-                unequaln :
-                  optoken:=_EQUAL;
-                addn:
-                  optoken:=_PLUS;
-                subn:
-                  optoken:=_MINUS;
-                muln:
-                  optoken:=_STAR;
-                starstarn:
-                  optoken:=_STARSTAR;
-                slashn:
-                  optoken:=_SLASH;
-                ltn:
-                  optoken:=tokens._lt;
-                gtn:
-                  optoken:=tokens._gt;
-                lten:
-                  optoken:=_lte;
-                gten:
-                  optoken:=_gte;
-                symdifn :
-                  optoken:=_SYMDIF;
-                modn :
-                  optoken:=_OP_MOD;
-                orn :
-                  optoken:=_OP_OR;
-                xorn :
-                  optoken:=_OP_XOR;
-                andn :
-                  optoken:=_OP_AND;
-                divn :
-                  optoken:=_OP_DIV;
-                shln :
-                  optoken:=_OP_SHL;
-                shrn :
-                  optoken:=_OP_SHR;
-                else
-                  exit;
-             end;
-             operpd:=search_binary_operator(optoken,ld,rd);
-             if operpd=nil then
-               begin
-                 CGMessage(parser_e_operator_not_overloaded);
-                 isbinaryoverloaded:=false;
-                 exit;
-               end;
-             inc(operpd.procsym.refs);
-
-             { the nil as symtable signs firstcalln that this is
-               an overloaded operator }
-             ht:=ccallnode.create(nil,Tprocsym(operpd.procsym),nil,nil);
-
-             { we already know the procdef to use for equal, so it can
-               skip the overload choosing in callnode.det_resulttype }
-             if assigned(operpd) then
-               tcallnode(ht).procdefinition:=operpd;
-             { we need copies, because the originals will be destroyed when we give a }
-             { changed node back to firstpass! (JM)                                   }
-             if assigned(tbinarynode(t).left) then
-               if assigned(tbinarynode(t).right) then
-                 tcallnode(ht).left :=
-                   ccallparanode.create(tbinarynode(t).right.getcopy,
-                                        ccallparanode.create(tbinarynode(t).left.getcopy,nil))
-               else
-                 tcallnode(ht).left :=
-                   ccallparanode.create(nil,
-                                        ccallparanode.create(tbinarynode(t).left.getcopy,nil))
-             else if assigned(tbinarynode(t).right) then
-                 tcallnode(ht).left :=
-                    ccallparanode.create(tbinarynode(t).right.getcopy,
-                                         ccallparanode.create(nil,nil));
-             if t.nodetype=unequaln then
-               ht:=cnotnode.create(ht);
-             t:=ht;
+            candidates.free;
+            reverseparameters(ppn);
+            { reverse compare operators }
+            case optoken of
+              _LT:
+                optoken:=_GTE;
+              _GT:
+                optoken:=_LTE;
+              _LTE:
+                optoken:=_GT;
+              _GTE:
+                optoken:=_LT;
+            end;
+            candidates:=tcallcandidates.create_operator(optoken,ppn);
+          end;
+
+        { stop when there are no operators found }
+        if candidates.count=0 then
+          begin
+            CGMessage(parser_e_operator_not_overloaded);
+            candidates.free;
+            ppn.free;
+            result:=false;
+            exit;
+          end;
+
+        { Retrieve information about the candidates }
+        candidates.get_information;
+{$ifdef EXTDEBUG}
+        { Display info when multiple candidates are found }
+        candidates.dump_info(V_Debug);
+{$endif EXTDEBUG}
+        cand_cnt:=candidates.choose_best(operpd);
+
+        { exit when no overloads are found }
+        if cand_cnt=0 then
+          begin
+            candidates.free;
+            ppn.free;
+            result:=false;
+            exit;
           end;
+
+        { Multiple candidates left? }
+        if cand_cnt>1 then
+          begin
+            CGMessage(cg_e_cant_choose_overload_function);
+{$ifdef EXTDEBUG}
+            candidates.dump_info(V_Hint);
+{$else EXTDEBUG}
+            candidates.list(false);
+{$endif EXTDEBUG}
+            { we'll just use the first candidate to make the
+              call }
+          end;
+        candidates.free;
+
+        inc(operpd.procsym.refs);
+
+        { the nil as symtable signs firstcalln that this is
+          an overloaded operator }
+        ht:=ccallnode.create(ppn,Tprocsym(operpd.procsym),nil,nil);
+
+        { we already know the procdef to use, so it can
+          skip the overload choosing in callnode.det_resulttype }
+        tcallnode(ht).procdefinition:=operpd;
+
+        if t.nodetype=unequaln then
+          ht:=cnotnode.create(ht);
+        t:=ht;
       end;
 
 
@@ -941,10 +1090,817 @@ implementation
         valid_for_assignment:=valid_for_assign(p,[valid_property]);
       end;
 
+
+    procedure var_para_allowed(var eq:tequaltype;def_from,def_to:Tdef);
+      begin
+        { Note: eq must be already valid, it will only be updated! }
+        case def_to.deftype of
+          formaldef :
+            begin
+              { all types can be passed to a formaldef }
+              eq:=te_equal;
+            end;
+          orddef :
+            begin
+              { allows conversion from word to integer and
+                byte to shortint, but only for TP7 compatibility }
+              if (m_tp7 in aktmodeswitches) and
+                 (def_from.deftype=orddef) and
+                 (def_from.size=def_to.size) then
+                eq:=te_convert_l1;
+            end;
+          arraydef :
+            begin
+              if is_open_array(def_to) and
+                 is_dynamic_array(def_from) and
+                equal_defs(tarraydef(def_from).elementtype.def,tarraydef(def_to).elementtype.def) then
+                eq:=te_convert_l2;
+            end;
+          pointerdef :
+            begin
+              { an implicit pointer conversion is allowed }
+              if (def_from.deftype=pointerdef) then
+                eq:=te_convert_l1;
+            end;
+          stringdef :
+            begin
+              { all shortstrings are allowed, size is not important }
+              if is_shortstring(def_from) and
+                 is_shortstring(def_to) then
+                eq:=te_equal;
+            end;
+          objectdef :
+            begin
+              { child objects can be also passed }
+              { in non-delphi mode, otherwise    }
+              { they must match exactly, except  }
+              { if they are objects              }
+              if (def_from.deftype=objectdef) and
+                 (
+                  not(m_delphi in aktmodeswitches) or
+                  (
+                   (tobjectdef(def_from).objecttype=odt_object) and
+                   (tobjectdef(def_to).objecttype=odt_object)
+                  )
+                 ) and
+                 (tobjectdef(def_from).is_related(tobjectdef(def_to))) then
+                eq:=te_convert_l1;
+            end;
+          filedef :
+            begin
+              { an implicit file conversion is also allowed }
+              { from a typed file to an untyped one           }
+              if (def_from.deftype=filedef) and
+                 (tfiledef(def_from).filetyp = ft_typed) and
+                 (tfiledef(def_to).filetyp = ft_untyped) then
+                eq:=te_convert_l1;
+            end;
+        end;
+      end;
+
+
+    procedure para_allowed(var eq:tequaltype;p:tcallparanode;def_to:tdef);
+      begin
+        { Note: eq must be already valid, it will only be updated! }
+        case def_to.deftype of
+          formaldef :
+            begin
+              { all types can be passed to a formaldef }
+              eq:=te_equal;
+            end;
+          stringdef :
+            begin
+              { to support ansi/long/wide strings in a proper way }
+              { string and string[10] are assumed as equal }
+              { when searching the correct overloaded procedure   }
+              if (p.resulttype.def.deftype=stringdef) and
+                 (tstringdef(def_to).string_typ=tstringdef(p.resulttype.def).string_typ) then
+                eq:=te_equal
+              else
+              { Passing a constant char to ansistring or shortstring or
+                a widechar to widestring then handle it as equal. }
+               if (p.left.nodetype=ordconstn) and
+                  (
+                   is_char(p.resulttype.def) and
+                   (is_shortstring(def_to) or is_ansistring(def_to))
+                  ) or
+                  (
+                   is_widechar(p.resulttype.def) and
+                   is_widestring(def_to)
+                  ) then
+                eq:=te_equal
+            end;
+          setdef :
+            begin
+              { set can also be a not yet converted array constructor }
+              if (p.resulttype.def.deftype=arraydef) and
+                 (tarraydef(p.resulttype.def).IsConstructor) and
+                 not(tarraydef(p.resulttype.def).IsVariant) then
+                eq:=te_equal;
+            end;
+          procvardef :
+            begin
+              { in tp7 mode proc -> procvar is allowed }
+              if (m_tp_procvar in aktmodeswitches) and
+                 (p.left.nodetype=calln) and
+                 (proc_to_procvar_equal(tprocdef(tcallnode(p.left).procdefinition),tprocvardef(def_to),true)>=te_equal) then
+               eq:=te_equal;
+            end;
+        end;
+      end;
+
+
+
+{****************************************************************************
+                           TCallCandidates
+****************************************************************************}
+
+    constructor tcallcandidates.create(sym:tprocsym;st:tsymtable;ppn:tnode;isprop:boolean);
+      var
+        j          : integer;
+        pd         : tprocdef;
+        hp         : pcandidate;
+        found,
+        has_overload_directive : boolean;
+        topclassh  : tobjectdef;
+        srsymtable : tsymtable;
+        srprocsym  : tprocsym;
+        pt         : tcallparanode;
+
+      begin
+        FProcSym:=sym;
+        FProcs:=nil;
+        FProccnt:=0;
+        FProcvisiblecnt:=0;
+        FParanode:=ppn;
+        FAllowVariant:=true;
+
+        { determine length of parameter list }
+        pt:=tcallparanode(ppn);
+        FParalength:=0;
+        while assigned(pt) do
+         begin
+           inc(FParalength);
+           pt:=tcallparanode(pt.right);
+         end;
+
+        { when the definition has overload directive set, we search for
+          overloaded definitions in the class, this only needs to be done once
+          for class entries as the tree keeps always the same }
+        if (not sym.overloadchecked) and
+           (sym.owner.symtabletype=objectsymtable) and
+           (po_overload in sym.first_procdef.procoptions) then
+         search_class_overloads(sym);
+
+        { when the class passed is defined in this unit we
+          need to use the scope of that class. This is a trick
+          that can be used to access protected members in other
+          units. At least kylix supports it this way (PFV) }
+        if assigned(st) and
+           (st.symtabletype=objectsymtable) and
+           (st.defowner.owner.symtabletype in [globalsymtable,staticsymtable]) and
+           (st.defowner.owner.unitid=0) then
+          topclassh:=tobjectdef(st.defowner)
+        else
+          begin
+            if assigned(current_procinfo) then
+              topclassh:=current_procinfo.procdef._class
+            else
+              topclassh:=nil;
+          end;
+
+        { link all procedures which have the same # of parameters }
+        for j:=1 to sym.procdef_count do
+          begin
+            pd:=sym.procdef[j];
+            { Is the procdef visible? This needs to be checked on
+              procdef level since a symbol can contain both private and
+              public declarations. But the check should not be done
+              when the callnode is generated by a property }
+            if isprop or
+               (pd.owner.symtabletype<>objectsymtable) or
+               pd.is_visible_for_object(topclassh) then
+             begin
+               { we have at least one procedure that is visible }
+               inc(FProcvisiblecnt);
+               { only when the # of parameter are supported by the
+                 procedure }
+               if (FParalength>=pd.minparacount) and
+                  ((po_varargs in pd.procoptions) or { varargs }
+                   (FParalength<=pd.maxparacount)) then
+                 proc_add(pd);
+             end;
+          end;
+
+        { remember if the procedure is declared with the overload directive,
+          it's information is still needed also after all procs are removed }
+        has_overload_directive:=(po_overload in sym.first_procdef.procoptions);
+
+        { when the definition has overload directive set, we search for
+          overloaded definitions in the symtablestack. The found
+          entries are only added to the procs list and not the procsym, because
+          the list can change in every situation }
+        if has_overload_directive and
+           (sym.owner.symtabletype<>objectsymtable) then
+          begin
+            srsymtable:=sym.owner.next;
+            while assigned(srsymtable) do
+             begin
+               if srsymtable.symtabletype in [localsymtable,staticsymtable,globalsymtable] then
+                begin
+                  srprocsym:=tprocsym(srsymtable.speedsearch(sym.name,sym.speedvalue));
+                  { process only visible procsyms }
+                  if assigned(srprocsym) and
+                     (srprocsym.typ=procsym) and
+                     srprocsym.is_visible_for_object(topclassh) then
+                   begin
+                     { if this procedure doesn't have overload we can stop
+                       searching }
+                     if not(po_overload in srprocsym.first_procdef.procoptions) then
+                      break;
+                     { process all overloaded definitions }
+                     for j:=1 to srprocsym.procdef_count do
+                      begin
+                        pd:=srprocsym.procdef[j];
+                        { only when the # of parameter are supported by the
+                          procedure }
+                        if (FParalength>=pd.minparacount) and
+                           ((po_varargs in pd.procoptions) or { varargs }
+                           (FParalength<=pd.maxparacount)) then
+                         begin
+                           found:=false;
+                           hp:=FProcs;
+                           while assigned(hp) do
+                            begin
+                              { Only compare visible parameters for the user }
+                              if compare_paras(hp^.data.para,pd.para,cp_value_equal_const,[cpo_ignorehidden])>=te_equal then
+                               begin
+                                 found:=true;
+                                 break;
+                               end;
+                              hp:=hp^.next;
+                            end;
+                           if not found then
+                             proc_add(pd);
+                         end;
+                      end;
+                   end;
+                end;
+               srsymtable:=srsymtable.next;
+             end;
+          end;
+      end;
+
+
+    constructor tcallcandidates.create_operator(op:ttoken;ppn:tnode);
+      var
+        j          : integer;
+        pd         : tprocdef;
+        hp         : pcandidate;
+        found      : boolean;
+        srsymtable : tsymtable;
+        srprocsym  : tprocsym;
+        pt         : tcallparanode;
+        sv         : cardinal;
+      begin
+        FProcSym:=nil;
+        FProcs:=nil;
+        FProccnt:=0;
+        FProcvisiblecnt:=0;
+        FParanode:=ppn;
+        FAllowVariant:=false;
+
+        { determine length of parameter list }
+        pt:=tcallparanode(ppn);
+        FParalength:=0;
+        while assigned(pt) do
+         begin
+           if pt.resulttype.def.deftype=variantdef then
+             FAllowVariant:=true;
+           inc(FParalength);
+           pt:=tcallparanode(pt.right);
+         end;
+
+        { we search all overloaded operator definitions in the symtablestack. The found
+          entries are only added to the procs list and not the procsym, because
+          the list can change in every situation }
+        sv:=getspeedvalue(overloaded_names[op]);
+        srsymtable:=symtablestack;
+        while assigned(srsymtable) do
+          begin
+            if srsymtable.symtabletype in [localsymtable,staticsymtable,globalsymtable] then
+              begin
+                srprocsym:=tprocsym(srsymtable.speedsearch(overloaded_names[op],sv));
+                if assigned(srprocsym) and
+                   (srprocsym.typ=procsym) then
+                  begin
+                    { Store first procsym found }
+                    if not assigned(FProcsym) then
+                      FProcsym:=srprocsym;
+
+                    { process all overloaded definitions }
+                    for j:=1 to srprocsym.procdef_count do
+                      begin
+                        pd:=srprocsym.procdef[j];
+                        { only when the # of parameter are supported by the
+                          procedure }
+                        if (FParalength>=pd.minparacount) and
+                           (FParalength<=pd.maxparacount) then
+                          begin
+                            found:=false;
+                            hp:=FProcs;
+                            while assigned(hp) do
+                              begin
+                                { Only compare visible parameters for the user }
+                                if compare_paras(hp^.data.para,pd.para,cp_value_equal_const,[cpo_ignorehidden])>=te_equal then
+                                  begin
+                                    found:=true;
+                                    break;
+                                  end;
+                                hp:=hp^.next;
+                              end;
+                            if not found then
+                              proc_add(pd);
+                          end;
+                      end;
+                  end;
+              end;
+            srsymtable:=srsymtable.next;
+          end;
+      end;
+
+
+    destructor tcallcandidates.destroy;
+      var
+        hpnext,
+        hp : pcandidate;
+      begin
+        hp:=FProcs;
+        while assigned(hp) do
+         begin
+           hpnext:=hp^.next;
+           dispose(hp);
+           hp:=hpnext;
+         end;
+      end;
+
+
+    function tcallcandidates.proc_add(pd:tprocdef):pcandidate;
+      var
+        i : integer;
+      begin
+        { generate new candidate entry }
+        new(result);
+        fillchar(result^,sizeof(tcandidate),0);
+        result^.data:=pd;
+        result^.next:=FProcs;
+        FProcs:=result;
+        inc(FProccnt);
+        { Find last parameter, skip all default parameters
+          that are not passed. Ignore this skipping for varargs }
+        result^.firstpara:=tparaitem(pd.Para.last);
+        if not(po_varargs in pd.procoptions) then
+         begin
+           { ignore hidden parameters }
+           while assigned(result^.firstpara) and (result^.firstpara.is_hidden) do
+             result^.firstpara:=tparaitem(result^.firstpara.previous);
+           for i:=1 to pd.maxparacount-FParalength do
+             begin
+               if not assigned(result^.firstpara) then
+                 internalerror(200401141);
+               result^.firstpara:=tparaitem(result^.firstPara.previous);
+             end;
+         end;
+      end;
+
+
+    procedure tcallcandidates.list(all:boolean);
+      var
+        hp : pcandidate;
+      begin
+        hp:=FProcs;
+        while assigned(hp) do
+         begin
+           if all or
+              (not hp^.invalid) then
+             MessagePos1(hp^.data.fileinfo,sym_h_param_list,hp^.data.fullprocname(false));
+           hp:=hp^.next;
+         end;
+      end;
+
+
+{$ifdef EXTDEBUG}
+    procedure tcallcandidates.dump_info(lvl:longint);
+
+        function ParaTreeStr(p:tcallparanode):string;
+        begin
+          result:='';
+          while assigned(p) do
+           begin
+             if result<>'' then
+              result:=result+',';
+             result:=result+p.resulttype.def.typename;
+             p:=tcallparanode(p.right);
+           end;
+        end;
+
+      var
+        hp : pcandidate;
+        currpara : tparaitem;
+      begin
+        if not CheckVerbosity(lvl) then
+         exit;
+        Comment(lvl+V_LineInfo,'Overloaded callnode: '+FProcSym.name+'('+ParaTreeStr(tcallparanode(FParaNode))+')');
+        hp:=FProcs;
+        while assigned(hp) do
+         begin
+           Comment(lvl,'  '+hp^.data.fullprocname(false));
+           if (hp^.invalid) then
+            Comment(lvl,'   invalid')
+           else
+            begin
+              Comment(lvl,'   ex: '+tostr(hp^.exact_count)+
+                          ' eq: '+tostr(hp^.equal_count)+
+                          ' l1: '+tostr(hp^.cl1_count)+
+                          ' l2: '+tostr(hp^.cl2_count)+
+                          ' l3: '+tostr(hp^.cl3_count)+
+                          ' oper: '+tostr(hp^.coper_count)+
+                          ' ord: '+realtostr(hp^.exact_count));
+              { Print parameters in left-right order }
+              currpara:=hp^.firstpara;
+              if assigned(currpara) then
+               begin
+                 while assigned(currpara.next) do
+                  currpara:=tparaitem(currpara.next);
+               end;
+              while assigned(currpara) do
+               begin
+                 if (not currpara.is_hidden) then
+                   Comment(lvl,'    - '+currpara.paratype.def.typename+' : '+EqualTypeName[currpara.eqval]);
+                 currpara:=tparaitem(currpara.previous);
+               end;
+            end;
+           hp:=hp^.next;
+         end;
+      end;
+{$endif EXTDEBUG}
+
+
+    procedure tcallcandidates.get_information;
+      var
+        hp       : pcandidate;
+        currpara : tparaitem;
+        currparanr : byte;
+        def_from,
+        def_to   : tdef;
+        currpt,
+        pt       : tcallparanode;
+        eq       : tequaltype;
+        convtype : tconverttype;
+        pdoper   : tprocdef;
+        releasecurrpt : boolean;
+        cdoptions : tcompare_defs_options;
+      begin
+        cdoptions:=[cdo_check_operator];
+        if FAllowVariant then
+          include(cdoptions,cdo_allow_variant);
+        { process all procs }
+        hp:=FProcs;
+        while assigned(hp) do
+         begin
+           { We compare parameters in reverse order (right to left),
+             the firstpara is already pointing to the last parameter
+             were we need to start comparing }
+           currparanr:=FParalength;
+           currpara:=hp^.firstpara;
+           while assigned(currpara) and (currpara.is_hidden) do
+             currpara:=tparaitem(currpara.previous);
+           pt:=tcallparanode(FParaNode);
+           while assigned(pt) and assigned(currpara) do
+            begin
+              { currpt can be changed from loadn to calln when a procvar
+                is passed. This is to prevent that the change is permanent }
+              currpt:=pt;
+              releasecurrpt:=false;
+              { retrieve current parameter definitions to compares }
+              eq:=te_incompatible;
+              def_from:=currpt.resulttype.def;
+              def_to:=currpara.paratype.def;
+              if not(assigned(def_from)) then
+               internalerror(200212091);
+              if not(
+                     assigned(def_to) or
+                     ((po_varargs in hp^.data.procoptions) and
+                      (currparanr>hp^.data.minparacount))
+                    ) then
+               internalerror(200212092);
+
+              { Convert tp procvars when not expecting a procvar }
+              if (def_to.deftype<>procvardef) and
+                 (currpt.left.resulttype.def.deftype=procvardef) then
+                begin
+                  releasecurrpt:=true;
+                  currpt:=tcallparanode(pt.getcopy);
+                  if maybe_call_procvar(currpt.left,true) then
+                    begin
+                      currpt.resulttype:=currpt.left.resulttype;
+                      def_from:=currpt.left.resulttype.def;
+                    end;
+                end;
+
+              { varargs are always equal, but not exact }
+              if (po_varargs in hp^.data.procoptions) and
+                 (currparanr>hp^.data.minparacount) then
+               begin
+                 eq:=te_equal;
+               end
+              else
+              { same definition -> exact }
+               if (def_from=def_to) then
+                begin
+                  eq:=te_exact;
+                end
+              else
+              { for value and const parameters check if a integer is constant or
+                included in other integer -> equal and calc ordinal_distance }
+               if not(currpara.paratyp in [vs_var,vs_out]) and
+                  is_integer(def_from) and
+                  is_integer(def_to) and
+                  is_in_limit(def_from,def_to) then
+                 begin
+                   eq:=te_equal;
+                   hp^.ordinal_distance:=hp^.ordinal_distance+
+                     abs(bestreal(torddef(def_from).low)-bestreal(torddef(def_to).low));
+                   hp^.ordinal_distance:=hp^.ordinal_distance+
+                     abs(bestreal(torddef(def_to).high)-bestreal(torddef(def_from).high));
+                   { Give wrong sign a small penalty, this is need to get a diffrence
+                     from word->[longword,longint] }
+                   if is_signed(def_from)<>is_signed(def_to) then
+                     hp^.ordinal_distance:=hp^.ordinal_distance+1.0;
+                 end
+              else
+              { generic type comparision }
+               begin
+                 eq:=compare_defs_ext(def_from,def_to,currpt.left.nodetype,convtype,pdoper,cdoptions);
+
+                 { when the types are not equal we need to check
+                   some special case for parameter passing }
+                 if (eq<te_equal) then
+                  begin
+                    if currpara.paratyp in [vs_var,vs_out] then
+                      begin
+                        { para requires an equal type so the previous found
+                          match was not good enough, reset to incompatible }
+                        eq:=te_incompatible;
+                        { var_para_allowed will return te_equal and te_convert_l1 to
+                          make a difference for best matching }
+                        var_para_allowed(eq,currpt.resulttype.def,currpara.paratype.def)
+                      end
+                    else
+                      para_allowed(eq,currpt,def_to);
+                  end;
+               end;
+
+              { when a procvar was changed to a call an exact much is
+                downgraded to equal. This way an overload call with the
+                procvar is choosen. See tb0471 (PFV) }
+              if (pt<>currpt) and (eq=te_exact) then
+                eq:=te_equal;
+
+              { increase correct counter }
+              case eq of
+                te_exact :
+                  inc(hp^.exact_count);
+                te_equal :
+                  inc(hp^.equal_count);
+                te_convert_l1 :
+                  inc(hp^.cl1_count);
+                te_convert_l2 :
+                  inc(hp^.cl2_count);
+                te_convert_l3 :
+                  inc(hp^.cl3_count);
+                te_convert_operator :
+                  inc(hp^.coper_count);
+                te_incompatible :
+                  hp^.invalid:=true;
+                else
+                  internalerror(200212072);
+              end;
+
+              { stop checking when an incompatible parameter is found }
+              if hp^.invalid then
+               begin
+                 { store the current parameter info for
+                   a nice error message when no procedure is found }
+                 hp^.wrongpara:=currpara;
+                 hp^.wrongparanr:=currparanr;
+                 break;
+               end;
+
+{$ifdef EXTDEBUG}
+              { store equal in node tree for dump }
+              currpara.eqval:=eq;
+{$endif EXTDEBUG}
+
+              { maybe release temp currpt }
+              if releasecurrpt then
+                currpt.free;
+
+              { next parameter in the call tree }
+              pt:=tcallparanode(pt.right);
+
+              { next parameter for definition, only goto next para
+                if we're out of the varargs }
+              if not(po_varargs in hp^.data.procoptions) or
+                 (currparanr<=hp^.data.maxparacount) then
+               begin
+                 { Ignore vs_hidden parameters }
+                 repeat
+                   currpara:=tparaitem(currpara.previous);
+                 until (not assigned(currpara)) or (not currpara.is_hidden);
+               end;
+              dec(currparanr);
+            end;
+           if not(hp^.invalid) and
+              (assigned(pt) or assigned(currpara) or (currparanr<>0)) then
+             internalerror(200212141);
+           { next candidate }
+           hp:=hp^.next;
+         end;
+      end;
+
+
+    function is_better_candidate(currpd,bestpd:pcandidate):integer;
+      var
+        res : integer;
+      begin
+        {
+          Return values:
+            > 0 when currpd is better than bestpd
+            < 0 when bestpd is better than currpd
+            = 0 when both are equal
+
+          To choose the best candidate we use the following order:
+          - Incompatible flag
+          - (Smaller) Number of convert operator parameters.
+          - (Smaller) Number of convertlevel 2 parameters.
+          - (Smaller) Number of convertlevel 1 parameters.
+          - (Bigger) Number of exact parameters.
+          - (Smaller) Number of equal parameters.
+          - (Smaller) Total of ordinal distance. For example, the distance of a word
+            to a byte is 65535-255=65280.
+        }
+        if bestpd^.invalid then
+         begin
+           if currpd^.invalid then
+            res:=0
+           else
+            res:=1;
+         end
+        else
+         if currpd^.invalid then
+          res:=-1
+        else
+         begin
+           { less operator parameters? }
+           res:=(bestpd^.coper_count-currpd^.coper_count);
+           if (res=0) then
+            begin
+              { less cl3 parameters? }
+              res:=(bestpd^.cl3_count-currpd^.cl3_count);
+              if (res=0) then
+               begin
+                 { less cl2 parameters? }
+                 res:=(bestpd^.cl2_count-currpd^.cl2_count);
+                 if (res=0) then
+                  begin
+                    { less cl1 parameters? }
+                    res:=(bestpd^.cl1_count-currpd^.cl1_count);
+                    if (res=0) then
+                     begin
+                       { more exact parameters? }
+                       res:=(currpd^.exact_count-bestpd^.exact_count);
+                       if (res=0) then
+                        begin
+                          { less equal parameters? }
+                          res:=(bestpd^.equal_count-currpd^.equal_count);
+                          if (res=0) then
+                           begin
+                             { smaller ordinal distance? }
+                             if (currpd^.ordinal_distance<bestpd^.ordinal_distance) then
+                              res:=1
+                             else
+                              if (currpd^.ordinal_distance>bestpd^.ordinal_distance) then
+                               res:=-1
+                             else
+                              res:=0;
+                           end;
+                        end;
+                     end;
+                  end;
+               end;
+            end;
+         end;
+        is_better_candidate:=res;
+      end;
+
+
+    function tcallcandidates.choose_best(var bestpd:tabstractprocdef):integer;
+      var
+        besthpstart,
+        hp       : pcandidate;
+        cntpd,
+        res      : integer;
+      begin
+        {
+          Returns the number of candidates left and the
+          first candidate is returned in pdbest
+        }
+        { Setup the first procdef as best, only count it as a result
+          when it is valid }
+        bestpd:=FProcs^.data;
+        if FProcs^.invalid then
+         cntpd:=0
+        else
+         cntpd:=1;
+        if assigned(FProcs^.next) then
+         begin
+           besthpstart:=FProcs;
+           hp:=FProcs^.next;
+           while assigned(hp) do
+            begin
+              res:=is_better_candidate(hp,besthpstart);
+              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;
+         end;
+
+        result:=cntpd;
+      end;
+
+
+    procedure tcallcandidates.find_wrong_para;
+      var
+        currparanr : smallint;
+        hp : pcandidate;
+        pt : tcallparanode;
+      begin
+        { Only process the first overloaded procdef }
+        hp:=FProcs;
+        { Find callparanode corresponding to the argument }
+        pt:=tcallparanode(FParanode);
+        currparanr:=FParalength;
+        while assigned(pt) and
+              (currparanr>hp^.wrongparanr) do
+         begin
+           pt:=tcallparanode(pt.right);
+           dec(currparanr);
+         end;
+        if (currparanr<>hp^.wrongparanr) or
+           not assigned(pt) then
+          internalerror(200212094);
+        { Show error message, when it was a var or out parameter
+          guess that it is a missing typeconv }
+        if hp^.wrongpara.paratyp in [vs_var,vs_out] then
+          CGMessagePos2(pt.fileinfo,parser_e_call_by_ref_without_typeconv,
+            pt.resulttype.def.typename,hp^.wrongpara.paratype.def.typename)
+        else
+          CGMessagePos3(pt.fileinfo,type_e_wrong_parameter_type,
+            tostr(hp^.wrongparanr),pt.resulttype.def.typename,hp^.wrongpara.paratype.def.typename);
+      end;
+
+
 end.
 {
   $Log$
-  Revision 1.80  2004-02-20 21:55:19  peter
+  Revision 1.81  2004-02-24 16:12:39  peter
+    * operator overload chooses rewrite
+    * overload choosing is now generic and moved to htypechk
+
+  Revision 1.80  2004/02/20 21:55:19  peter
     * widestring conversions added to allowed operator check
 
   Revision 1.79  2004/02/13 15:42:21  peter

compiler/ncal.pas

@@ -37,23 +37,6 @@ interface
        symbase,symtype,symsym,symdef,symtable;
 
     type
-       pcandidate = ^tcandidate;
-       tcandidate = record
-          next        : pcandidate;
-          data        : tprocdef;
-          wrongpara,
-          firstpara   : tparaitem;
-          exact_count,
-          equal_count,
-          cl1_count,
-          cl2_count,
-          cl3_count,
-          coper_count : integer; { should be signed }
-          ordinal_distance : bestreal;
-          invalid     : boolean;
-          wrongparanr : byte;
-       end;
-
        tcallnodeflags = (
          cnf_restypeset
        );
@@ -64,15 +47,6 @@ interface
           { number of parameters passed from the source, this does not include the hidden parameters }
           paralength   : smallint;
           paravisible  : boolean;
-          function  candidates_find:pcandidate;
-          procedure candidates_free(procs:pcandidate);
-          procedure candidates_list(procs:pcandidate;all:boolean);
-          procedure candidates_get_information(procs:pcandidate);
-          function  candidates_choose_best(procs:pcandidate;var bestpd:tabstractprocdef):integer;
-          procedure candidates_find_wrong_para(procs:pcandidate);
-{$ifdef EXTDEBUG}
-          procedure candidates_dump_info(lvl:longint;procs:pcandidate);
-{$endif EXTDEBUG}
           function  gen_self_tree_methodpointer:tnode;
           function  gen_self_tree:tnode;
           function  gen_vmt_tree:tnode;
@@ -294,200 +268,6 @@ type
       end;
 
 
-      function is_better_candidate(currpd,bestpd:pcandidate):integer;
-        var
-          res : integer;
-        begin
-          {
-            Return values:
-              > 0 when currpd is better than bestpd
-              < 0 when bestpd is better than currpd
-              = 0 when both are equal
-
-            To choose the best candidate we use the following order:
-            - Incompatible flag
-            - (Smaller) Number of convert operator parameters.
-            - (Smaller) Number of convertlevel 2 parameters.
-            - (Smaller) Number of convertlevel 1 parameters.
-            - (Bigger) Number of exact parameters.
-            - (Smaller) Number of equal parameters.
-            - (Smaller) Total of ordinal distance. For example, the distance of a word
-              to a byte is 65535-255=65280.
-          }
-          if bestpd^.invalid then
-           begin
-             if currpd^.invalid then
-              res:=0
-             else
-              res:=1;
-           end
-          else
-           if currpd^.invalid then
-            res:=-1
-          else
-           begin
-             { less operator parameters? }
-             res:=(bestpd^.coper_count-currpd^.coper_count);
-             if (res=0) then
-              begin
-                { less cl3 parameters? }
-                res:=(bestpd^.cl3_count-currpd^.cl3_count);
-                if (res=0) then
-                 begin
-                   { less cl2 parameters? }
-                   res:=(bestpd^.cl2_count-currpd^.cl2_count);
-                   if (res=0) then
-                    begin
-                      { less cl1 parameters? }
-                      res:=(bestpd^.cl1_count-currpd^.cl1_count);
-                      if (res=0) then
-                       begin
-                         { more exact parameters? }
-                         res:=(currpd^.exact_count-bestpd^.exact_count);
-                         if (res=0) then
-                          begin
-                            { less equal parameters? }
-                            res:=(bestpd^.equal_count-currpd^.equal_count);
-                            if (res=0) then
-                             begin
-                               { smaller ordinal distance? }
-                               if (currpd^.ordinal_distance<bestpd^.ordinal_distance) then
-                                res:=1
-                               else
-                                if (currpd^.ordinal_distance>bestpd^.ordinal_distance) then
-                                 res:=-1
-                               else
-                                res:=0;
-                             end;
-                          end;
-                       end;
-                    end;
-                 end;
-              end;
-           end;
-          is_better_candidate:=res;
-        end;
-
-
-    procedure var_para_allowed(var eq:tequaltype;def_from,def_to:Tdef);
-      begin
-        { Note: eq must be already valid, it will only be updated! }
-        case def_to.deftype of
-          formaldef :
-            begin
-              { all types can be passed to a formaldef }
-              eq:=te_equal;
-            end;
-          orddef :
-            begin
-              { allows conversion from word to integer and
-                byte to shortint, but only for TP7 compatibility }
-              if (m_tp7 in aktmodeswitches) and
-                 (def_from.deftype=orddef) and
-                 (def_from.size=def_to.size) then
-                eq:=te_convert_l1;
-            end;
-          arraydef :
-            begin
-              if is_open_array(def_to) and
-                 is_dynamic_array(def_from) and
-                equal_defs(tarraydef(def_from).elementtype.def,tarraydef(def_to).elementtype.def) then
-                eq:=te_convert_l2;
-            end;
-          pointerdef :
-            begin
-              { an implicit pointer conversion is allowed }
-              if (def_from.deftype=pointerdef) then
-                eq:=te_convert_l1;
-            end;
-          stringdef :
-            begin
-              { all shortstrings are allowed, size is not important }
-              if is_shortstring(def_from) and
-                 is_shortstring(def_to) then
-                eq:=te_equal;
-            end;
-          objectdef :
-            begin
-              { child objects can be also passed }
-              { in non-delphi mode, otherwise    }
-              { they must match exactly, except  }
-              { if they are objects              }
-              if (def_from.deftype=objectdef) and
-                 (
-                  not(m_delphi in aktmodeswitches) or
-                  (
-                   (tobjectdef(def_from).objecttype=odt_object) and
-                   (tobjectdef(def_to).objecttype=odt_object)
-                  )
-                 ) and
-                 (tobjectdef(def_from).is_related(tobjectdef(def_to))) then
-                eq:=te_convert_l1;
-            end;
-          filedef :
-            begin
-              { an implicit file conversion is also allowed }
-              { from a typed file to an untyped one           }
-              if (def_from.deftype=filedef) and
-                 (tfiledef(def_from).filetyp = ft_typed) and
-                 (tfiledef(def_to).filetyp = ft_untyped) then
-                eq:=te_convert_l1;
-            end;
-        end;
-      end;
-
-
-    procedure para_allowed(var eq:tequaltype;p:tcallparanode;def_to:tdef);
-      begin
-        { Note: eq must be already valid, it will only be updated! }
-        case def_to.deftype of
-          formaldef :
-            begin
-              { all types can be passed to a formaldef }
-              eq:=te_equal;
-            end;
-          stringdef :
-            begin
-              { to support ansi/long/wide strings in a proper way }
-              { string and string[10] are assumed as equal }
-              { when searching the correct overloaded procedure   }
-              if (p.resulttype.def.deftype=stringdef) and
-                 (tstringdef(def_to).string_typ=tstringdef(p.resulttype.def).string_typ) then
-                eq:=te_equal
-              else
-              { Passing a constant char to ansistring or shortstring or
-                a widechar to widestring then handle it as equal. }
-               if (p.left.nodetype=ordconstn) and
-                  (
-                   is_char(p.resulttype.def) and
-                   (is_shortstring(def_to) or is_ansistring(def_to))
-                  ) or
-                  (
-                   is_widechar(p.resulttype.def) and
-                   is_widestring(def_to)
-                  ) then
-                eq:=te_equal
-            end;
-          setdef :
-            begin
-              { set can also be a not yet converted array constructor }
-              if (p.resulttype.def.deftype=arraydef) and
-                 (tarraydef(p.resulttype.def).IsConstructor) and
-                 not(tarraydef(p.resulttype.def).IsVariant) then
-                eq:=te_equal;
-            end;
-          procvardef :
-            begin
-              { in tp7 mode proc -> procvar is allowed }
-              if (m_tp_procvar in aktmodeswitches) and
-                 (p.left.nodetype=calln) and
-                 (proc_to_procvar_equal(tprocdef(tcallnode(p.left).procdefinition),tprocvardef(def_to),true)>=te_equal) then
-               eq:=te_equal;
-            end;
-        end;
-      end;
-
-
 {****************************************************************************
                               TOBJECTINFOITEM
  ****************************************************************************}
@@ -1232,514 +1012,6 @@ type
       end;
 
 
-    function Tcallnode.candidates_find:pcandidate;
-
-      var
-        j          : integer;
-        pd         : tprocdef;
-        procs,hp   : pcandidate;
-        found,
-        has_overload_directive : boolean;
-        topclassh  : tobjectdef;
-        srsymtable : tsymtable;
-        srprocsym  : tprocsym;
-
-        procedure proc_add(pd:tprocdef);
-        var
-          i : integer;
-        begin
-          { generate new candidate entry }
-          new(hp);
-          fillchar(hp^,sizeof(tcandidate),0);
-          hp^.data:=pd;
-          hp^.next:=procs;
-          procs:=hp;
-          { Find last parameter, skip all default parameters
-            that are not passed. Ignore this skipping for varargs }
-          hp^.firstpara:=tparaitem(pd.Para.last);
-          if not(po_varargs in pd.procoptions) then
-           begin
-             { ignore hidden parameters }
-             while assigned(hp^.firstpara) and (hp^.firstpara.is_hidden) do
-               hp^.firstpara:=tparaitem(hp^.firstpara.previous);
-             for i:=1 to pd.maxparacount-paralength do
-               begin
-                 if not assigned(hp^.firstpara) then
-                   internalerror(200401141);
-                 hp^.firstpara:=tparaitem(hp^.firstPara.previous);
-               end;
-           end;
-        end;
-
-      begin
-        procs:=nil;
-
-        { when the definition has overload directive set, we search for
-          overloaded definitions in the class, this only needs to be done once
-          for class entries as the tree keeps always the same }
-        if (not symtableprocentry.overloadchecked) and
-           (symtableprocentry.owner.symtabletype=objectsymtable) and
-           (po_overload in symtableprocentry.first_procdef.procoptions) then
-         search_class_overloads(symtableprocentry);
-
-         { when the class passed is defined in this unit we
-           need to use the scope of that class. This is a trick
-           that can be used to access protected members in other
-           units. At least kylix supports it this way (PFV) }
-         if assigned(symtableproc) and
-            (symtableproc.symtabletype=objectsymtable) and
-            (symtableproc.defowner.owner.symtabletype in [globalsymtable,staticsymtable]) and
-            (symtableproc.defowner.owner.unitid=0) then
-           topclassh:=tobjectdef(symtableproc.defowner)
-         else
-           begin
-             if assigned(current_procinfo) then
-               topclassh:=current_procinfo.procdef._class
-             else
-               topclassh:=nil;
-           end;
-
-        { link all procedures which have the same # of parameters }
-        paravisible:=false;
-        for j:=1 to symtableprocentry.procdef_count do
-          begin
-            pd:=symtableprocentry.procdef[j];
-            { Is the procdef visible? This needs to be checked on
-              procdef level since a symbol can contain both private and
-              public declarations. But the check should not be done
-              when the callnode is generated by a property }
-            if (nf_isproperty in flags) or
-               (pd.owner.symtabletype<>objectsymtable) or
-               pd.is_visible_for_object(topclassh) then
-             begin
-               { we have at least one procedure that is visible }
-               paravisible:=true;
-               { only when the # of parameter are supported by the
-                 procedure }
-               if (paralength>=pd.minparacount) and
-                  ((po_varargs in pd.procoptions) or { varargs }
-                   (paralength<=pd.maxparacount)) then
-                 proc_add(pd);
-             end;
-          end;
-
-        { remember if the procedure is declared with the overload directive,
-          it's information is still needed also after all procs are removed }
-        has_overload_directive:=(po_overload in symtableprocentry.first_procdef.procoptions);
-
-        { when the definition has overload directive set, we search for
-          overloaded definitions in the symtablestack. The found
-          entries are only added to the procs list and not the procsym, because
-          the list can change in every situation }
-        if has_overload_directive and
-           (symtableprocentry.owner.symtabletype<>objectsymtable) then
-          begin
-            srsymtable:=symtableprocentry.owner.next;
-            while assigned(srsymtable) do
-             begin
-               if srsymtable.symtabletype in [localsymtable,staticsymtable,globalsymtable] then
-                begin
-                  srprocsym:=tprocsym(srsymtable.speedsearch(symtableprocentry.name,symtableprocentry.speedvalue));
-                  { process only visible procsyms }
-                  if assigned(srprocsym) and
-                     (srprocsym.typ=procsym) and
-                     srprocsym.is_visible_for_object(topclassh) then
-                   begin
-                     { if this procedure doesn't have overload we can stop
-                       searching }
-                     if not(po_overload in srprocsym.first_procdef.procoptions) then
-                      break;
-                     { process all overloaded definitions }
-                     for j:=1 to srprocsym.procdef_count do
-                      begin
-                        pd:=srprocsym.procdef[j];
-                        { only when the # of parameter are supported by the
-                          procedure }
-                        if (paralength>=pd.minparacount) and
-                           ((po_varargs in pd.procoptions) or { varargs }
-                           (paralength<=pd.maxparacount)) then
-                         begin
-                           found:=false;
-                           hp:=procs;
-                           while assigned(hp) do
-                            begin
-                              { Only compare visible parameters for the user }
-                              if compare_paras(hp^.data.para,pd.para,cp_value_equal_const,[cpo_ignorehidden])>=te_equal then
-                               begin
-                                 found:=true;
-                                 break;
-                               end;
-                              hp:=hp^.next;
-                            end;
-                           if not found then
-                             proc_add(pd);
-                         end;
-                      end;
-                   end;
-                end;
-               srsymtable:=srsymtable.next;
-             end;
-          end;
-        candidates_find:=procs;
-      end;
-
-
-    procedure tcallnode.candidates_free(procs:pcandidate);
-      var
-        hpnext,
-        hp : pcandidate;
-      begin
-        hp:=procs;
-        while assigned(hp) do
-         begin
-           hpnext:=hp^.next;
-           dispose(hp);
-           hp:=hpnext;
-         end;
-      end;
-
-
-    procedure tcallnode.candidates_list(procs:pcandidate;all:boolean);
-      var
-        hp : pcandidate;
-      begin
-        hp:=procs;
-        while assigned(hp) do
-         begin
-           if all or
-              (not hp^.invalid) then
-             MessagePos1(hp^.data.fileinfo,sym_h_param_list,hp^.data.fullprocname(false));
-           hp:=hp^.next;
-         end;
-      end;
-
-
-{$ifdef EXTDEBUG}
-    procedure Tcallnode.candidates_dump_info(lvl:longint;procs:pcandidate);
-
-        function ParaTreeStr(p:tcallparanode):string;
-        begin
-          result:='';
-          while assigned(p) do
-           begin
-             if result<>'' then
-              result:=result+',';
-             result:=result+p.resulttype.def.typename;
-             p:=tcallparanode(p.right);
-           end;
-        end;
-
-      var
-        hp : pcandidate;
-        currpara : tparaitem;
-      begin
-        if not CheckVerbosity(lvl) then
-         exit;
-        Comment(lvl+V_LineInfo,'Overloaded callnode: '+symtableprocentry.name+'('+ParaTreeStr(tcallparanode(left))+')');
-        hp:=procs;
-        while assigned(hp) do
-         begin
-           Comment(lvl,'  '+hp^.data.fullprocname(false));
-           if (hp^.invalid) then
-            Comment(lvl,'   invalid')
-           else
-            begin
-              Comment(lvl,'   ex: '+tostr(hp^.exact_count)+
-                          ' eq: '+tostr(hp^.equal_count)+
-                          ' l1: '+tostr(hp^.cl1_count)+
-                          ' l2: '+tostr(hp^.cl2_count)+
-                          ' l3: '+tostr(hp^.cl3_count)+
-                          ' oper: '+tostr(hp^.coper_count)+
-                          ' ord: '+realtostr(hp^.exact_count));
-              { Print parameters in left-right order }
-              currpara:=hp^.firstpara;
-              if assigned(currpara) then
-               begin
-                 while assigned(currpara.next) do
-                  currpara:=tparaitem(currpara.next);
-               end;
-              while assigned(currpara) do
-               begin
-                 if (not currpara.is_hidden) then
-                   Comment(lvl,'    - '+currpara.paratype.def.typename+' : '+EqualTypeName[currpara.eqval]);
-                 currpara:=tparaitem(currpara.previous);
-               end;
-            end;
-           hp:=hp^.next;
-         end;
-      end;
-{$endif EXTDEBUG}
-
-
-    procedure Tcallnode.candidates_get_information(procs:pcandidate);
-      var
-        hp       : pcandidate;
-        currpara : tparaitem;
-        currparanr : byte;
-        def_from,
-        def_to   : tdef;
-        currpt,
-        pt       : tcallparanode;
-        eq       : tequaltype;
-        convtype : tconverttype;
-        pdoper   : tprocdef;
-        releasecurrpt : boolean;
-      begin
-        { process all procs }
-        hp:=procs;
-        while assigned(hp) do
-         begin
-           { We compare parameters in reverse order (right to left),
-             the firstpara is already pointing to the last parameter
-             were we need to start comparing }
-           currparanr:=paralength;
-           currpara:=hp^.firstpara;
-           while assigned(currpara) and (currpara.is_hidden) do
-             currpara:=tparaitem(currpara.previous);
-           pt:=tcallparanode(left);
-           while assigned(pt) and assigned(currpara) do
-            begin
-              { currpt can be changed from loadn to calln when a procvar
-                is passed. This is to prevent that the change is permanent }
-              currpt:=pt;
-              releasecurrpt:=false;
-              { retrieve current parameter definitions to compares }
-              eq:=te_incompatible;
-              def_from:=currpt.resulttype.def;
-              def_to:=currpara.paratype.def;
-              if not(assigned(def_from)) then
-               internalerror(200212091);
-              if not(
-                     assigned(def_to) or
-                     ((po_varargs in hp^.data.procoptions) and
-                      (currparanr>hp^.data.minparacount))
-                    ) then
-               internalerror(200212092);
-
-              { Convert tp procvars when not expecting a procvar }
-              if (def_to.deftype<>procvardef) and
-                 (currpt.left.resulttype.def.deftype=procvardef) then
-                begin
-                  releasecurrpt:=true;
-                  currpt:=tcallparanode(pt.getcopy);
-                  if maybe_call_procvar(currpt.left,true) then
-                    begin
-                      currpt.resulttype:=currpt.left.resulttype;
-                      def_from:=currpt.left.resulttype.def;
-                    end;
-                end;
-
-              { varargs are always equal, but not exact }
-              if (po_varargs in hp^.data.procoptions) and
-                 (currparanr>hp^.data.minparacount) then
-               begin
-                 eq:=te_equal;
-               end
-              else
-              { same definition -> exact }
-               if (def_from=def_to) then
-                begin
-                  eq:=te_exact;
-                end
-              else
-              { for value and const parameters check if a integer is constant or
-                included in other integer -> equal and calc ordinal_distance }
-               if not(currpara.paratyp in [vs_var,vs_out]) and
-                  is_integer(def_from) and
-                  is_integer(def_to) and
-                  is_in_limit(def_from,def_to) then
-                 begin
-                   eq:=te_equal;
-                   hp^.ordinal_distance:=hp^.ordinal_distance+
-                     abs(bestreal(torddef(def_from).low)-bestreal(torddef(def_to).low));
-                   hp^.ordinal_distance:=hp^.ordinal_distance+
-                     abs(bestreal(torddef(def_to).high)-bestreal(torddef(def_from).high));
-                   { Give wrong sign a small penalty, this is need to get a diffrence
-                     from word->[longword,longint] }
-                   if is_signed(def_from)<>is_signed(def_to) then
-                     hp^.ordinal_distance:=hp^.ordinal_distance+1.0;
-                 end
-              else
-              { generic type comparision }
-               begin
-                 eq:=compare_defs_ext(def_from,def_to,currpt.left.nodetype,convtype,pdoper,
-                                      [cdo_allow_variant,cdo_check_operator]);
-
-                 { when the types are not equal we need to check
-                   some special case for parameter passing }
-                 if (eq<te_equal) then
-                  begin
-                    if currpara.paratyp in [vs_var,vs_out] then
-                      begin
-                        { para requires an equal type so the previous found
-                          match was not good enough, reset to incompatible }
-                        eq:=te_incompatible;
-                        { var_para_allowed will return te_equal and te_convert_l1 to
-                          make a difference for best matching }
-                        var_para_allowed(eq,currpt.resulttype.def,currpara.paratype.def)
-                      end
-                    else
-                      para_allowed(eq,currpt,def_to);
-                  end;
-               end;
-
-              { when a procvar was changed to a call an exact much is
-                downgraded to equal. This way an overload call with the
-                procvar is choosen. See tb0471 (PFV) }
-              if (pt<>currpt) and (eq=te_exact) then
-                eq:=te_equal;
-
-              { increase correct counter }
-              case eq of
-                te_exact :
-                  inc(hp^.exact_count);
-                te_equal :
-                  inc(hp^.equal_count);
-                te_convert_l1 :
-                  inc(hp^.cl1_count);
-                te_convert_l2 :
-                  inc(hp^.cl2_count);
-                te_convert_l3 :
-                  inc(hp^.cl3_count);
-                te_convert_operator :
-                  inc(hp^.coper_count);
-                te_incompatible :
-                  hp^.invalid:=true;
-                else
-                  internalerror(200212072);
-              end;
-
-              { stop checking when an incompatible parameter is found }
-              if hp^.invalid then
-               begin
-                 { store the current parameter info for
-                   a nice error message when no procedure is found }
-                 hp^.wrongpara:=currpara;
-                 hp^.wrongparanr:=currparanr;
-                 break;
-               end;
-
-{$ifdef EXTDEBUG}
-              { store equal in node tree for dump }
-              currpara.eqval:=eq;
-{$endif EXTDEBUG}
-
-              { maybe release temp currpt }
-              if releasecurrpt then
-                currpt.free;
-
-              { next parameter in the call tree }
-              pt:=tcallparanode(pt.right);
-
-              { next parameter for definition, only goto next para
-                if we're out of the varargs }
-              if not(po_varargs in hp^.data.procoptions) or
-                 (currparanr<=hp^.data.maxparacount) then
-               begin
-                 { Ignore vs_hidden parameters }
-                 repeat
-                   currpara:=tparaitem(currpara.previous);
-                 until (not assigned(currpara)) or (not currpara.is_hidden);
-               end;
-              dec(currparanr);
-            end;
-           if not(hp^.invalid) and
-              (assigned(pt) or assigned(currpara) or (currparanr<>0)) then
-             internalerror(200212141);
-           { next candidate }
-           hp:=hp^.next;
-         end;
-      end;
-
-
-    function Tcallnode.candidates_choose_best(procs:pcandidate;var bestpd:tabstractprocdef):integer;
-      var
-        besthpstart,
-        hp       : pcandidate;
-        cntpd,
-        res      : integer;
-      begin
-        {
-          Returns the number of candidates left and the
-          first candidate is returned in pdbest
-        }
-        { Setup the first procdef as best, only count it as a result
-          when it is valid }
-        bestpd:=procs^.data;
-        if procs^.invalid then
-         cntpd:=0
-        else
-         cntpd:=1;
-        if assigned(procs^.next) then
-         begin
-           besthpstart:=procs;
-           hp:=procs^.next;
-           while assigned(hp) do
-            begin
-              res:=is_better_candidate(hp,besthpstart);
-              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;
-         end;
-
-        candidates_choose_best:=cntpd;
-      end;
-
-
-    procedure tcallnode.candidates_find_wrong_para(procs:pcandidate);
-      var
-        currparanr : smallint;
-        hp : pcandidate;
-        pt : tcallparanode;
-      begin
-        { Only process the first overloaded procdef }
-        hp:=procs;
-        { Find callparanode corresponding to the argument }
-        pt:=tcallparanode(left);
-        currparanr:=paralength;
-        while assigned(pt) and
-              (currparanr>hp^.wrongparanr) do
-         begin
-           pt:=tcallparanode(pt.right);
-           dec(currparanr);
-         end;
-        if (currparanr<>hp^.wrongparanr) or
-           not assigned(pt) then
-          internalerror(200212094);
-        { Show error message, when it was a var or out parameter
-          guess that it is a missing typeconv }
-        if hp^.wrongpara.paratyp in [vs_var,vs_out] then
-          CGMessagePos2(left.fileinfo,parser_e_call_by_ref_without_typeconv,
-            pt.resulttype.def.typename,hp^.wrongpara.paratype.def.typename)
-        else
-          CGMessagePos3(pt.fileinfo,type_e_wrong_parameter_type,
-            tostr(hp^.wrongparanr),pt.resulttype.def.typename,hp^.wrongpara.paratype.def.typename);
-      end;
-
-
     function tcallnode.gen_self_tree_methodpointer:tnode;
       var
         hsym : tvarsym;
@@ -2009,7 +1281,7 @@ type
 
     function tcallnode.det_resulttype:tnode;
       var
-        procs : pcandidate;
+        candidates : tcallcandidates;
         oldcallnode : tcallnode;
         hpt : tnode;
         pt : tcallparanode;
@@ -2023,7 +1295,7 @@ type
         errorexit;
       begin
          result:=nil;
-         procs:=nil;
+         candidates:=nil;
 
          oldcallnode:=aktcallnode;
          aktcallnode:=nil;
@@ -2090,12 +1362,12 @@ type
               { do we know the procedure to call ? }
               if not(assigned(procdefinition)) then
                 begin
-                   procs:=candidates_find;
+                   candidates:=tcallcandidates.create(symtableprocentry,symtableproc,left,(nf_isproperty in flags));
 
                    { no procedures found? then there is something wrong
                      with the parameter size or the procedures are
                      not accessible }
-                   if not assigned(procs) then
+                   if candidates.count=0 then
                     begin
                       { when it's an auto inherited call and there
                         is no procedure found, but the procedures
@@ -2144,16 +1416,16 @@ type
                     end;
 
                    { Retrieve information about the candidates }
-                   candidates_get_information(procs);
+                   candidates.get_information;
 {$ifdef EXTDEBUG}
                    { Display info when multiple candidates are found }
-                   if assigned(procs^.next) then
-                     candidates_dump_info(V_Debug,procs);
+                   if candidates.count>1 then
+                     candidates.dump_info(V_Debug);
 {$endif EXTDEBUG}
 
                    { Choose the best candidate and count the number of
                      candidates left }
-                   cand_cnt:=candidates_choose_best(procs,procdefinition);
+                   cand_cnt:=candidates.choose_best(procdefinition);
 
                    { All parameters are checked, check if there are any
                      procedures left }
@@ -2164,9 +1436,9 @@ type
                        begin
                          CGMessage(cg_e_cant_choose_overload_function);
 {$ifdef EXTDEBUG}
-                         candidates_dump_info(V_Hint,procs);
-{$else}
-                         candidates_list(procs,false);
+                         candidates.dump_info(V_Hint);
+{$else EXTDEBUG}
+                         candidates.list(false);
 {$endif EXTDEBUG}
                          { we'll just use the first candidate to make the
                            call }
@@ -2192,18 +1464,18 @@ type
                         is filled with the first (random) definition that is
                         found. We use this definition to display a nice error
                         message that the wrong type is passed }
-                      candidates_find_wrong_para(procs);
-                      candidates_list(procs,true);
+                      candidates.find_wrong_para;
+                      candidates.list(true);
 {$ifdef EXTDEBUG}
-                      candidates_dump_info(V_Hint,procs);
+                      candidates.dump_info(V_Hint);
 {$endif EXTDEBUG}
 
                       { We can not proceed, release all procs and exit }
-                      candidates_free(procs);
+                      candidates.free;
                       goto errorexit;
                     end;
 
-                   candidates_free(procs);
+                   candidates.free;
                end; { end of procedure to call determination }
            end;
 
@@ -2756,7 +2028,11 @@ begin
 end.
 {
   $Log$
-  Revision 1.227  2004-02-20 21:55:59  peter
+  Revision 1.228  2004-02-24 16:12:39  peter
+    * operator overload chooses rewrite
+    * overload choosing is now generic and moved to htypechk
+
+  Revision 1.227  2004/02/20 21:55:59  peter
     * procvar cleanup
 
   Revision 1.226  2004/02/19 17:07:42  florian

compiler/nmat.pas

@@ -589,17 +589,15 @@ implementation
            end
          else
            begin
-              minusdef:=search_unary_operator(_minus,left.resulttype.def);
-              if assigned(minusdef) then
-                begin
-                  inc(minusdef.procsym.refs);
-                  t:=ccallnode.create(ccallparanode.create(left,nil),
-                                      Tprocsym(minusdef.procsym),nil,nil);
-                  left:=nil;
+             { allow operator overloading }
+             t:=self;
+             if isunaryoverloaded(t) then
+               begin
                   result:=t;
                   exit;
-                end;
-              CGMessage(type_e_mismatch);
+               end;
+
+             CGMessage(type_e_mismatch);
            end;
       end;
 
@@ -768,17 +766,15 @@ implementation
              end
          else
            begin
-              notdef:=search_unary_operator(_op_not,left.resulttype.def);
-              if assigned(notdef) then
-                begin
-                  inc(notdef.procsym.refs);
-                  t:=ccallnode.create(ccallparanode.create(left,nil),
-                                      Tprocsym(notdef.procsym),nil,nil);
-                  left:=nil;
+             { allow operator overloading }
+             t:=self;
+             if isunaryoverloaded(t) then
+               begin
                   result:=t;
                   exit;
-                end;
-              CGMessage(type_e_mismatch);
+               end;
+
+             CGMessage(type_e_mismatch);
            end;
       end;
 
@@ -862,7 +858,11 @@ begin
 end.
 {
   $Log$
-  Revision 1.58  2004-02-04 22:15:15  daniel
+  Revision 1.59  2004-02-24 16:12:39  peter
+    * operator overload chooses rewrite
+    * overload choosing is now generic and moved to htypechk
+
+  Revision 1.58  2004/02/04 22:15:15  daniel
     * Rtti generation moved to ncgutil
     * Assmtai usage of symsym removed
     * operator overloading cleanup up

compiler/symsym.pas

@@ -127,9 +127,7 @@ interface
                                          retdef:tdef;
                                          cpoptions:tcompare_paras_options):Tprocdef;
           function search_procdef_byprocvardef(d:Tprocvardef):Tprocdef;
-          function search_procdef_unary_operator(firstpara:Tdef):Tprocdef;
           function search_procdef_assignment_operator(fromdef,todef:tdef):Tprocdef;
-          function search_procdef_binary_operator(def1,def2:tdef):Tprocdef;
           function  write_references(ppufile:tcompilerppufile;locals:boolean):boolean;override;
 {$ifdef GDB}
           function stabstring : pchar;override;
@@ -918,39 +916,6 @@ implementation
       end;
 
 
-    function Tprocsym.search_procdef_unary_operator(firstpara:Tdef):Tprocdef;
-      var
-        pd : pprocdeflist;
-        currpara : tparaitem;
-      begin
-        search_procdef_unary_operator:=nil;
-        pd:=pdlistfirst;
-        while assigned(pd) do
-          begin
-            currpara:=tparaitem(pd^.def.para.first);
-            { ignore vs_hidden parameters }
-            while assigned(currpara) and (currpara.is_hidden) do
-             currpara:=tparaitem(currpara.next);
-            if assigned(currpara) then
-             begin
-               if equal_defs(currpara.paratype.def,firstpara) then
-                 begin
-                   { This must be the last not hidden parameter }
-                   currpara:=tparaitem(currpara.next);
-                   while assigned(currpara) and (currpara.is_hidden) do
-                     currpara:=tparaitem(currpara.next);
-                   if currpara=nil then
-                     begin
-                       search_procdef_unary_operator:=pd^.def;
-                       break;
-                     end;
-                 end;
-             end;
-            pd:=pd^.next;
-          end;
-      end;
-
-
     function Tprocsym.search_procdef_assignment_operator(fromdef,todef:tdef):Tprocdef;
       var
         convtyp : tconverttype;
@@ -960,12 +925,10 @@ implementation
         besteq : tequaltype;
         hpd : tprocdef;
         currpara : tparaitem;
-        cdoptions : tcompare_defs_options;
       begin
-        search_procdef_assignment_operator:=nil;
+        result:=nil;
         bestpd:=nil;
         besteq:=te_incompatible;
-        cdoptions:=[];
         pd:=pdlistfirst;
         while assigned(pd) do
           begin
@@ -977,10 +940,10 @@ implementation
                 currpara:=tparaitem(currpara.next);
                if assigned(currpara) then
                 begin
-                  eq:=compare_defs_ext(fromdef,currpara.paratype.def,nothingn,convtyp,hpd,cdoptions);
+                  eq:=compare_defs_ext(fromdef,currpara.paratype.def,nothingn,convtyp,hpd,[]);
                   if eq=te_exact then
                    begin
-                     search_procdef_assignment_operator:=pd^.def;
+                     result:=pd^.def;
                      exit;
                    end;
                   if eq>besteq then
@@ -992,83 +955,7 @@ implementation
              end;
             pd:=pd^.next;
           end;
-        search_procdef_assignment_operator:=bestpd;
-      end;
-
-
-    function Tprocsym.search_procdef_binary_operator(def1,def2:tdef):Tprocdef;
-      var
-        convtyp : tconverttype;
-        pd : pprocdeflist;
-        bestpd : tprocdef;
-        eq1,eq2 : tequaltype;
-        eqlev,
-        bestlev : byte;
-        hpd : tprocdef;
-        nextpara,
-        currpara : tparaitem;
-        cdoptions : tcompare_defs_options;
-      begin
-        search_procdef_binary_operator:=nil;
-        bestpd:=nil;
-        bestlev:=0;
-        cdoptions:=[];
-        { variants arguments must match exact, don't allow conversion to variants that
-          will then allow things like enum->string, because enum->variant is available
-          and select the operator variant->string }
-        if (def1.deftype=variantdef) or (def1.deftype=variantdef) then
-          cdoptions:=[cdo_allow_variant];
-        pd:=pdlistfirst;
-        while assigned(pd) do
-          begin
-            currpara:=Tparaitem(pd^.def.para.first);
-            { ignore vs_hidden parameters }
-            while assigned(currpara) and (currpara.is_hidden) do
-             currpara:=tparaitem(currpara.next);
-            if assigned(currpara) then
-             begin
-               { Compare def1 with the first para }
-               eq1:=compare_defs_ext(def1,currpara.paratype.def,nothingn,convtyp,hpd,cdoptions);
-               if eq1<>te_incompatible then
-                begin
-                  { Ignore vs_hidden parameters }
-                  repeat
-                    currpara:=tparaitem(currpara.next);
-                  until (not assigned(currpara)) or (not currpara.is_hidden);
-                  if assigned(currpara) then
-                   begin
-                     { Ignore vs_hidden parameters }
-                     nextpara:=currpara;
-                     repeat
-                       nextpara:=tparaitem(nextpara.next);
-                     until (not assigned(nextpara)) or (not nextpara.is_hidden);
-                     { There should be no other parameters left }
-                     if not assigned(nextpara) then
-                      begin
-                        { Compare def2 with the last para }
-                        eq2:=compare_defs_ext(def2,currpara.paratype.def,nothingn,convtyp,hpd,cdoptions);
-                        if (eq2<>te_incompatible)  then
-                         begin
-                           { check level }
-                           eqlev:=byte(eq1)+byte(eq2);
-                           if eqlev=(byte(te_exact)+byte(te_exact)) then
-                            begin
-                              search_procdef_binary_operator:=pd^.def;
-                              exit;
-                            end;
-                           if eqlev>bestlev then
-                            begin
-                              bestpd:=pd^.def;
-                              bestlev:=eqlev;
-                            end;
-                         end;
-                      end;
-                   end;
-                end;
-             end;
-            pd:=pd^.next;
-          end;
-        search_procdef_binary_operator:=bestpd;
+        result:=bestpd;
       end;
 
 
@@ -2367,7 +2254,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.160  2004-02-22 22:13:27  daniel
+  Revision 1.161  2004-02-24 16:12:39  peter
+    * operator overload chooses rewrite
+    * overload choosing is now generic and moved to htypechk
+
+  Revision 1.160  2004/02/22 22:13:27  daniel
     * Escape newlines in constant string stabs
 
   Revision 1.159  2004/02/20 21:54:47  peter

compiler/symtable.pas

@@ -211,8 +211,6 @@ interface
     function  searchsysvar(const s: stringid; var srsym: tvarsym; var symowner: tsymtable): boolean;
     function  search_class_member(pd : tobjectdef;const s : string):tsym;
     function  search_assignment_operator(from_def,to_def:Tdef):Tprocdef;
-    function  search_unary_operator(op:Ttoken;def:Tdef):Tprocdef;
-    function  search_binary_operator(op:Ttoken;def1,def2:Tdef):Tprocdef;
 
 {*** Object Helpers ***}
     procedure search_class_overloads(aprocsym : tprocsym);
@@ -2078,58 +2076,6 @@ implementation
         end;
     end;
 
-    function search_unary_operator(op:Ttoken;def:Tdef):Tprocdef;
-
-    var st:Tsymtable;
-        sym:Tprocsym;
-        sv:cardinal;
-
-    begin
-      result:=nil;
-      st:=symtablestack;
-      sv:=getspeedvalue(overloaded_names[op]);
-      while st<>nil do
-        begin
-          sym:=Tprocsym(st.speedsearch(overloaded_names[op],sv));
-          if sym<>nil then
-            begin
-              if sym.typ<>procsym then
-                internalerror(200402031);
-              result:=sym.search_procdef_unary_operator(def);
-              if result<>nil then
-                exit;
-            end;
-          st:=st.next;
-        end;
-    end;
-
-
-    function search_binary_operator(op:Ttoken;def1,def2:Tdef):Tprocdef;
-
-    var st:Tsymtable;
-        sym:Tprocsym;
-        sv:cardinal;
-
-    begin
-      result:=nil;
-      st:=symtablestack;
-      sv:=getspeedvalue(overloaded_names[op]);
-      while st<>nil do
-        begin
-          sym:=Tprocsym(st.speedsearch(overloaded_names[op],sv));
-          if sym<>nil then
-            begin
-              if sym.typ<>procsym then
-                internalerror(200402031);
-              result:=sym.search_procdef_binary_operator(def1,def2);
-              if result<>nil then
-                exit;
-            end;
-          st:=st.next;
-        end;
-    end;
-
-
     function searchsystype(const s: stringid; var srsym: ttypesym): boolean;
       var
         symowner: tsymtable;
@@ -2427,7 +2373,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.139  2004-02-20 21:55:59  peter
+  Revision 1.140  2004-02-24 16:12:39  peter
+    * operator overload chooses rewrite
+    * overload choosing is now generic and moved to htypechk
+
+  Revision 1.139  2004/02/20 21:55:59  peter
     * procvar cleanup
 
   Revision 1.138  2004/02/17 15:57:49  peter