paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-10-22 13:13:25 +02:00
Code Issues Packages Projects Releases Wiki Activity

* Fix from programo@vp.pl for frexp function, in case X=0 or X=1

Browse Source 
git-svn-id: trunk@3310 -
This commit is contained in:
michael 2006-04-21 18:50:26 +00:00
parent ab7395fa03
commit e9420ae581
1 changed files with 17 additions and 17 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

34
rtl/objpas/math.pp
View File

@ -699,24 +699,24 @@ function floor(x : float) : integer;
Floor := Floor-1;
end;
procedure Frexp(X: float; var Mantissa: float; var Exponent: integer);
begin
Exponent :=0;
if (abs(x)<0.5) then
While (abs(x)<0.5) do
begin
x := x*2;
Dec(Exponent);
end
else
While (abs(x)>1) do
begin
x := x/2;
Inc(Exponent);
end;
mantissa := x;
end;
procedure Frexp(X: float; var Mantissa: float; var Exponent: integer);
begin
Exponent:=0;
if (X<>0) then
if (abs(X)<0.5) then
repeat
X:=X*2;
Dec(Exponent);
until (abs(X)>=0.5)
else
while (abs(X)>=1) do
begin
X:=X/2;
Inc(Exponent);
end;
Mantissa:=X;
end;
function ldexp(x : float;const p : Integer) : float;