- removed empty ppc-specific frac()

+ added correct generic frac() implementation for doubles (translated
    from glibc code)
This commit is contained in:
Jonas Maebe 2003-05-02 15:12:19 +00:00
parent 53152499c5
commit c59fb8e28a
2 changed files with 66 additions and 19 deletions

View File

@ -78,9 +78,8 @@ const sincof : TabCoef = (
{$ifndef FPC_SYSTEM_HAS_TRUNC}
{ also necessary for Int() on systems with 64bit floats (JM) }
type
float32 = longint;
{$ifdef ENDIAN_LITTLE}
float64 = packed record
low: longint;
@ -92,6 +91,10 @@ type
low: longint;
end;
{$endif}
{$ifndef FPC_SYSTEM_HAS_TRUNC}
type
float32 = longint;
flag = byte;
Function extractFloat64Frac0(a: float64): longint;
@ -258,12 +261,60 @@ Function float32_to_int32_round_to_zero( a: Float32 ): longint;
{$ifndef FPC_SYSTEM_HAS_INT}
{$ifdef SUPPORT_DOUBLE}
{ straight Pascal translation of the code for __trunc() in }
{ the file sysdeps/libm-ieee754/s_trunc.c of glibc (JM) }
function int(d: double): double;[internconst:in_const_int];
var
i0, j0: longint;
i1: cardinal;
sx: longint;
begin
i0 := float64(d).high;
i1 := cardinal(float64(d).low);
sx := i0 and $80000000;
j0 := ((i0 shr 20) and $7ff) - $3ff;
if (j0 < 20) then
begin
if (j0 < 0) then
begin
{ the magnitude of the number is < 1 so the result is +-0. }
float64(d).high := sx;
float64(d).low := 0;
end
else
begin
float64(d).high := sx or (i0 and not($fffff shr j0));
float64(d).low := 0;
end
end
else if (j0 > 51) then
begin
if (j0 = $400) then
{ d is inf or NaN }
exit(d + d); { don't know why they do this (JM) }
end
else
begin
float64(d).high := i0;
float64(d).low := longint(i1 and not(cardinal($ffffffff) shr (j0 - 20)));
end;
result := d;
end;
{$else SUPPORT_DOUBLE}
function int(d : real) : real;[internconst:in_const_int];
begin
{ this will be correct since real = single in the case of }
{ the motorola version of the compiler... }
int:=real(trunc(d));
end;
{$endif SUPPORT_DOUBLE}
{$endif}
@ -1030,7 +1081,12 @@ Function float32_to_int32_round_to_zero( a: Float32 ): longint;
{
$Log$
Revision 1.11 2003-04-23 21:28:21 peter
Revision 1.12 2003-05-02 15:12:19 jonas
- removed empty ppc-specific frac()
+ added correct generic frac() implementation for doubles (translated
from glibc code)
Revision 1.11 2003/04/23 21:28:21 peter
* fpc_round added, needed for int64 currency
Revision 1.10 2003/01/15 00:45:17 peter
@ -1055,4 +1111,4 @@ Function float32_to_int32_round_to_zero( a: Float32 ): longint;
* several fixes for linux/powerpc
* several fixes to MT
}
}

View File

@ -64,21 +64,7 @@ const
runerror(207);
end;
function frac(d : extended) : extended;[internconst:in_const_frac];
begin
runerror(207);
end;
}
{$define FPC_SYSTEM_HAS_INT}
{$warning FIX ME}
function int(d : extended) : extended;[internconst:in_const_int];
begin
runerror(207);
end;
const
factor: double = double(int64(1) shl 32);
@ -370,7 +356,12 @@ end ['R0','R3','F0','F1','F2','F3'];
{
$Log$
Revision 1.19 2003-04-26 20:36:24 jonas
Revision 1.20 2003-05-02 15:12:19 jonas
- removed empty ppc-specific frac()
+ added correct generic frac() implementation for doubles (translated
from glibc code)
Revision 1.19 2003/04/26 20:36:24 jonas
* trunc now also supports int64 (no NaN's etc though)
Revision 1.18 2003/04/26 17:20:16 florian