* Fix overload selection code.

git-svn-id: trunk@7654 -

compiler/cutils.pas

@@ -140,6 +140,7 @@ interface
     function minilzw_encode(const s:string):string;
     function minilzw_decode(const s:string):string;
 
+    Function nextafter(x,y:double):double;
 
 implementation
 
@@ -1265,6 +1266,112 @@ implementation
         runerror(255);
       end;
 
+    Function Nextafter(x,y:double):double;
+    // Returns the double precision number closest to x in
+    // the direction toward y.
+
+    // Initial direct translation by Soeren Haastrup from
+    // www.netlib.org/fdlibm/s_nextafter.c according to
+    // ====================================================
+    // Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
+    // Developed at SunSoft, a Sun Microsystems, Inc. business.
+    // Permission to use, copy, modify, and distribute this
+    // software is freely granted, provided that this notice
+    // is preserved.
+    // ====================================================
+    // and with all signaling policies preserved as is.
+
+    type
+      {$ifdef ENDIAN_LITTLE}
+        twoword=record
+                  lo,hi:longword; // Little Endian split of a double.
+                end;
+      {$else}
+        twoword=record
+                  hi,lo:longword; // Little Endian split of a double.
+                end;
+      {$endif}
+
+    var
+        hx,hy,ix,iy:longint;
+        lx,ly:longword;
+
+    Begin
+    hx:=twoword(x).hi;    // high and low words of x and y
+    lx:=twoword(x).lo;
+    hy:=twoword(y).hi;
+    ly:=twoword(y).lo;
+    ix:=hx and $7fffffff;  // absolute values
+    iy:=hy and $7fffffff;
+
+    // Case x=NAN or y=NAN
+
+    if ( (ix>=$7ff00000) and (((ix-$7ff00000) or lx) <> 0) )
+        or ( (iy>=$7ff00000) and (((iy-$7ff00000) OR ly) <> 0) )
+    then exit(x+y);
+
+    // Case x=y
+
+    if x=y then exit(x); // (implies Nextafter(0,-0) is 0 and not -0...)
+
+    // Case x=0
+
+    if (ix or lx)=0
+    then begin
+          twoword(x).hi:=hy and $80000000;  // return +-minimalSubnormal
+          twoword(x).lo:=1;
+          y:=x*x;    // set underflow flag (ignored in FPC as default)
+          if y=x
+          then exit(y)
+          else exit(x);
+        end;
+
+    // all other cases
+
+    if hx>=0  // x>0
+    then begin
+          if (hx>hy) or ( (hx=hy) and (lx>ly) ) // x>y , return x-ulp
+          then begin
+                if (lx=0) then hx:=hx-1;
+                lx:=lx-1;
+              end
+          else begin                      // x<y, return x+ulp
+                lx:=lx+1;
+                if lx=0 then hx:=hx+1;
+              end
+        end
+    else begin // x<0
+          if (hy>=0) or (hx>=hy) or ( (hx=hy) and (lx>ly)) // x<y, return x-ulp
+          then begin
+                if (lx=0) then hx:=hx-1;
+                lx:=lx-1;
+              end
+          else begin            // x>y , return x+ulp
+                lx:=lx+1;
+                if lx=0 then hx:=hx+1;
+              end
+        end;
+
+    // finally check if overflow or underflow just happend
+
+    hy:=hx and $7ff00000;
+    if (hy>= $7ff00000) then exit(x+x); // overflow and signal
+    if (hy<$0010000)                    // underflow
+    then begin
+          y:=x*x;              // raise underflow flag
+          if y<>x
+          then begin
+                twoword(y).hi:=hx;
+                twoword(y).lo:=lx;
+                exit(y);
+              end
+        end;
+
+    twoword(x).hi:=hx;
+    twoword(x).lo:=lx;
+    nextafter:=x;
+
+    end;
 
 initialization
   internalerrorproc:=@defaulterror;

compiler/htypechk.pas

@@ -49,7 +49,7 @@ interface
          cl2_count,
          cl3_count,
          coper_count : integer; { should be signed }
-         ordinal_distance : bestreal;
+         ordinal_distance : double;
          invalid     : boolean;
          wrongparanr : byte;
       end;
@@ -1931,7 +1931,7 @@ implementation
         currpara : tparavarsym;
         paraidx  : integer;
         currparanr : byte;
-        rfh,rth  : bestreal;
+        rfh,rth  : double;
         objdef   : tobjectdef;
         def_from,
         def_to   : tdef;
@@ -1943,6 +1943,12 @@ implementation
         pdoper   : tprocdef;
         releasecurrpt : boolean;
         cdoptions : tcompare_defs_options;
+
+    {$ifopt r+}{$define ena_rq}{$q-}{$r-}{$endif}
+      const
+        inf=1.0/0.0;
+    {$ifdef ena_rq}{$q+}{$r+}{$endif}
+
       begin
         cdoptions:=[cdo_check_operator];
         if FAllowVariant then
@@ -2020,15 +2026,11 @@ implementation
                  (currparanr>hp^.data.minparacount) and
                  not is_array_of_const(def_from) and
                  not is_array_constructor(def_from) then
-               begin
+                eq:=te_equal
-                 eq:=te_equal;
-               end
               else
               { same definition -> exact }
                if (def_from=def_to) then
-                begin
+                 eq:=te_exact
-                  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 }
@@ -2046,7 +2048,9 @@ implementation
                    { 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;
+                   {$ifopt r+}{$define ena_rq}{$q-}{$r-}{$endif}
+                     hp^.ordinal_distance:=nextafter(hp^.ordinal_distance,inf);
+                   {$ifdef ena_rq}{$r+}{$q+}{$endif}
                  end
               else
               { for value and const parameters check precision of real, give
@@ -2057,19 +2061,19 @@ implementation
                  begin
                    eq:=te_equal;
                    if is_extended(def_to) then
-                     rth:=bestreal(4)
+                     rth:=4
                    else
                      if is_double (def_to) then
-                       rth:=bestreal(2)
+                       rth:=2
                    else
-                     rth:=bestreal(1);
+                     rth:=1;
                    if is_extended(def_from) then
-                     rfh:=bestreal(4)
+                     rfh:=4
                    else
                      if is_double (def_from) then
-                       rfh:=bestreal(2)
+                       rfh:=2
                    else
-                     rfh:=bestreal(1);
+                     rfh:=1;
                    { penalty for shrinking of precision }
                    if rth<rfh then
                      rfh:=(rfh-rth)*16

compiler/i386/i386tab.inc

@@ -9606,7 +9606,7 @@
   ),
   (
     opcode  : A_INSERTQ;
-    ops     : 1768187245;
+    ops     : 4;
     optypes : (ot_xmmreg,ot_xmmreg,ot_immediate);
     code    : #76#2#15#120#63#253#18#253#19;
     flags   : if_sse4 or if_sb