From 04974721aeee72da4dc497d371bad42a779ad89e Mon Sep 17 00:00:00 2001 From: Eric Botcazou Date: Wed, 25 Nov 2020 19:32:15 +0100 Subject: [PATCH] [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. --- .../gnat_ugn/gnat_and_program_execution.rst | 2 +- gcc/ada/gnat_ugn.texi | 12 +++---- gcc/ada/libgnat/s-valrea.adb | 34 ++++++++++++++----- gcc/ada/libgnat/s-valued.adb | 5 ++- gcc/ada/libgnat/s-valuef.adb | 5 ++- gcc/ada/libgnat/s-valuer.adb | 17 +++++++--- gcc/ada/libgnat/s-valuer.ads | 2 ++ 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 ba2c9b6d201..c4f186ef130 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 65326ba8404..2efa06f0948 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 cd02dfea5f6..1add4e9a6a9 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 5fa8a99648c..7986ce3e5c8 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 9a54cf36872..5a87a7f3dfb 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 04b064fbe08..9c126cc3622 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 8d2f3fde11a..06fbe9e2233 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 -- 2.30.2