paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-10-28 21:42:04 +01: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; Floor := Floor-1;
end; end;
procedure Frexp(X: float; var Mantissa: float; var Exponent: integer);
begin procedure Frexp(X: float; var Mantissa: float; var Exponent: integer);
Exponent :=0; begin
if (abs(x)<0.5) then Exponent:=0;
While (abs(x)<0.5) do if (X<>0) then
begin if (abs(X)<0.5) then
x := x*2; repeat
Dec(Exponent); X:=X*2;
end Dec(Exponent);
else until (abs(X)>=0.5)
While (abs(x)>1) do else
begin while (abs(X)>=1) do
x := x/2; begin
Inc(Exponent); X:=X/2;
end; Inc(Exponent);
mantissa := x; end;
end; Mantissa:=X;
end;
function ldexp(x : float;const p : Integer) : float; function ldexp(x : float;const p : Integer) : float;