2
0
Эх сурвалжийг харах

* Fix from [email protected] for frexp function, in case X=0 or X=1

git-svn-id: trunk@3310 -
michael 19 жил өмнө
parent
commit
e9420ae581
1 өөрчлөгдсөн 17 нэмэгдсэн , 17 устгасан
  1. 17 17
      rtl/objpas/math.pp

+ 17 - 17
rtl/objpas/math.pp

@@ -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;