mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-11-01 14:10:57 +01:00
* Fix overload selection code.
git-svn-id: trunk@7654 -
This commit is contained in:
daniel
parent
078f6e05fa
commit
b635d89ffa
@ -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;
|
||||
|
||||
@ -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;
|
||||
end
|
||||
eq:=te_equal
|
||||
else
|
||||
{ same definition -> exact }
|
||||
if (def_from=def_to) then
|
||||
begin
|
||||
eq:=te_exact;
|
||||
end
|
||||
eq:=te_exact
|
||||
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
|
||||
|
||||
@ -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
|
||||
|
||||
Loading…
Reference in New Issue
Block a user