public inbox for gcc-cvs@sourceware.org
help / color / mirror / Atom feed
* [gcc r13-2457] [Ada] Correctly round Value attribute for floating point in more cases
@ 2022-09-06 7:15 Marc Poulhiès
0 siblings, 0 replies; only message in thread
From: Marc Poulhiès @ 2022-09-06 7:15 UTC (permalink / raw)
To: gcc-cvs
https://gcc.gnu.org/g:d6b15134378bfba88effc523f4eb2c20a9486a63
commit r13-2457-gd6b15134378bfba88effc523f4eb2c20a9486a63
Author: Eric Botcazou <ebotcazou@adacore.com>
Date: Mon Aug 1 23:10:40 2022 +0200
[Ada] Correctly round Value attribute for floating point in more cases
This provides correct rounding in the IEEE 754 sense for the Value attribute
of floating-point types in more cases, by bumping the number of significant
bits used in the initial integer mantissa obtained from parsing.
gcc/ada/
* libgnat/s-valuer.ads (System.Value_R): Add Parts formal parameter
as well as Data_Index, Scale_Array and Value_Array types.
(Scan_Raw_Real): Change type of Scale and return type.
(Value_Raw_Real): Likewise.
* libgnat/s-valuer.adb (Round_Extra): Reorder parameters and adjust
recursive call.
(Scan_Decimal_Digits): Reorder parameters, add N parameter and deal
with multi-part scale and value.
(Scan_Integral_Digits): Likewise.
(Scan_Raw_Real): Change type of Scale and return type and deal with
multi-part scale and value.
(Value_Raw_Real): Change type of Scale and return type and tidy up.
* libgnat/s-valued.adb (Impl): Pass 1 as Parts actual parameter.
(Scan_Decimal): Adjust to type changes.
(Value_Decimal): Likewise.
* libgnat/s-valuef.adb (Impl): Pass 1 as Parts actual parameter.
(Scan_Fixed): Adjust to type changes.
(Value_Fixed): Likewise.
* libgnat/s-valrea.adb (Need_Extra): Delete.
(Precision_Limit): Always use the precision of the mantissa.
(Impl): Pass 2 as Parts actual parameter.
(Exact_Log2): New expression function.
(Integer_to_Real): Change type of Scale and Val and deal with a
2-part integer mantissa.
(Scan_Real): Adjust to type changes.
(Value_Real): Likewise.
Diff:
---
gcc/ada/libgnat/s-valrea.adb | 186 +++++++++++++++++++----------------------
gcc/ada/libgnat/s-valued.adb | 30 +++----
gcc/ada/libgnat/s-valuef.adb | 32 ++++----
gcc/ada/libgnat/s-valuer.adb | 192 +++++++++++++++++++++++++------------------
gcc/ada/libgnat/s-valuer.ads | 31 +++++--
5 files changed, 253 insertions(+), 218 deletions(-)
diff --git a/gcc/ada/libgnat/s-valrea.adb b/gcc/ada/libgnat/s-valrea.adb
index c9e5505c93c..b712ba6827a 100644
--- a/gcc/ada/libgnat/s-valrea.adb
+++ b/gcc/ada/libgnat/s-valrea.adb
@@ -43,18 +43,9 @@ package body System.Val_Real is
pragma Assert (Num'Machine_Mantissa <= Uns'Size);
-- We need an unsigned type large enough to represent the mantissa
- Need_Extra : constant Boolean := Num'Machine_Mantissa > Uns'Size - 4;
- -- If the mantissa of the floating-point type is almost as large as the
- -- unsigned type, we do not have enough space for an extra digit in the
- -- unsigned type so we handle the extra digit separately, at the cost of
- -- a bit more work in Integer_to_Real.
+ Precision_Limit : constant Uns := 2**Num'Machine_Mantissa - 1;
- Precision_Limit : constant Uns :=
- (if Need_Extra then 2**Num'Machine_Mantissa - 1 else 2**Uns'Size - 1);
- -- If we handle the extra digit separately, we use the precision of the
- -- floating-point type so that the conversion is exact.
-
- package Impl is new Value_R (Uns, Precision_Limit, Round => Need_Extra);
+ package Impl is new Value_R (Uns, 2, Precision_Limit, Round => False);
subtype Base_T is Unsigned range 2 .. 16;
@@ -83,12 +74,20 @@ package body System.Val_Real is
subtype Double_T is Double_Real.Double_T;
-- The double floating-point type
+ function Exact_Log2 (N : Unsigned) return Positive is
+ (case N is
+ when 2 => 1,
+ when 4 => 2,
+ when 8 => 3,
+ when 16 => 4,
+ when others => raise Program_Error);
+ -- Return the exponent of a power of 2
+
function Integer_to_Real
(Str : String;
- Val : Uns;
+ Val : Impl.Value_Array;
Base : Unsigned;
- Scale : Integer;
- Extra : Unsigned;
+ Scale : Impl.Scale_Array;
Minus : Boolean) return Num;
-- Convert the real value from integer to real representation
@@ -101,10 +100,9 @@ package body System.Val_Real is
function Integer_to_Real
(Str : String;
- Val : Uns;
+ Val : Impl.Value_Array;
Base : Unsigned;
- Scale : Integer;
- Extra : Unsigned;
+ Scale : Impl.Scale_Array;
Minus : Boolean) return Num
is
pragma Assert (Base in 2 .. 16);
@@ -120,9 +118,9 @@ package body System.Val_Real is
else raise Program_Error);
-- Maximum exponent of the base that can fit in Num
- R_Val : Num;
D_Val : Double_T;
- S : Integer := Scale;
+ R_Val : Num;
+ S : Integer;
begin
-- We call the floating-point processor reset routine so we can be sure
@@ -134,82 +132,78 @@ package body System.Val_Real is
System.Float_Control.Reset;
end if;
- -- Take into account the extra digit, i.e. do the two computations
-
- -- (1) R_Val := R_Val * Num (B) + Num (Extra)
- -- (2) S := S - 1
+ -- First convert the integer mantissa into a double real. The conversion
+ -- of each part is exact, given the precision limit we used above. Then,
+ -- if the contribution of the low part might be nonnull, scale the high
+ -- part appropriately and add the low part to the result.
- -- In the first, the three operands are exact, so using an FMA would
- -- be ideal, but we are most likely running on the x87 FPU, hence we
- -- may not have one. That is why we turn the multiplication into an
- -- iterated addition with exact error handling, so that we can do a
- -- single rounding at the end.
+ if Val (2) = 0 then
+ D_Val := Double_Real.To_Double (Num (Val (1)));
+ S := Scale (1);
- if Need_Extra and then Extra > 0 then
+ else
declare
- B : Unsigned := Base;
- Acc : Num := 0.0;
- Err : Num := 0.0;
- Fac : Num := Num (Val);
- DS : Double_T;
+ V1 : constant Num := Num (Val (1));
+ V2 : constant Num := Num (Val (2));
+
+ DS : Positive;
begin
- loop
- -- If B is odd, add one factor. Note that the accumulator is
- -- never larger than the factor at this point (it is in fact
- -- never larger than the factor minus the initial value).
-
- if B rem 2 /= 0 then
- if Acc = 0.0 then
- Acc := Fac;
- else
- DS := Double_Real.Quick_Two_Sum (Fac, Acc);
- Acc := DS.Hi;
- Err := Err + DS.Lo;
- end if;
- exit when B = 1;
- end if;
+ DS := Scale (1) - Scale (2);
- -- Now B is (morally) even, halve it and double the factor,
- -- which is always an exact operation.
+ case Base is
+ -- If the base is a power of two, we use the efficient Scaling
+ -- attribute up to an amount worth a double mantissa.
- B := B / 2;
- Fac := Fac * 2.0;
- end loop;
+ when 2 | 4 | 8 | 16 =>
+ declare
+ L : constant Positive := Exact_Log2 (Base);
- -- Add Extra to the error, which are both small integers
+ begin
+ if DS <= 2 * Num'Machine_Mantissa / L then
+ DS := DS * L;
+ D_Val :=
+ Double_Real.Quick_Two_Sum (Num'Scaling (V1, DS), V2);
+ S := Scale (2);
- D_Val := Double_Real.Quick_Two_Sum (Acc, Err + Num (Extra));
+ else
+ D_Val := Double_Real.To_Double (V1);
+ S := Scale (1);
+ end if;
+ end;
- S := S - 1;
- end;
+ -- If the base is 10, we also scale up to an amount worth a
+ -- double mantissa.
- -- Or else, if the Extra digit is zero, do the exact conversion
+ when 10 =>
+ declare
+ Powten : constant array (0 .. Maxpow) of Double_T;
+ pragma Import (Ada, Powten);
+ for Powten'Address use Powten_Address;
- elsif Need_Extra then
- D_Val := Double_Real.To_Double (Num (Val));
+ begin
+ if DS <= Maxpow then
+ D_Val := Powten (DS) * V1 + V2;
+ S := Scale (2);
- -- Otherwise, the value contains more bits than the mantissa so do the
- -- conversion in two steps.
+ else
+ D_Val := Double_Real.To_Double (V1);
+ S := Scale (1);
+ end if;
+ end;
- else
- declare
- Mask : constant Uns := 2**(Uns'Size - Num'Machine_Mantissa) - 1;
- Hi : constant Uns := Val and not Mask;
- Lo : constant Uns := Val and Mask;
+ -- Inaccurate implementation for other bases
- begin
- if Hi = 0 then
- D_Val := Double_Real.To_Double (Num (Lo));
- else
- D_Val := Double_Real.Quick_Two_Sum (Num (Hi), Num (Lo));
- end if;
+ when others =>
+ D_Val := Double_Real.To_Double (V1);
+ S := Scale (1);
+ end case;
end;
end if;
-- Compute the final value by applying the scaling, if any
- if Val = 0 or else S = 0 then
+ if (Val (1) = 0 and then Val (2) = 0) or else S = 0 then
R_Val := Double_Real.To_Single (D_Val);
else
@@ -218,29 +212,17 @@ package body System.Val_Real is
-- attribute with an overflow check, if it is not 2, to catch
-- ludicrous exponents that would result in an infinity or zero.
- when 2 =>
- R_Val := Num'Scaling (Double_Real.To_Single (D_Val), S);
-
- when 4 =>
- if Integer'First / 2 <= S and then S <= Integer'Last / 2 then
- S := S * 2;
- end if;
-
- R_Val := Num'Scaling (Double_Real.To_Single (D_Val), S);
-
- when 8 =>
- if Integer'First / 3 <= S and then S <= Integer'Last / 3 then
- S := S * 3;
- end if;
-
- R_Val := Num'Scaling (Double_Real.To_Single (D_Val), S);
+ when 2 | 4 | 8 | 16 =>
+ declare
+ L : constant Positive := Exact_Log2 (Base);
- when 16 =>
- if Integer'First / 4 <= S and then S <= Integer'Last / 4 then
- S := S * 4;
- end if;
+ begin
+ if Integer'First / L <= S and then S <= Integer'Last / L then
+ S := S * L;
+ end if;
- R_Val := Num'Scaling (Double_Real.To_Single (D_Val), S);
+ R_Val := Num'Scaling (Double_Real.To_Single (D_Val), S);
+ end;
-- If the base is 10, use a double implementation for the sake
-- of accuracy, to be removed when exponentiation is improved.
@@ -358,15 +340,15 @@ package body System.Val_Real is
Max : Integer) return Num
is
Base : Unsigned;
- Scale : Integer;
+ Scale : Impl.Scale_Array;
Extra : Unsigned;
Minus : Boolean;
- Val : Uns;
+ Val : Impl.Value_Array;
begin
Val := Impl.Scan_Raw_Real (Str, Ptr, Max, Base, Scale, Extra, Minus);
- return Integer_to_Real (Str, Val, Base, Scale, Extra, Minus);
+ return Integer_to_Real (Str, Val, Base, Scale, Minus);
end Scan_Real;
----------------
@@ -375,15 +357,15 @@ package body System.Val_Real is
function Value_Real (Str : String) return Num is
Base : Unsigned;
- Scale : Integer;
+ Scale : Impl.Scale_Array;
Extra : Unsigned;
Minus : Boolean;
- Val : Uns;
+ Val : Impl.Value_Array;
begin
Val := Impl.Value_Raw_Real (Str, Base, Scale, Extra, Minus);
- return Integer_to_Real (Str, Val, Base, Scale, Extra, Minus);
+ return Integer_to_Real (Str, Val, Base, Scale, 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 c4a78a2ac87..92e9140443e 100644
--- a/gcc/ada/libgnat/s-valued.adb
+++ b/gcc/ada/libgnat/s-valued.adb
@@ -38,7 +38,7 @@ package body System.Value_D is
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), Round => False);
+ package Impl is new Value_R (Uns, 1, 2**(Int'Size - 1), Round => False);
-- We do not use the Extra digit for decimal fixed-point types
function Integer_to_Decimal
@@ -229,16 +229,16 @@ package body System.Value_D is
Max : Integer;
Scale : Integer) return Int
is
- Base : Unsigned;
- ScaleB : Integer;
- Extra : Unsigned;
- Minus : Boolean;
- Val : Uns;
+ Base : Unsigned;
+ Scl : Impl.Scale_Array;
+ Extra : Unsigned;
+ Minus : Boolean;
+ Val : Impl.Value_Array;
begin
- Val := Impl.Scan_Raw_Real (Str, Ptr, Max, Base, ScaleB, Extra, Minus);
+ Val := Impl.Scan_Raw_Real (Str, Ptr, Max, Base, Scl, Extra, Minus);
- return Integer_to_Decimal (Str, Val, Base, ScaleB, Minus, Scale);
+ return Integer_to_Decimal (Str, Val (1), Base, Scl (1), Minus, Scale);
end Scan_Decimal;
-------------------
@@ -246,16 +246,16 @@ package body System.Value_D is
-------------------
function Value_Decimal (Str : String; Scale : Integer) return Int is
- Base : Unsigned;
- ScaleB : Integer;
- Extra : Unsigned;
- Minus : Boolean;
- Val : Uns;
+ Base : Unsigned;
+ Scl : Impl.Scale_Array;
+ Extra : Unsigned;
+ Minus : Boolean;
+ Val : Impl.Value_Array;
begin
- Val := Impl.Value_Raw_Real (Str, Base, ScaleB, Extra, Minus);
+ Val := Impl.Value_Raw_Real (Str, Base, Scl, Extra, Minus);
- return Integer_to_Decimal (Str, Val, Base, ScaleB, Minus, Scale);
+ return Integer_to_Decimal (Str, Val (1), Base, Scl (1), Minus, Scale);
end Value_Decimal;
end System.Value_D;
diff --git a/gcc/ada/libgnat/s-valuef.adb b/gcc/ada/libgnat/s-valuef.adb
index e252a285364..1b9d18ef708 100644
--- a/gcc/ada/libgnat/s-valuef.adb
+++ b/gcc/ada/libgnat/s-valuef.adb
@@ -46,7 +46,7 @@ package body System.Value_F is
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), Round => True);
+ package Impl is new Value_R (Uns, 1, 2**(Int'Size - 1), Round => True);
-- We use the Extra digit for ordinary fixed-point types
function Integer_To_Fixed
@@ -332,16 +332,17 @@ package body System.Value_F is
Num : Int;
Den : Int) return Int
is
- Base : Unsigned;
- ScaleB : Integer;
- Extra : Unsigned;
- Minus : Boolean;
- Val : Uns;
+ Base : Unsigned;
+ Scl : Impl.Scale_Array;
+ Extra : Unsigned;
+ Minus : Boolean;
+ Val : Impl.Value_Array;
begin
- Val := Impl.Scan_Raw_Real (Str, Ptr, Max, Base, ScaleB, Extra, Minus);
+ Val := Impl.Scan_Raw_Real (Str, Ptr, Max, Base, Scl, Extra, Minus);
- return Integer_To_Fixed (Str, Val, Base, ScaleB, Extra, Minus, Num, Den);
+ return
+ Integer_To_Fixed (Str, Val (1), Base, Scl (1), Extra, Minus, Num, Den);
end Scan_Fixed;
-----------------
@@ -353,16 +354,17 @@ package body System.Value_F is
Num : Int;
Den : Int) return Int
is
- Base : Unsigned;
- ScaleB : Integer;
- Extra : Unsigned;
- Minus : Boolean;
- Val : Uns;
+ Base : Unsigned;
+ Scl : Impl.Scale_Array;
+ Extra : Unsigned;
+ Minus : Boolean;
+ Val : Impl.Value_Array;
begin
- Val := Impl.Value_Raw_Real (Str, Base, ScaleB, Extra, Minus);
+ Val := Impl.Value_Raw_Real (Str, Base, Scl, Extra, Minus);
- return Integer_To_Fixed (Str, Val, Base, ScaleB, Extra, Minus, Num, Den);
+ return
+ Integer_To_Fixed (Str, Val (1), Base, Scl (1), Extra, Minus, Num, Den);
end Value_Fixed;
end System.Value_F;
diff --git a/gcc/ada/libgnat/s-valuer.adb b/gcc/ada/libgnat/s-valuer.adb
index fc916606343..c55444a1ec7 100644
--- a/gcc/ada/libgnat/s-valuer.adb
+++ b/gcc/ada/libgnat/s-valuer.adb
@@ -44,22 +44,23 @@ package body System.Value_R is
procedure Round_Extra
(Digit : Char_As_Digit;
+ Base : Unsigned;
Value : in out Uns;
Scale : in out Integer;
- Extra : in out Char_As_Digit;
- Base : Unsigned);
+ Extra : in out Char_As_Digit);
-- Round the triplet (Value, Scale, Extra) according to Digit in Base
procedure Scan_Decimal_Digits
(Str : String;
Index : in out Integer;
Max : Integer;
- Value : in out Uns;
- Scale : in out Integer;
- Extra : in out Char_As_Digit;
- Base_Violation : in out Boolean;
Base : Unsigned;
- Base_Specified : Boolean);
+ Base_Specified : Boolean;
+ Value : in out Value_Array;
+ Scale : in out Scale_Array;
+ N : in out Positive;
+ Extra : in out Char_As_Digit;
+ Base_Violation : in out Boolean);
-- Scan the decimal part of a real (i.e. after decimal separator)
--
-- The string parsed is Str (Index .. Max) and after the call Index will
@@ -77,12 +78,13 @@ package body System.Value_R is
(Str : String;
Index : in out Integer;
Max : Integer;
- Value : out Uns;
- Scale : out Integer;
- Extra : out Char_As_Digit;
- Base_Violation : in out Boolean;
Base : Unsigned;
- Base_Specified : Boolean);
+ Base_Specified : Boolean;
+ Value : out Value_Array;
+ Scale : out Scale_Array;
+ N : out Positive;
+ Extra : out Char_As_Digit;
+ Base_Violation : in out Boolean);
-- Scan the integral part of a real (i.e. before decimal separator)
--
-- The string parsed is Str (Index .. Max) and after the call Index will
@@ -123,10 +125,10 @@ package body System.Value_R is
procedure Round_Extra
(Digit : Char_As_Digit;
+ Base : Unsigned;
Value : in out Uns;
Scale : in out Integer;
- Extra : in out Char_As_Digit;
- Base : Unsigned)
+ Extra : in out Char_As_Digit)
is
pragma Assert (Base in 2 .. 16);
@@ -145,7 +147,7 @@ package body System.Value_R is
Extra := Char_As_Digit (Value mod B);
Value := Value / B;
Scale := Scale + 1;
- Round_Extra (Digit, Value, Scale, Extra, Base);
+ Round_Extra (Digit, Base, Value, Scale, Extra);
else
Extra := 0;
@@ -166,12 +168,13 @@ package body System.Value_R is
(Str : String;
Index : in out Integer;
Max : Integer;
- Value : in out Uns;
- Scale : in out Integer;
- Extra : in out Char_As_Digit;
- Base_Violation : in out Boolean;
Base : Unsigned;
- Base_Specified : Boolean)
+ Base_Specified : Boolean;
+ Value : in out Value_Array;
+ Scale : in out Scale_Array;
+ N : in out Positive;
+ Extra : in out Char_As_Digit;
+ Base_Violation : in out Boolean)
is
pragma Assert (Base in 2 .. 16);
@@ -205,7 +208,7 @@ package body System.Value_R is
-- If initial Scale is not 0 then it means that Precision_Limit was
-- reached during scanning of the integral part.
- if Scale > 0 then
+ if Scale (Data_Index'Last) > 0 then
Precision_Limit_Reached := True;
else
Extra := 0;
@@ -247,7 +250,7 @@ package body System.Value_R is
if Precision_Limit_Reached then
if Round and then Precision_Limit_Just_Reached then
- Round_Extra (Digit, Value, Scale, Extra, Base);
+ Round_Extra (Digit, Base, Value (N), Scale (N), Extra);
Precision_Limit_Just_Reached := False;
end if;
@@ -258,19 +261,24 @@ package body System.Value_R is
Trailing_Zeros := Trailing_Zeros + 1;
else
- -- Handle accumulated zeros.
+ -- Handle accumulated zeros
for J in 1 .. Trailing_Zeros loop
- if Value <= UmaxB then
- Value := Value * Uns (Base);
- Scale := Scale - 1;
+ if Value (N) <= UmaxB then
+ Value (N) := Value (N) * Uns (Base);
+ Scale (N) := Scale (N) - 1;
+
+ elsif Parts > 1 and then N < Data_Index'Last then
+ N := N + 1;
+ Scale (N) := Scale (N - 1) - 1;
else
Extra := 0;
Precision_Limit_Reached := True;
if Round and then J = Trailing_Zeros then
- Round_Extra (Digit, Value, Scale, Extra, Base);
+ Round_Extra (Digit, Base, Value (N), Scale (N), Extra);
end if;
+
exit;
end if;
end loop;
@@ -281,7 +289,7 @@ package body System.Value_R is
-- Handle current non zero digit
- Temp := Value * Uns (Base) + Uns (Digit);
+ Temp := Value (N) * Uns (Base) + Uns (Digit);
-- Precision_Limit_Reached may have been set above
@@ -292,15 +300,20 @@ package body System.Value_R is
-- account that Temp may wrap around when Precision_Limit is
-- equal to the largest integer.
- elsif Value <= Umax
- or else (Value <= UmaxB
+ elsif Value (N) <= Umax
+ or else (Value (N) <= UmaxB
and then ((Precision_Limit < Uns'Last
and then Temp <= Precision_Limit)
or else (Precision_Limit = Uns'Last
and then Temp >= Uns (Base))))
then
- Value := Temp;
- Scale := Scale - 1;
+ Value (N) := Temp;
+ Scale (N) := Scale (N) - 1;
+
+ elsif Parts > 1 and then N < Data_Index'Last then
+ N := N + 1;
+ Value (N) := Uns (Digit);
+ Scale (N) := Scale (N - 1) - 1;
else
Extra := Digit;
@@ -352,12 +365,13 @@ package body System.Value_R is
(Str : String;
Index : in out Integer;
Max : Integer;
- Value : out Uns;
- Scale : out Integer;
- Extra : out Char_As_Digit;
- Base_Violation : in out Boolean;
Base : Unsigned;
- Base_Specified : Boolean)
+ Base_Specified : Boolean;
+ Value : out Value_Array;
+ Scale : out Scale_Array;
+ N : out Positive;
+ Extra : out Char_As_Digit;
+ Base_Violation : in out Boolean)
is
pragma Assert (Base in 2 .. 16);
@@ -382,10 +396,11 @@ package body System.Value_R is
-- Temporary
begin
- -- Initialize Value, Scale and Extra
+ -- Initialize N, Value, Scale and Extra
- Value := 0;
- Scale := 0;
+ N := 1;
+ Value := (others => 0);
+ Scale := (others => 0);
Extra := 0;
Precision_Limit_Reached := False;
@@ -422,28 +437,32 @@ package body System.Value_R is
-- should continue only to assess the validity of the string.
if Precision_Limit_Reached then
- Scale := Scale + 1;
+ Scale (N) := Scale (N) + 1;
if Round and then Precision_Limit_Just_Reached then
- Round_Extra (Digit, Value, Scale, Extra, Base);
+ Round_Extra (Digit, Base, Value (N), Scale (N), Extra);
Precision_Limit_Just_Reached := False;
end if;
else
- Temp := Value * Uns (Base) + Uns (Digit);
+ Temp := Value (N) * Uns (Base) + Uns (Digit);
-- Check if Temp is larger than Precision_Limit, taking into
-- account that Temp may wrap around when Precision_Limit is
-- equal to the largest integer.
- if Value <= Umax
- or else (Value <= UmaxB
+ if Value (N) <= Umax
+ or else (Value (N) <= UmaxB
and then ((Precision_Limit < Uns'Last
and then Temp <= Precision_Limit)
or else (Precision_Limit = Uns'Last
and then Temp >= Uns (Base))))
then
- Value := Temp;
+ Value (N) := Temp;
+
+ elsif Parts > 1 and then N < Data_Index'Last then
+ N := N + 1;
+ Value (N) := Uns (Digit);
else
Extra := Digit;
@@ -451,10 +470,16 @@ package body System.Value_R is
if Round then
Precision_Limit_Just_Reached := True;
end if;
- Scale := Scale + 1;
+ Scale (N) := Scale (N) + 1;
end if;
end if;
+ -- Every parsed digit also scales the previous parts
+
+ for J in 1 .. N - 1 loop
+ Scale (J) := Scale (J) + 1;
+ end loop;
+
-- Look for the next character
Index := Index + 1;
@@ -492,9 +517,9 @@ package body System.Value_R is
Ptr : not null access Integer;
Max : Integer;
Base : out Unsigned;
- Scale : out Integer;
+ Scale : out Scale_Array;
Extra : out Unsigned;
- Minus : out Boolean) return Uns
+ Minus : out Boolean) return Value_Array
is
pragma Assert (Max <= Str'Last);
@@ -509,8 +534,11 @@ package body System.Value_R is
-- If True some digits where not in the base. The real is still scanned
-- till the end even if an error will be raised.
+ N : Positive;
+ -- Index number of the current part
+
Expon : Integer;
- -- Exponent as an Integer
+ -- Exponent as an integer
Index : Integer;
-- Local copy of string pointer
@@ -518,8 +546,8 @@ package body System.Value_R is
Start : Positive;
-- Index of the first non-blank character
- Value : Uns;
- -- Mantissa as an Integer
+ Value : Value_Array;
+ -- Mantissa as an array of integers
begin
-- The default base is 10
@@ -554,8 +582,8 @@ package body System.Value_R is
-- part or the base to use.
Scan_Integral_Digits
- (Str, Index, Max, Value, Scale, Char_As_Digit (Extra),
- Base_Violation, Base, Base_Specified => False);
+ (Str, Index, Max, Base, False, Value, Scale, N,
+ Char_As_Digit (Extra), Base_Violation);
-- A dot is allowed only if followed by a digit (RM 3.5(47))
@@ -565,8 +593,9 @@ package body System.Value_R is
then
After_Point := True;
Index := Index + 1;
- Value := 0;
- Scale := 0;
+ N := 1;
+ Value := (others => 0);
+ Scale := (others => 0);
Extra := 0;
else
@@ -582,8 +611,8 @@ package body System.Value_R is
then
Base_Char := Str (Index);
- if Value in 2 .. 16 then
- Base := Unsigned (Value);
+ if N = 1 and then Value (1) in 2 .. 16 then
+ Base := Unsigned (Value (1));
else
Base_Violation := True;
Base := 16;
@@ -597,7 +626,7 @@ package body System.Value_R is
then
After_Point := True;
Index := Index + 1;
- Value := 0;
+ Value := (others => 0);
end if;
end if;
@@ -609,8 +638,8 @@ package body System.Value_R is
end if;
Scan_Integral_Digits
- (Str, Index, Max, Value, Scale, Char_As_Digit (Extra),
- Base_Violation, Base, Base_Specified => Base_Char /= ASCII.NUL);
+ (Str, Index, Max, Base, Base_Char /= ASCII.NUL, Value, Scale,
+ N, Char_As_Digit (Extra), Base_Violation);
end if;
-- Do we have a dot?
@@ -636,8 +665,8 @@ package body System.Value_R is
pragma Assert (Index <= Max);
Scan_Decimal_Digits
- (Str, Index, Max, Value, Scale, Char_As_Digit (Extra),
- Base_Violation, Base, Base_Specified => Base_Char /= ASCII.NUL);
+ (Str, Index, Max, Base, Base_Char /= ASCII.NUL, Value, Scale,
+ N, Char_As_Digit (Extra), Base_Violation);
end if;
-- If an explicit base was specified ensure that the delimiter is found
@@ -660,9 +689,15 @@ package body System.Value_R is
-- Handle very large exponents like Scan_Exponent
if Expon < Integer'First / 10 or else Expon > Integer'Last / 10 then
- Scale := Expon;
+ Scale (1) := Expon;
+ for J in 2 .. Data_Index'Last loop
+ Value (J) := 0;
+ end loop;
+
else
- Scale := Scale + Expon;
+ for J in Data_Index'Range loop
+ Scale (J) := Scale (J) + Expon;
+ end loop;
end if;
-- Here is where we check for a bad based number
@@ -672,7 +707,6 @@ package body System.Value_R is
else
return Value;
end if;
-
end Scan_Raw_Real;
--------------------
@@ -682,10 +716,13 @@ package body System.Value_R is
function Value_Raw_Real
(Str : String;
Base : out Unsigned;
- Scale : out Integer;
+ Scale : out Scale_Array;
Extra : out Unsigned;
- Minus : out Boolean) return Uns
+ Minus : out Boolean) return Value_Array
is
+ P : aliased Integer;
+ V : Value_Array;
+
begin
-- We have to special case Str'Last = Positive'Last because the normal
-- circuit ends up setting P to Str'Last + 1 which is out of bounds. We
@@ -697,20 +734,15 @@ package body System.Value_R is
begin
return Value_Raw_Real (NT (Str), Base, Scale, Extra, Minus);
end;
+ end if;
- -- Normal case where Str'Last < Positive'Last
+ -- Normal case
- else
- declare
- V : Uns;
- P : aliased Integer := Str'First;
- begin
- V := Scan_Raw_Real
- (Str, P'Access, Str'Last, Base, Scale, Extra, Minus);
- Scan_Trailing_Blanks (Str, P);
- return V;
- end;
- end if;
+ P := Str'First;
+ V := Scan_Raw_Real (Str, P'Access, Str'Last, Base, Scale, Extra, Minus);
+ Scan_Trailing_Blanks (Str, P);
+
+ return V;
end Value_Raw_Real;
end System.Value_R;
diff --git a/gcc/ada/libgnat/s-valuer.ads b/gcc/ada/libgnat/s-valuer.ads
index 3279090ce8a..d9d168ecb3e 100644
--- a/gcc/ada/libgnat/s-valuer.ads
+++ b/gcc/ada/libgnat/s-valuer.ads
@@ -37,22 +37,37 @@ with System.Unsigned_Types; use System.Unsigned_Types;
generic
type Uns is mod <>;
+ -- Modular type used for the value
+
+ Parts : Positive;
+ -- Number of Uns parts in the value
Precision_Limit : Uns;
+ -- Precision limit for each part of the value
Round : Boolean;
+ -- If Parts = 1, True if the extra digit must be rounded
package System.Value_R is
pragma Preelaborate;
+ subtype Data_Index is Positive range 1 .. Parts;
+ -- The type indexing the value
+
+ type Scale_Array is array (Data_Index) of Integer;
+ -- The scale for each part of the value
+
+ type Value_Array is array (Data_Index) of Uns;
+ -- The value split into parts
+
function Scan_Raw_Real
(Str : String;
Ptr : not null access Integer;
Max : Integer;
Base : out Unsigned;
- Scale : out Integer;
+ Scale : out Scale_Array;
Extra : out Unsigned;
- Minus : out Boolean) return Uns;
+ Minus : out Boolean) return Value_Array;
-- This function scans the string starting at Str (Ptr.all) for a valid
-- real literal according to the syntax described in (RM 3.5(43)). The
-- substring scanned extends no further than Str (Max). There are three
@@ -64,9 +79,13 @@ package System.Value_R is
-- parameters are set; if Val is the result of the call, then the real
-- represented by the literal is equal to
--
- -- (Val * Base + Extra) * (Base ** (Scale - 1))
+ -- (Val (1) * Base + Extra) * (Base ** (Scale (1) - 1))
+ --
+ -- when Parts = 1 and
+ --
+ -- Sum [Val (N) * (Base ** Scale (N)), N in 1 .. Parts]
--
- -- with the negative sign if Minus is true.
+ -- when Parts > 1, with the negative sign if Minus is true.
--
-- If no valid real is found, then Ptr.all points either to an initial
-- non-blank character, or to Max + 1 if the field is all spaces and the
@@ -91,9 +110,9 @@ package System.Value_R is
function Value_Raw_Real
(Str : String;
Base : out Unsigned;
- Scale : out Integer;
+ Scale : out Scale_Array;
Extra : out Unsigned;
- Minus : out Boolean) return Uns;
+ Minus : out Boolean) return Value_Array;
-- Used in computing X'Value (Str) where X is a real type. Str is the
-- string argument of the attribute. Constraint_Error is raised if the
-- string is malformed.
^ permalink raw reply [flat|nested] only message in thread
only message in thread, other threads:[~2022-09-06 7:15 UTC | newest]
Thread overview: (only message) (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2022-09-06 7:15 [gcc r13-2457] [Ada] Correctly round Value attribute for floating point in more cases Marc Poulhiès
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).