mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-08-12 06:26:10 +02:00
- removed empty ppc-specific frac()
+ added correct generic frac() implementation for doubles (translated from glibc code)
This commit is contained in:
parent
53152499c5
commit
c59fb8e28a
@ -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
|
||||
|
||||
}
|
||||
}
|
||||
|
@ -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
|
||||
|
Loading…
Reference in New Issue
Block a user