mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-08-17 16:49:23 +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
|
type
|
||||||
float32 = longint;
|
|
||||||
{$ifdef ENDIAN_LITTLE}
|
{$ifdef ENDIAN_LITTLE}
|
||||||
float64 = packed record
|
float64 = packed record
|
||||||
low: longint;
|
low: longint;
|
||||||
@ -92,6 +91,10 @@ type
|
|||||||
low: longint;
|
low: longint;
|
||||||
end;
|
end;
|
||||||
{$endif}
|
{$endif}
|
||||||
|
|
||||||
|
{$ifndef FPC_SYSTEM_HAS_TRUNC}
|
||||||
|
type
|
||||||
|
float32 = longint;
|
||||||
flag = byte;
|
flag = byte;
|
||||||
|
|
||||||
Function extractFloat64Frac0(a: float64): longint;
|
Function extractFloat64Frac0(a: float64): longint;
|
||||||
@ -258,12 +261,60 @@ Function float32_to_int32_round_to_zero( a: Float32 ): longint;
|
|||||||
|
|
||||||
|
|
||||||
{$ifndef FPC_SYSTEM_HAS_INT}
|
{$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];
|
function int(d : real) : real;[internconst:in_const_int];
|
||||||
begin
|
begin
|
||||||
{ this will be correct since real = single in the case of }
|
{ this will be correct since real = single in the case of }
|
||||||
{ the motorola version of the compiler... }
|
{ the motorola version of the compiler... }
|
||||||
int:=real(trunc(d));
|
int:=real(trunc(d));
|
||||||
end;
|
end;
|
||||||
|
{$endif SUPPORT_DOUBLE}
|
||||||
|
|
||||||
{$endif}
|
{$endif}
|
||||||
|
|
||||||
|
|
||||||
@ -1030,7 +1081,12 @@ Function float32_to_int32_round_to_zero( a: Float32 ): longint;
|
|||||||
|
|
||||||
{
|
{
|
||||||
$Log$
|
$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
|
* fpc_round added, needed for int64 currency
|
||||||
|
|
||||||
Revision 1.10 2003/01/15 00:45:17 peter
|
Revision 1.10 2003/01/15 00:45:17 peter
|
||||||
|
@ -64,21 +64,7 @@ const
|
|||||||
runerror(207);
|
runerror(207);
|
||||||
end;
|
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
|
const
|
||||||
factor: double = double(int64(1) shl 32);
|
factor: double = double(int64(1) shl 32);
|
||||||
@ -370,7 +356,12 @@ end ['R0','R3','F0','F1','F2','F3'];
|
|||||||
|
|
||||||
{
|
{
|
||||||
$Log$
|
$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)
|
* trunc now also supports int64 (no NaN's etc though)
|
||||||
|
|
||||||
Revision 1.18 2003/04/26 17:20:16 florian
|
Revision 1.18 2003/04/26 17:20:16 florian
|
||||||
|
Loading…
Reference in New Issue
Block a user