From 5a85f3129cc19637c5a2fb4848fe78324c4c1a0c Mon Sep 17 00:00:00 2001 From: Eric Botcazou Date: Thu, 12 Nov 2020 15:56:00 +0100 Subject: [PATCH] [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. --- gcc/ada/libgnat/a-nbnbre.adb | 69 +++++++++++++++++++++++++++++++----- 1 file changed, 61 insertions(+), 8 deletions(-) diff --git a/gcc/ada/libgnat/a-nbnbre.adb b/gcc/ada/libgnat/a-nbnbre.adb index 4254b302faf..4ff5b352851 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; -- 2.30.2