paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-10-29 08:21:58 +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

18
rtl/objpas/math.pp
View File

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