[Ada] Reimplement Ada.Numerics.Big_Numbers.Big_Reals.Fixed_Conversions

gcc/ada/

	* libgnat/a-nbnbre.adb (Float_Conversions): Instantiate Conv
	package only once in the body.
	(Fixed_Conversions.Float_Aux): New instance.
	(Fixed_Conversions.Conv_I): Likewise.
	(Fixed_Conversions.Conv_U): Likewise.
	(Fixed_Conversions.LLLI): New subtype.
	(Fixed_Conversions.LLLU): Likewise.
	(Fixed_Conversions.Too_Large): New constant.
	(Fixed_Conversions.To_Big_Real): Reimplement.
	(Fixed_Conversions.From_Big_Real): Likewise.

1 files changed, 61 insertions, 8 deletions

diff --git a/gcc/ada/libgnat/a-nbnbre.adb b/gcc/ada/libgnat/a-nbnbre.adb
index 4254b302..4ff5b35 100644
--- a/gcc/ada/libgnat/a-nbnbre.adb
+++ b/gcc/ada/libgnat/a-nbnbre.adb
@@ -118,6 +118,9 @@ package body Ada.Numerics.Big_Numbers.Big_Reals is
 
    package body Float_Conversions is
 
+      package Conv is new
+        Big_Integers.Unsigned_Conversions (Long_Long_Unsigned);
+
       -----------------
       -- To_Big_Real --
       -----------------
@@ -130,9 +133,6 @@ package body Ada.Numerics.Big_Numbers.Big_Reals is
 
       function To_Big_Real (Arg : Num) return Valid_Big_Real is
 
-         package Conv is new
-           Big_Integers.Unsigned_Conversions (Long_Long_Unsigned);
-
          A : constant Num'Base := abs (Arg);
          E : constant Integer  := Num'Exponent (A);
          F : constant Num'Base := Num'Fraction (A);
@@ -182,9 +182,6 @@ package body Ada.Numerics.Big_Numbers.Big_Reals is
 
       function From_Big_Real (Arg : Big_Real) return Num is
 
-         package Conv is new
-           Big_Integers.Unsigned_Conversions (Long_Long_Unsigned);
-
          M    : constant Natural     := Num'Machine_Mantissa;
          One  : constant Big_Real    := To_Real (1);
          Two  : constant Big_Real    := To_Real (2);
@@ -310,22 +307,78 @@ package body Ada.Numerics.Big_Numbers.Big_Reals is
 
    package body Fixed_Conversions is
 
+      package Float_Aux is new Float_Conversions (Long_Long_Float);
+
+      subtype LLLI is Long_Long_Long_Integer;
+      subtype LLLU is Long_Long_Long_Unsigned;
+
+      Too_Large : constant Boolean :=
+                    Num'Small_Numerator > LLLU'Last
+                      or else Num'Small_Denominator > LLLU'Last;
+      --  True if the Small is too large for Long_Long_Long_Unsigned, in which
+      --  case we convert to/from Long_Long_Float as an intermediate step.
+
+      package Conv_I is new Big_Integers.Signed_Conversions (LLLI);
+      package Conv_U is new Big_Integers.Unsigned_Conversions (LLLU);
+
       -----------------
       -- To_Big_Real --
       -----------------
 
+      --  We just compute V * N / D where V is the mantissa value of the fixed
+      --  point number, and N resp. D is the numerator resp. the denominator of
+      --  the Small of the fixed-point type.
+
       function To_Big_Real (Arg : Num) return Valid_Big_Real is
+         N, D, V : Big_Integer;
+
       begin
-         return From_String (Arg'Image);
+         if Too_Large then
+            return Float_Aux.To_Big_Real (Long_Long_Float (Arg));
+         end if;
+
+         N := Conv_U.To_Big_Integer (Num'Small_Numerator);
+         D := Conv_U.To_Big_Integer (Num'Small_Denominator);
+         V := Conv_I.To_Big_Integer (LLLI'Integer_Value (Arg));
+
+         return V * N / D;
       end To_Big_Real;
 
       -------------------
       -- From_Big_Real --
       -------------------
 
+      --  We first compute A / B = Arg * D / N where N resp. D is the numerator
+      --  resp. the denominator of the Small of the fixed-point type. Then we
+      --  divide A by B and convert the result to the mantissa value.
+
       function From_Big_Real (Arg : Big_Real) return Num is
+         N, D, A, B, Q, X : Big_Integer;
+
       begin
-         return Num'Value (To_String (Arg));
+         if Too_Large then
+            return Num (Float_Aux.From_Big_Real (Arg));
+         end if;
+
+         N := Conv_U.To_Big_Integer (Num'Small_Numerator);
+         D := Conv_U.To_Big_Integer (Num'Small_Denominator);
+         A := Numerator (Arg) * D;
+         B := Denominator (Arg) * N;
+
+         Q := A / B;
+
+         --  Round to nearest, ties to away, by comparing twice the remainder
+
+         X := (A - Q * B) * To_Big_Integer (2);
+
+         if X >= B then
+            Q := Q + To_Big_Integer (1);
+
+         elsif X <= -B then
+            Q := Q - To_Big_Integer (1);
+         end if;
+
+         return Num'Fixed_Value (Conv_I.From_Big_Integer (Q));
       end From_Big_Real;
 
    end Fixed_Conversions;