paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-17 20:49:09 +02:00
Code Issues Packages Projects Releases Wiki Activity

* more "real" fixes

Browse Source 
git-svn-id: trunk@4641 -
This commit is contained in:
Jonas Maebe 2006-09-17 21:44:20 +00:00
parent b50841bfce
commit 83884ec540
2 changed files with 33 additions and 43 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

40
rtl/inc/cgenmath.inc
View File

@ -24,7 +24,7 @@
{$ifdef SUPPORT_DOUBLE} {$ifdef SUPPORT_DOUBLE}
function c_trunc(d: double): double; cdecl; external 'c' name 'trunc'; function c_trunc(d: double): double; cdecl; external 'c' name 'trunc';
function fpc_int_real(d: double): double;compilerproc; {$ifdef MATHINLINE}inline;{$endif} function fpc_int_real(d: ValReal): ValReal;compilerproc; {$ifdef MATHINLINE}inline;{$endif}
begin begin
result := c_trunc(d); result := c_trunc(d);
end; end;
@ -32,9 +32,9 @@
{$else SUPPORT_DOUBLE} {$else SUPPORT_DOUBLE}
function c_truncf(d: real): double; cdecl; external 'c' name 'truncf'; function c_truncf(d: double): double; cdecl; external 'c' name 'truncf';
function fpc_int_real(d: real): real;compilerproc; {$ifdef MATHINLINE}inline;{$endif} function fpc_int_real(d: ValReal): ValReal;compilerproc; {$ifdef MATHINLINE}inline;{$endif}
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... }
@ -49,7 +49,7 @@
{$define SYSTEM_HAS_FREXP} {$define SYSTEM_HAS_FREXP}
function c_frexp(x: double; out e: longint): double; cdecl; external 'c' name 'frexp'; function c_frexp(x: double; out e: longint): double; cdecl; external 'c' name 'frexp';
function frexp(x:Real; out e:Integer ):Real; {$ifdef MATHINLINE}inline;{$endif} function frexp(x:ValReal; out e:Integer ):ValReal; {$ifdef MATHINLINE}inline;{$endif}
var var
l: longint; l: longint;
begin begin
@ -63,7 +63,7 @@
{$define SYSTEM_HAS_LDEXP} {$define SYSTEM_HAS_LDEXP}
function c_ldexp(x: double; n: longint): double; cdecl; external 'c' name 'ldexp'; function c_ldexp(x: double; n: longint): double; cdecl; external 'c' name 'ldexp';
function ldexp( x: Real; N: Integer):Real;{$ifdef MATHINLINE}inline;{$endif} function ldexp( x: ValReal; N: Integer):ValReal;{$ifdef MATHINLINE}inline;{$endif}
begin begin
ldexp := c_ldexp(x,n); ldexp := c_ldexp(x,n);
end; end;
@ -75,7 +75,7 @@
function c_sqrt(d: double): double; cdecl; external 'c' name 'sqrt'; function c_sqrt(d: double): double; cdecl; external 'c' name 'sqrt';
function fpc_sqrt_real(d:Real):Real;compilerproc; {$ifdef MATHINLINE}inline;{$endif} function fpc_sqrt_real(d:ValReal):ValReal;compilerproc; {$ifdef MATHINLINE}inline;{$endif}
begin begin
result := c_sqrt(d); result := c_sqrt(d);
end; end;
@ -87,29 +87,33 @@
{$define FPC_SYSTEM_HAS_EXP} {$define FPC_SYSTEM_HAS_EXP}
function c_exp(d: double): double; cdecl; external 'c' name 'exp'; function c_exp(d: double): double; cdecl; external 'c' name 'exp';
function fpc_Exp_real(d:Real):Real;compilerproc; {$ifdef MATHINLINE}inline;{$endif} function fpc_Exp_real(d:ValReal):ValReal;compilerproc; {$ifdef MATHINLINE}inline;{$endif}
begin begin
result := c_exp(d); result := c_exp(d);
end; end;
{$endif} {$endif}
(*
Not supported on Mac OS X 10.1 { Not supported everywhere (also not on Mac OS X 10.1, but that's deprecated. }
{ It is supported on linux, but at least for linux/i386 we should call }
{ llroundl() instead (for extended support). }
{$if defined(darwin) }
{$ifndef FPC_SYSTEM_HAS_ROUND} {$ifndef FPC_SYSTEM_HAS_ROUND}
{$define FPC_SYSTEM_HAS_ROUND} {$define FPC_SYSTEM_HAS_ROUND}
function c_llround(d: double): int64; cdecl; external 'c' name 'llround'; function c_llround(d: double): int64; cdecl; external 'c' name 'llround';
function round(d : Real) : int64; external name 'FPC_ROUND'; // function round(d : Real) : int64; external name 'FPC_ROUND';
function fpc_round(d : Real) : int64;[public, alias:'FPC_ROUND'];compilerproc; function fpc_round_real(d : ValReal) : int64;[public, alias:'FPC_ROUND'];compilerproc;
begin begin
fpc_round := c_llround(d); fpc_round_real := c_llround(d);
end; end;
{$endif} {$endif not FPC_SYSTEM_HAS_ROUND}
*)
{$endif darwin}
{$ifndef FPC_SYSTEM_HAS_LN} {$ifndef FPC_SYSTEM_HAS_LN}
@ -117,7 +121,7 @@ Not supported on Mac OS X 10.1
function c_log(d: double): double; cdecl; external 'c' name 'log'; function c_log(d: double): double; cdecl; external 'c' name 'log';
function fpc_Ln_real(d:Real):Real;compilerproc;{$ifdef MATHINLINE}inline;{$endif} function fpc_Ln_real(d:ValReal):ValReal;compilerproc;{$ifdef MATHINLINE}inline;{$endif}
begin begin
result := c_log(d); result := c_log(d);
end; end;
@ -128,7 +132,7 @@ Not supported on Mac OS X 10.1
{$define FPC_SYSTEM_HAS_SIN} {$define FPC_SYSTEM_HAS_SIN}
function c_sin(d: double): double; cdecl; external 'c' name 'sin'; function c_sin(d: double): double; cdecl; external 'c' name 'sin';
function fpc_Sin_real(d:Real):Real;compilerproc; {$ifdef MATHINLINE}inline;{$endif} function fpc_Sin_real(d:ValReal):ValReal;compilerproc; {$ifdef MATHINLINE}inline;{$endif}
begin begin
result := c_sin(d); result := c_sin(d);
end; end;
@ -140,7 +144,7 @@ Not supported on Mac OS X 10.1
{$define FPC_SYSTEM_HAS_COS} {$define FPC_SYSTEM_HAS_COS}
function c_cos(d: double): double; cdecl; external 'c' name 'cos'; function c_cos(d: double): double; cdecl; external 'c' name 'cos';
function fpc_Cos_real(d:Real):Real;compilerproc; {$ifdef MATHINLINE}inline;{$endif} function fpc_Cos_real(d:ValReal):ValReal;compilerproc; {$ifdef MATHINLINE}inline;{$endif}
begin begin
result := c_cos(d); result := c_cos(d);
end; end;
@ -152,7 +156,7 @@ Not supported on Mac OS X 10.1
{$define FPC_SYSTEM_HAS_ARCTAN} {$define FPC_SYSTEM_HAS_ARCTAN}
function c_atan(d: double): double; cdecl; external 'c' name 'atan'; function c_atan(d: double): double; cdecl; external 'c' name 'atan';
function fpc_ArcTan_real(d:Real):Real;compilerproc; {$ifdef MATHINLINE}inline;{$endif} function fpc_ArcTan_real(d:ValReal):ValReal;compilerproc; {$ifdef MATHINLINE}inline;{$endif}
begin begin
result := c_atan(d); result := c_atan(d);
end; end;

36
rtl/inc/genmath.inc
View File

@ -311,7 +311,7 @@ type
{ straight Pascal translation of the code for __trunc() in } { straight Pascal translation of the code for __trunc() in }
{ the file sysdeps/libm-ieee754/s_trunc.c of glibc (JM) } { the file sysdeps/libm-ieee754/s_trunc.c of glibc (JM) }
function fpc_int_real(d: double): double;compilerproc; function fpc_int_real(d: ValReal): ValReal;compilerproc;
var var
i0, j0: longint; i0, j0: longint;
i1: cardinal; i1: cardinal;
@ -365,11 +365,11 @@ type
{$else SUPPORT_DOUBLE} {$else SUPPORT_DOUBLE}
function fpc_int_real(d : real) : real;compilerproc; function fpc_int_real(d : ValReal) : ValReal;compilerproc;
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... }
result:=real(trunc(d)); result:=ValReal(trunc(d));
end; end;
{$endif SUPPORT_DOUBLE} {$endif SUPPORT_DOUBLE}
@ -378,9 +378,7 @@ type
{$ifndef FPC_SYSTEM_HAS_ABS} {$ifndef FPC_SYSTEM_HAS_ABS}
{$ifdef SUPPORT_DOUBLE} function fpc_abs_real(d : ValReal) : ValReal;compilerproc;
function fpc_abs_real(d : Double) : Double;compilerproc;
begin begin
if (d<0.0) then if (d<0.0) then
result := -d result := -d
@ -388,18 +386,6 @@ type
result := d ; result := d ;
end; end;
{$else}
function fpc_abs_real(d : Double) : Double;compilerproc;
begin
if (d<0.0) then
result := -d
else
result := d ;
end;
{$endif}
{$endif not FPC_SYSTEM_HAS_ABS} {$endif not FPC_SYSTEM_HAS_ABS}
@ -515,14 +501,14 @@ type
{$ifndef FPC_SYSTEM_HAS_SQR} {$ifndef FPC_SYSTEM_HAS_SQR}
function fpc_sqr_real(d : Real) : Real;compilerproc;{$ifdef MATHINLINE}inline;{$endif} function fpc_sqr_real(d : ValReal) : ValReal;compilerproc;{$ifdef MATHINLINE}inline;{$endif}
begin begin
result := d*d; result := d*d;
end; end;
{$endif} {$endif}
{$ifndef FPC_SYSTEM_HAS_PI} {$ifndef FPC_SYSTEM_HAS_PI}
function fpc_pi_real : Real;compilerproc;{$ifdef MATHINLINE}inline;{$endif} function fpc_pi_real : ValReal;compilerproc;{$ifdef MATHINLINE}inline;{$endif}
begin begin
result := 3.1415926535897932385; result := 3.1415926535897932385;
end; end;
@ -530,7 +516,7 @@ type
{$ifndef FPC_SYSTEM_HAS_SQRT} {$ifndef FPC_SYSTEM_HAS_SQRT}
function fpc_sqrt_real(d:Real):Real;compilerproc; function fpc_sqrt_real(d:ValReal):ValReal;compilerproc;
{*****************************************************************} {*****************************************************************}
{ Square root } { Square root }
{*****************************************************************} {*****************************************************************}
@ -742,7 +728,7 @@ type
{$ifndef FPC_SYSTEM_HAS_LN} {$ifndef FPC_SYSTEM_HAS_LN}
function fpc_ln_real(d:Real):Real;compilerproc; function fpc_ln_real(d:ValReal):ValReal;compilerproc;
{*****************************************************************} {*****************************************************************}
{ Natural Logarithm } { Natural Logarithm }
{*****************************************************************} {*****************************************************************}
@ -866,7 +852,7 @@ type
{$ifndef FPC_SYSTEM_HAS_SIN} {$ifndef FPC_SYSTEM_HAS_SIN}
function fpc_Sin_real(d:Real):Real;compilerproc; function fpc_Sin_real(d:ValReal):ValReal;compilerproc;
{*****************************************************************} {*****************************************************************}
{ Circular Sine } { Circular Sine }
{*****************************************************************} {*****************************************************************}
@ -952,7 +938,7 @@ type
{$ifndef FPC_SYSTEM_HAS_COS} {$ifndef FPC_SYSTEM_HAS_COS}
function fpc_Cos_real(d:Real):Real;compilerproc; function fpc_Cos_real(d:ValReal):ValReal;compilerproc;
{*****************************************************************} {*****************************************************************}
{ Circular cosine } { Circular cosine }
{*****************************************************************} {*****************************************************************}
@ -1035,7 +1021,7 @@ type
{$ifndef FPC_SYSTEM_HAS_ARCTAN} {$ifndef FPC_SYSTEM_HAS_ARCTAN}
function fpc_ArcTan_real(d:Real):Real;compilerproc; function fpc_ArcTan_real(d:ValReal):ValReal;compilerproc;
{*****************************************************************} {*****************************************************************}
{ Inverse circular tangent (arctangent) } { Inverse circular tangent (arctangent) }
{*****************************************************************} {*****************************************************************}