[Ada] Small adjustment to parameterization of System.Value_R

gcc/ada/

	* doc/gnat_ugn/gnat_and_program_execution.rst: Minor fix.
	* gnat_ugn.texi: Regenerate.
	* libgnat/s-valuer.ads (Precision_Limit): New formal parameter.
	* libgnat/s-valuer.adb (Precision_Limit): Remove.
	(Scan_Decimal_Digits): Robustify overflow check.
	(Scan_Integral_Digits): Likewise.
	* libgnat/s-valrea.adb: Add assertion on the size of the unsigned
	type and instantiate System.Value_R with the mantissa limit.
	(Integer_to_Real): Add Extra parameter and take it into account.
	(Scan_Real): Pass Extra to Integer_to_Real.
	(Value_Real): Likewise.
	* libgnat/s-valued.adb: Add assertion on the size of the unsigned
	type and instantiate System.Value_R with the mantissa limit.
	* libgnat/s-valuef.adb: Likewise.

7 files changed, 54 insertions, 23 deletions

diff --git a/gcc/ada/doc/gnat_ugn/gnat_and_program_execution.rst b/gcc/ada/doc/gnat_ugn/gnat_and_program_execution.rst
index ba2c9b6..c4f186e 100644
--- a/gcc/ada/doc/gnat_ugn/gnat_and_program_execution.rst
+++ b/gcc/ada/doc/gnat_ugn/gnat_and_program_execution.rst
@@ -1840,7 +1840,7 @@ improves performance for your program.
 
 .. _Floating_Point_Operations:
 
-Floating_Point_Operations
+Floating Point Operations
 ^^^^^^^^^^^^^^^^^^^^^^^^^
 
 .. index:: Floating-Point Operations
diff --git a/gcc/ada/gnat_ugn.texi b/gcc/ada/gnat_ugn.texi
index 65326ba..2efa06f 100644
--- a/gcc/ada/gnat_ugn.texi
+++ b/gcc/ada/gnat_ugn.texi
@@ -381,7 +381,7 @@ Performance Considerations
 * Optimization Levels:: 
 * Debugging Optimized Code:: 
 * Inlining of Subprograms:: 
-* Floating_Point_Operations:: 
+* Floating Point Operations:: 
 * Vectorization of loops:: 
 * Other Optimization Switches:: 
 * Optimization and Strict Aliasing:: 
@@ -19652,7 +19652,7 @@ some guidelines on debugging optimized code.
 * Optimization Levels:: 
 * Debugging Optimized Code:: 
 * Inlining of Subprograms:: 
-* Floating_Point_Operations:: 
+* Floating Point Operations:: 
 * Vectorization of loops:: 
 * Other Optimization Switches:: 
 * Optimization and Strict Aliasing:: 
@@ -20001,7 +20001,7 @@ Note that if you use @code{-g} you can then use the @code{strip} program
 on the resulting executable,
 which removes both debugging information and global symbols.
 
-@node Inlining of Subprograms,Floating_Point_Operations,Debugging Optimized Code,Performance Considerations
+@node Inlining of Subprograms,Floating Point Operations,Debugging Optimized Code,Performance Considerations
 @anchor{gnat_ugn/gnat_and_program_execution id32}@anchor{185}@anchor{gnat_ugn/gnat_and_program_execution inlining-of-subprograms}@anchor{100}
 @subsubsection Inlining of Subprograms
 
@@ -20140,9 +20140,9 @@ automatically assume that @code{-O3} is better than @code{-O2}, and
 indeed you should use @code{-O3} only if tests show that it actually
 improves performance for your program.
 
-@node Floating_Point_Operations,Vectorization of loops,Inlining of Subprograms,Performance Considerations
+@node Floating Point Operations,Vectorization of loops,Inlining of Subprograms,Performance Considerations
 @anchor{gnat_ugn/gnat_and_program_execution floating-point-operations}@anchor{186}@anchor{gnat_ugn/gnat_and_program_execution id33}@anchor{187}
-@subsubsection Floating_Point_Operations
+@subsubsection Floating Point Operations
 
 
 @geindex Floating-Point Operations
@@ -20188,7 +20188,7 @@ Note that the ABI has the same form for both floating-point models,
 so it is permissible to mix units compiled with and without these
 switches.
 
-@node Vectorization of loops,Other Optimization Switches,Floating_Point_Operations,Performance Considerations
+@node Vectorization of loops,Other Optimization Switches,Floating Point Operations,Performance Considerations
 @anchor{gnat_ugn/gnat_and_program_execution id34}@anchor{188}@anchor{gnat_ugn/gnat_and_program_execution vectorization-of-loops}@anchor{189}
 @subsubsection Vectorization of loops
 
diff --git a/gcc/ada/libgnat/s-valrea.adb b/gcc/ada/libgnat/s-valrea.adb
index cd02dfe..1add4e9 100644
--- a/gcc/ada/libgnat/s-valrea.adb
+++ b/gcc/ada/libgnat/s-valrea.adb
@@ -36,13 +36,20 @@ with System.Value_R;
 
 package body System.Val_Real is
 
-   package Impl is new Value_R (Uns, Floating => True);
+   pragma Assert (Num'Machine_Mantissa <= Uns'Size);
+   --  We need an unsigned type large enough to represent the mantissa
+
+   Precision_Limit : constant Uns := 2**Num'Machine_Mantissa - 1;
+   --  We use the precision of the floating-point type
+
+   package Impl is new Value_R (Uns, Precision_Limit, Floating => True);
 
    function Integer_to_Real
      (Str   : String;
       Val   : Uns;
       Base  : Unsigned;
       Scale : Integer;
+      Extra : Unsigned;
       Minus : Boolean) return Num;
    --  Convert the real value from integer to real representation
 
@@ -55,6 +62,7 @@ package body System.Val_Real is
       Val   : Uns;
       Base  : Unsigned;
       Scale : Integer;
+      Extra : Unsigned;
       Minus : Boolean) return Num
    is
       pragma Assert (Base in 2 .. 16);
@@ -62,6 +70,7 @@ package body System.Val_Real is
       pragma Unsuppress (Range_Check);
 
       R_Val : Num;
+      S     : Integer := Scale;
 
    begin
       --  We call the floating-point processor reset routine so we can be sure
@@ -73,12 +82,21 @@ package body System.Val_Real is
          System.Float_Control.Reset;
       end if;
 
-      --  Compute the final value with a single rounding if possible
+      --  Take into account the extra digit near the limit to avoid anomalies
+
+      if Extra > 0 and then Val <= Precision_Limit / Uns (Base) then
+         R_Val := Num (Val * Uns (Base)) + Num (Extra);
+         S := S - 1;
+      else
+         R_Val := Num (Val);
+      end if;
+
+      --  Compute the final value
 
-      if Scale < 0 then
-         R_Val := Num (Val) / Num (Base) ** (-Scale);
+      if S < 0 then
+         R_Val := R_Val / Num (Base) ** (-S);
       else
-         R_Val := Num (Val) * Num (Base) ** Scale;
+         R_Val := R_Val * Num (Base) ** S;
       end if;
 
       --  Finally deal with initial minus sign, note that this processing is
@@ -102,14 +120,13 @@ package body System.Val_Real is
       Base  : Unsigned;
       Scale : Integer;
       Extra : Unsigned;
-      pragma Unreferenced (Extra);
       Minus : Boolean;
       Val   : Uns;
 
    begin
       Val := Impl.Scan_Raw_Real (Str, Ptr, Max, Base, Scale, Extra, Minus);
 
-      return Integer_to_Real (Str, Val, Base, Scale, Minus);
+      return Integer_to_Real (Str, Val, Base, Scale, Extra, Minus);
    end Scan_Real;
 
    ----------------
@@ -120,14 +137,13 @@ package body System.Val_Real is
       Base  : Unsigned;
       Scale : Integer;
       Extra : Unsigned;
-      pragma Unreferenced (Extra);
       Minus : Boolean;
       Val   : Uns;
 
    begin
       Val := Impl.Value_Raw_Real (Str, Base, Scale, Extra, Minus);
 
-      return Integer_to_Real (Str, Val, Base, Scale, Minus);
+      return Integer_to_Real (Str, Val, Base, Scale, Extra, Minus);
    end Value_Real;
 
 end System.Val_Real;
diff --git a/gcc/ada/libgnat/s-valued.adb b/gcc/ada/libgnat/s-valued.adb
index 5fa8a99..7986ce3 100644
--- a/gcc/ada/libgnat/s-valued.adb
+++ b/gcc/ada/libgnat/s-valued.adb
@@ -35,7 +35,10 @@ with System.Value_R;
 
 package body System.Value_D is
 
-   package Impl is new Value_R (Uns, Floating => False);
+   pragma Assert (Int'Size <= Uns'Size);
+   --  We need an unsigned type large enough to represent the mantissa
+
+   package Impl is new Value_R (Uns, 2**(Int'Size - 1), Floating => False);
 
    function Integer_to_Decimal
      (Str    : String;
diff --git a/gcc/ada/libgnat/s-valuef.adb b/gcc/ada/libgnat/s-valuef.adb
index 9a54cf3..5a87a7f 100644
--- a/gcc/ada/libgnat/s-valuef.adb
+++ b/gcc/ada/libgnat/s-valuef.adb
@@ -43,7 +43,10 @@ package body System.Value_F is
    --  supported values for the base of the literal. Given that the largest
    --  supported base is 16, this gives a limit of 2**(Int'Size - 5).
 
-   package Impl is new Value_R (Uns, Floating => False);
+   pragma Assert (Int'Size <= Uns'Size);
+   --  We need an unsigned type large enough to represent the mantissa
+
+   package Impl is new Value_R (Uns, 2**(Int'Size - 1), Floating => False);
 
    function Integer_To_Fixed
      (Str    : String;
diff --git a/gcc/ada/libgnat/s-valuer.adb b/gcc/ada/libgnat/s-valuer.adb
index 04b064f..9c126cc 100644
--- a/gcc/ada/libgnat/s-valuer.adb
+++ b/gcc/ada/libgnat/s-valuer.adb
@@ -33,9 +33,6 @@ with System.Val_Util; use System.Val_Util;
 
 package body System.Value_R is
 
-   Precision_Limit : constant Uns := 2 ** (Uns'Size - 1);
-   --  Limit beyond which additional digits are dropped
-
    subtype Char_As_Digit is Unsigned range 0 .. 17;
    subtype Valid_Digit is Char_As_Digit range 0 .. 15;
    E_Digit     : constant Char_As_Digit := 14;
@@ -238,8 +235,13 @@ package body System.Value_R is
 
                Temp := Value * Uns (Base) + Uns (Digit);
 
+               --  Check if Temp is larger than Precision_Limit, taking into
+               --  account that Temp may have wrapped around.
+
                if Value <= Umax
-                 or else (Value <= UmaxB and then Temp <= Precision_Limit)
+                 or else (Value <= UmaxB
+                           and then Temp <= Precision_Limit
+                           and then Temp >= Uns (Base))
                then
                   Value := Temp;
                   Scale := Scale - 1;
@@ -383,8 +385,13 @@ package body System.Value_R is
          else
             Temp := Value * Uns (Base) + Uns (Digit);
 
+            --  Check if Temp is larger than Precision_Limit, taking into
+            --  account that Temp may have wrapped around.
+
             if Value <= Umax
-              or else (Value <= UmaxB and then Temp <= Precision_Limit)
+              or else (Value <= UmaxB
+                        and then Temp <= Precision_Limit
+                        and then Temp >= Uns (Base))
             then
                Value := Temp;
 
diff --git a/gcc/ada/libgnat/s-valuer.ads b/gcc/ada/libgnat/s-valuer.ads
index 8d2f3fd..06fbe9e 100644
--- a/gcc/ada/libgnat/s-valuer.ads
+++ b/gcc/ada/libgnat/s-valuer.ads
@@ -38,6 +38,8 @@ generic
 
    type Uns is mod <>;
 
+   Precision_Limit : Uns;
+
    Floating : Boolean;
 
 package System.Value_R is