From: Eric Botcazou <ebotca...@adacore.com>
They are used to minimize the error after every operation, but they can be
eliminated by increasing the precision of the input value, which avoids the
unwanted effects of multiple roundings.
gcc/ada/ChangeLog:
* libgnat/s-valuer.ads (System.Value_R): Remove Round parameter.
(Scan_Raw_Real): Replace Extra with Extra2 and adjust the comment.
(Value_Raw_Real): Likewise.
* libgnat/s-valuer.adb (Round_Extra): Delete.
(Scan_Decimal_Digits): Replace Extra with Extra2 and adjust the
implementation.
(Scan_Integral_Digits): Replace Extra with Extra2 and Extra_Rounded
with Extra2_Filled and adjust the implementation.
(Scan_Raw_Real): Replace Extra with Extra2 and adjust the
implementation.
(Value_Raw_Real): Likewise.
* libgnat/s-valrea.adb (Impl): Remove actual for Round formal.
* libgnat/s-valued.adb (Impl): Likewise.
(Integer_to_Decimal): Replace Extra with Extra2 and adjust the
implementation. Rename Unsigned_To_Signed to To_Signed.
(Scan_Decimal): Replace Extra with Extra2 and adjust the
implementation.
(Value_Decimal): Likewise.
* libgnat/s-valuef.adb (Impl): Remove actual for Round formal.
(Integer_to_Fixed): Replace Extra with Extra2 and adjust the
implementation. Rename Unsigned_To_Signed to To_Signed. Only
round the last scaled divide operation.
(Scan_Fixed): Replace Extra with Extra2 and adjust the
implementation.
(Value_Fixed): Likewise.
Tested on x86_64-pc-linux-gnu, committed on master.
---
gcc/ada/libgnat/s-valrea.adb | 3 +-
gcc/ada/libgnat/s-valued.adb | 54 +++++------
gcc/ada/libgnat/s-valuef.adb | 104 ++++++++++----------
gcc/ada/libgnat/s-valuer.adb | 177 +++++++++++------------------------
gcc/ada/libgnat/s-valuer.ads | 31 +++---
5 files changed, 149 insertions(+), 220 deletions(-)
diff --git a/gcc/ada/libgnat/s-valrea.adb b/gcc/ada/libgnat/s-valrea.adb
index 6dd8aa5da96..aaa82d4e2c1 100644
--- a/gcc/ada/libgnat/s-valrea.adb
+++ b/gcc/ada/libgnat/s-valrea.adb
@@ -49,7 +49,8 @@ package body System.Val_Real is
Precision_Limit : constant Uns := 2**Num'Machine_Mantissa - 1;
-- See below for the rationale
- package Impl is new Value_R (Uns, 2, Precision_Limit, Round => False);
+ package Impl is new Value_R (Uns, 2, Precision_Limit);
+ -- We do not use the Extra digits for floating-point types
subtype Base_T is Unsigned range 2 .. 16;
diff --git a/gcc/ada/libgnat/s-valued.adb b/gcc/ada/libgnat/s-valued.adb
index cc2cffc72a6..57d5c04ab10 100644
--- a/gcc/ada/libgnat/s-valued.adb
+++ b/gcc/ada/libgnat/s-valued.adb
@@ -38,8 +38,8 @@ 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, 1, 2**(Int'Size - 1), Round => False);
- -- We do not use the Extra digit for decimal fixed-point types, except to
+ package Impl is new Value_R (Uns, 1, 2**(Int'Size - 1));
+ -- We do not use the Extra digits for decimal fixed-point types, except to
-- effectively ensure that overflow is detected near the boundaries.
function Integer_to_Decimal
@@ -47,7 +47,7 @@ package body System.Value_D is
Val : Uns;
Base : Unsigned;
ScaleB : Integer;
- Extra : Unsigned;
+ Extra2 : Unsigned;
Minus : Boolean;
Scale : Integer) return Int;
-- Convert the real value from integer to decimal representation
@@ -61,7 +61,7 @@ package body System.Value_D is
Val : Uns;
Base : Unsigned;
ScaleB : Integer;
- Extra : Unsigned;
+ Extra2 : Unsigned;
Minus : Boolean;
Scale : Integer) return Int
is
@@ -75,7 +75,7 @@ package body System.Value_D is
-- updated to contain the remaining power in the computation. Note that
-- Factor is expected to be positive in this context.
- function Unsigned_To_Signed (Val : Uns) return Int;
+ function To_Signed (Val : Uns) return Int;
-- Convert an integer value from unsigned to signed representation
-----------------
@@ -102,11 +102,11 @@ package body System.Value_D is
return Result;
end Safe_Expont;
- ------------------------
- -- Unsigned_To_Signed --
- ------------------------
+ ---------------
+ -- To_Signed --
+ ---------------
- function Unsigned_To_Signed (Val : Uns) return Int is
+ function To_Signed (Val : Uns) return Int is
begin
-- Deal with overflow cases, and also with largest negative number
@@ -127,11 +127,11 @@ package body System.Value_D is
else
return Int (Val);
end if;
- end Unsigned_To_Signed;
+ end To_Signed;
-- Local variables
- E : Uns := Uns (Extra);
+ E : Uns := Uns (Extra2 / Base);
begin
-- If the base of the value is 10 or its scaling factor is zero, then
@@ -159,7 +159,7 @@ package body System.Value_D is
end if;
end loop;
- return Unsigned_To_Signed (V);
+ return To_Signed (V);
end;
-- If the base of the value is not 10, use a scaled divide operation
@@ -218,7 +218,7 @@ package body System.Value_D is
-- Perform a scaled divide operation with rounding to match 'Image
- Scaled_Divide (Unsigned_To_Signed (V), Y, Z, Q, R, Round => True);
+ Scaled_Divide (To_Signed (V), Y, Z, Q, R, Round => True);
return Q;
end;
@@ -238,17 +238,17 @@ package body System.Value_D is
Max : Integer;
Scale : Integer) return Int
is
- Base : Unsigned;
- Scl : Impl.Scale_Array;
- Extra : Unsigned;
- Minus : Boolean;
- Val : Impl.Value_Array;
+ Base : Unsigned;
+ Scl : Impl.Scale_Array;
+ Extra2 : Unsigned;
+ Minus : Boolean;
+ Val : Impl.Value_Array;
begin
- Val := Impl.Scan_Raw_Real (Str, Ptr, Max, Base, Scl, Extra, Minus);
+ Val := Impl.Scan_Raw_Real (Str, Ptr, Max, Base, Scl, Extra2, Minus);
return
- Integer_to_Decimal (Str, Val (1), Base, Scl (1), Extra, Minus, Scale);
+ Integer_to_Decimal (Str, Val (1), Base, Scl (1), Extra2, Minus, Scale);
end Scan_Decimal;
-------------------
@@ -256,17 +256,17 @@ package body System.Value_D is
-------------------
function Value_Decimal (Str : String; Scale : Integer) return Int is
- Base : Unsigned;
- Scl : Impl.Scale_Array;
- Extra : Unsigned;
- Minus : Boolean;
- Val : Impl.Value_Array;
+ Base : Unsigned;
+ Scl : Impl.Scale_Array;
+ Extra2 : Unsigned;
+ Minus : Boolean;
+ Val : Impl.Value_Array;
begin
- Val := Impl.Value_Raw_Real (Str, Base, Scl, Extra, Minus);
+ Val := Impl.Value_Raw_Real (Str, Base, Scl, Extra2, Minus);
return
- Integer_to_Decimal (Str, Val (1), Base, Scl (1), Extra, Minus, Scale);
+ Integer_to_Decimal (Str, Val (1), Base, Scl (1), Extra2, 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 7baa3b31ff4..03821aa4c1f 100644
--- a/gcc/ada/libgnat/s-valuef.adb
+++ b/gcc/ada/libgnat/s-valuef.adb
@@ -46,15 +46,15 @@ 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, 1, 2**(Int'Size - 1), Round => True);
- -- We use the Extra digit for ordinary fixed-point types
+ package Impl is new Value_R (Uns, 1, 2**(Int'Size - 1));
+ -- We use the Extra digits for ordinary fixed-point types
function Integer_To_Fixed
(Str : String;
Val : Uns;
Base : Unsigned;
ScaleB : Integer;
- Extra : Unsigned;
+ Extra2 : Unsigned;
Minus : Boolean;
Num : Int;
Den : Int) return Int;
@@ -79,23 +79,23 @@ package body System.Value_F is
-- Of course N1 = N2 + 1 holds, which means both that Val may not contain
-- enough significant bits to represent all the values of the type and that
- -- 1 extra decimal digit contains the information for the missing bits.
+ -- 1 extra decimal digit contains the information for the missing bits. But
+ -- in practice we need 2 extra decimal digits to avoid multiple roundings.
-- Therefore the actual computation to be performed is
- -- V = (Val * Base + Extra) * (Base ** (ScaleB - 1)) / (Num / Den)
+ -- V = (Val * Base ** 2 + Extra2) * (Base ** (ScaleB - 2)) / (Num / Den)
- -- using two steps of scaled divide if Extra is positive and ScaleB too
+ -- using two steps of scaled divide if Extra2 is positive and ScaleB too
- -- (1) Val * (Den * (Base ** ScaleB)) = Q1 * Num + R1
+ -- (1a) Val * (Den * (Base ** ScaleB)) = Q1 * Num + R1
- -- (2) Extra * (Den * (Base ** ScaleB)) = Q2 * -Base + R2
+ -- (2a) Extra2 * (Den * (Base ** ScaleB)) = Q2 * Base ** 2 + R2
- -- which yields after dividing (1) by Num and (2) by Num * Base and summing
+ -- which yields after dividing (1a) by Num and (2a) by Num * (Base ** 2)
+ -- and summing
- -- V = Q1 + (R1 - Q2) / Num + R2 / (Num * Base)
-
- -- but we get rid of the third term by using a rounding divide for (2).
+ -- V = Q1 + (Q2 + R1) / Num + R2 / (Num * (Base ** 2))
-- This works only if Den * (Base ** ScaleB) does not overflow for inputs
-- corresponding to 'Image. Let S = Num / Den, B = Base and N the scale in
@@ -113,19 +113,17 @@ package body System.Value_F is
-- which means that the product does not overflow if Num <= 2**(M-1) / B.
- -- On the other hand, if Extra is positive and ScaleB negative, the above
+ -- On the other hand, if Extra2 is positive and ScaleB negative, the above
-- two steps are
-- (1b) Val * Den = Q1 * (Num * (Base ** -ScaleB)) + R1
- -- (2b) Extra * Den = Q2 * -Base + R2
+ -- (2b) Extra2 * Den = Q2 * Base ** 2 + R2
-- which yields after dividing (1b) by Num * (Base ** -ScaleB) and (2b) by
- -- Num * (Base ** (1 - ScaleB)) and summing
+ -- Num * (Base ** (2 - ScaleB)) and summing
- -- V = Q1 + (R1 - Q2) / (Num * (Base ** -ScaleB)) + R2 / ...
-
- -- but we get rid of the third term by using a rounding divide for (2b).
+ -- V = Q1 + (Q2 + R1) / (Num * (Base ** -ScaleB)) + R2 / (Num * (...))
-- This works only if Num * (Base ** -ScaleB) does not overflow for inputs
-- corresponding to 'Image. With the determination of ScaleB above, we have
@@ -143,15 +141,15 @@ package body System.Value_F is
Val : Uns;
Base : Unsigned;
ScaleB : Integer;
- Extra : Unsigned;
+ Extra2 : Unsigned;
Minus : Boolean;
Num : Int;
Den : Int) return Int
is
pragma Assert (Base in 2 .. 16);
- pragma Assert (Extra < Base);
- -- Accept only one extra digit after those used for Val
+ pragma Assert (Extra2 < Base ** 2);
+ -- Accept only two extra digits after those used for Val
pragma Assert (Num < 0 and then Den < 0);
-- Accept only negative numbers to allow -2**(Int'Size - 1)
@@ -169,7 +167,7 @@ package body System.Value_F is
-- updated to contain the remaining power in the computation. Note that
-- Factor is expected to be negative in this context.
- function Unsigned_To_Signed (Val : Uns) return Int;
+ function To_Signed (Val : Uns) return Int;
-- Convert an integer value from unsigned to signed representation
-----------------
@@ -196,11 +194,11 @@ package body System.Value_F is
return Result;
end Safe_Expont;
- ------------------------
- -- Unsigned_To_Signed --
- ------------------------
+ ---------------
+ -- To_Signed --
+ ---------------
- function Unsigned_To_Signed (Val : Uns) return Int is
+ function To_Signed (Val : Uns) return Int is
begin
-- Deal with overflow cases, and also with largest negative number
@@ -221,15 +219,15 @@ package body System.Value_F is
else
return Int (Val);
end if;
- end Unsigned_To_Signed;
+ end To_Signed;
-- Local variables
B : constant Int := Int (Base);
- V : Uns := Val;
- S : Integer := ScaleB;
- E : Uns := Uns (Extra);
+ V : Uns := Val;
+ S : Integer := ScaleB;
+ E : Unsigned := Extra2;
Y, Z, Q1, R1, Q2, R2 : Int;
@@ -238,7 +236,7 @@ package body System.Value_F is
-- but here we cannot handle 2**(Int'Size - 1) if Minus is not set.
if V = 2**(Int'Size - 1) and then not Minus then
- E := V rem Uns (B);
+ E := Unsigned (V rem Uns (B)) * Base + E / Base;
V := V / Uns (B);
S := S + 1;
end if;
@@ -248,7 +246,7 @@ package body System.Value_F is
-- raised during the computation. The only real concern is the exponent.
-- If S is too negative, then drop trailing digits, but preserve the
- -- last dropped digit, until V saturates to 0.
+ -- last two dropped digits, until V saturates to 0.
if S < 0 then
declare
@@ -263,7 +261,7 @@ package body System.Value_F is
E := 0;
exit;
end if;
- E := V rem Uns (B);
+ E := Unsigned (V rem Uns (B)) * Base + E / Base;
V := V / Uns (B);
end loop;
end;
@@ -279,9 +277,9 @@ package body System.Value_F is
Z := Num;
for J in 1 .. LS loop
- if V <= (Uns'Last - E) / Uns (B) then
- V := V * Uns (B) + E;
- E := 0;
+ if V <= (Uns'Last - Uns (E / Base)) / Uns (B) then
+ V := V * Uns (B) + Uns (E / Base);
+ E := (E rem Base) * Base;
else
Bad_Value (Str);
end if;
@@ -301,8 +299,8 @@ package body System.Value_F is
-- sign of the first operand and the sign of the remainder the opposite.
if E > 0 then
- Scaled_Divide (Unsigned_To_Signed (V), Y, Z, Q1, R1, Round => False);
- Scaled_Divide (Unsigned_To_Signed (E), Y, -B, Q2, R2, Round => True);
+ Scaled_Divide (To_Signed (V), Y, Z, Q1, R1, Round => False);
+ Scaled_Divide (To_Signed (Uns (E)), Y, -B**2, Q2, R2, Round => False);
-- Avoid an overflow during the subtraction. Note that Q2 is smaller
-- than Y and R1 smaller than Z in magnitude, so it is safe to take
@@ -329,7 +327,7 @@ package body System.Value_F is
return Q1 + Q2;
else
- Scaled_Divide (Unsigned_To_Signed (V), Y, Z, Q1, R1, Round => True);
+ Scaled_Divide (To_Signed (V), Y, Z, Q1, R1, Round => True);
return Q1;
end if;
@@ -349,17 +347,17 @@ package body System.Value_F is
Num : Int;
Den : Int) return Int
is
- Base : Unsigned;
- Scl : Impl.Scale_Array;
- Extra : Unsigned;
- Minus : Boolean;
- Val : Impl.Value_Array;
+ Bas : Unsigned;
+ Scl : Impl.Scale_Array;
+ Extra2 : Unsigned;
+ Minus : Boolean;
+ Val : Impl.Value_Array;
begin
- Val := Impl.Scan_Raw_Real (Str, Ptr, Max, Base, Scl, Extra, Minus);
+ Val := Impl.Scan_Raw_Real (Str, Ptr, Max, Bas, Scl, Extra2, Minus);
return
- Integer_To_Fixed (Str, Val (1), Base, Scl (1), Extra, Minus, Num, Den);
+ Integer_To_Fixed (Str, Val (1), Bas, Scl (1), Extra2, Minus, Num, Den);
end Scan_Fixed;
-----------------
@@ -371,17 +369,17 @@ package body System.Value_F is
Num : Int;
Den : Int) return Int
is
- Base : Unsigned;
- Scl : Impl.Scale_Array;
- Extra : Unsigned;
- Minus : Boolean;
- Val : Impl.Value_Array;
+ Bas : Unsigned;
+ Scl : Impl.Scale_Array;
+ Extra2 : Unsigned;
+ Minus : Boolean;
+ Val : Impl.Value_Array;
begin
- Val := Impl.Value_Raw_Real (Str, Base, Scl, Extra, Minus);
+ Val := Impl.Value_Raw_Real (Str, Bas, Scl, Extra2, Minus);
return
- Integer_To_Fixed (Str, Val (1), Base, Scl (1), Extra, Minus, Num, Den);
+ Integer_To_Fixed (Str, Val (1), Bas, Scl (1), Extra2, 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 25f54079bfe..b8073c060b4 100644
--- a/gcc/ada/libgnat/s-valuer.adb
+++ b/gcc/ada/libgnat/s-valuer.adb
@@ -42,14 +42,6 @@ package body System.Value_R is
function As_Digit (C : Character) return Char_As_Digit;
-- Given a character return the digit it represents
- procedure Round_Extra
- (Digit : Char_As_Digit;
- Base : Unsigned;
- Value : in out Uns;
- Scale : in out Integer;
- 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;
@@ -59,7 +51,7 @@ package body System.Value_R is
Value : in out Value_Array;
Scale : in out Scale_Array;
N : in out Positive;
- Extra : in out Char_As_Digit;
+ Extra2 : in out Unsigned;
Base_Violation : in out Boolean);
-- Scan the decimal part of a real (i.e. after decimal separator)
--
@@ -68,7 +60,8 @@ package body System.Value_R is
--
-- For each digit parsed, Value = Value * Base + Digit and Scale is
-- decremented by 1. If precision limit is reached, remaining digits are
- -- still parsed but ignored, except for the first which is stored in Extra.
+ -- still parsed but ignored, except for the first two of them which are
+ -- stored in Extra2.
--
-- Base_Violation is set to True if a digit found is not part of the Base
--
@@ -83,8 +76,8 @@ package body System.Value_R is
Value : out Value_Array;
Scale : out Scale_Array;
N : out Positive;
- Extra : out Char_As_Digit;
- Extra_Rounded : out Boolean;
+ Extra2 : out Unsigned;
+ Extra2_Filled : out Boolean;
Base_Violation : in out Boolean);
-- Scan the integral part of a real (i.e. before decimal separator)
--
@@ -94,7 +87,7 @@ package body System.Value_R is
-- For each digit parsed, either Value := Value * Base + Digit or Scale
-- is incremented by 1 if precision limit is reached, in which case the
-- remaining digits are still parsed but ignored, except for the first
- -- which is stored in Extra, rounded if Extra_Rounded is True.
+ -- two of them which are stored in Extra2 if Extra2_Filled is True.
--
-- Base_Violation is set to True if a digit found is not part of the Base
--
@@ -120,49 +113,6 @@ package body System.Value_R is
end case;
end As_Digit;
- -----------------
- -- Round_Extra --
- -----------------
-
- procedure Round_Extra
- (Digit : Char_As_Digit;
- Base : Unsigned;
- Value : in out Uns;
- Scale : in out Integer;
- Extra : in out Char_As_Digit)
- is
- pragma Assert (Base in 2 .. 16);
-
- B : constant Uns := Uns (Base);
-
- begin
- -- Beware that Base may be odd
-
- if 2 * Unsigned (Digit) >= Base then
-
- -- If Extra is maximum, round Value
-
- if Extra = Base - 1 then
-
- -- If Value is maximum, scale it up
-
- if Value = Precision_Limit then
- Extra := Char_As_Digit (Value mod B);
- Value := Value / B;
- Scale := Scale + 1;
- Round_Extra (Digit, Base, Value, Scale, Extra);
-
- else
- Extra := 0;
- Value := Value + 1;
- end if;
-
- else
- Extra := Extra + 1;
- end if;
- end if;
- end Round_Extra;
-
-------------------------
-- Scan_Decimal_Digits --
-------------------------
@@ -176,7 +126,7 @@ package body System.Value_R is
Value : in out Value_Array;
Scale : in out Scale_Array;
N : in out Positive;
- Extra : in out Char_As_Digit;
+ Extra2 : in out Unsigned;
Base_Violation : in out Boolean)
is
@@ -195,8 +145,7 @@ package body System.Value_R is
-- to Precision_Limit.
Precision_Limit_Just_Reached : Boolean;
- -- Set to True if Precision_Limit_Reached was just set to True, but only
- -- used when Round is True.
+ -- Set to True if Precision_Limit_Reached was just set to True
Digit : Char_As_Digit;
-- The current digit
@@ -213,17 +162,12 @@ package body System.Value_R is
if Scale (Data_Index'Last) > 0 then
Precision_Limit_Reached := True;
+ Precision_Limit_Just_Reached := True;
- if Round then
- Precision_Limit_Just_Reached := True;
- end if;
else
- Extra := 0;
+ Extra2 := 0;
Precision_Limit_Reached := False;
-
- if Round then
- Precision_Limit_Just_Reached := False;
- end if;
+ Precision_Limit_Just_Reached := False;
end if;
-- Initialize trailing zero counter
@@ -251,12 +195,12 @@ package body System.Value_R is
-- If precision limit has been reached, just ignore any remaining
-- digits for the computation of Value and Scale, but store the
- -- first in Extra and use the second to round Extra. The scanning
- -- should continue only to assess the validity of the string.
+ -- first two digits in Extra2. The scanning should continue only
+ -- to assess the validity of the string.
if Precision_Limit_Reached then
- if Round and then Precision_Limit_Just_Reached then
- Round_Extra (Digit, Base, Value (N), Scale (N), Extra);
+ if Precision_Limit_Just_Reached then
+ Extra2 := Extra2 + Digit;
Precision_Limit_Just_Reached := False;
end if;
@@ -279,11 +223,8 @@ package body System.Value_R is
Scale (N) := Scale (N - 1) - 1;
else
- Extra := 0;
+ Extra2 := (if J = Trailing_Zeros then Digit else 0);
Precision_Limit_Reached := True;
- if Round and then J = Trailing_Zeros then
- Round_Extra (Digit, Base, Value (N), Scale (N), Extra);
- end if;
exit;
end if;
@@ -322,11 +263,9 @@ package body System.Value_R is
Scale (N) := Scale (N - 1) - 1;
else
- Extra := Digit;
+ Extra2 := Digit * Base;
Precision_Limit_Reached := True;
- if Round then
- Precision_Limit_Just_Reached := True;
- end if;
+ Precision_Limit_Just_Reached := True;
end if;
end if;
end if;
@@ -376,8 +315,8 @@ package body System.Value_R is
Value : out Value_Array;
Scale : out Scale_Array;
N : out Positive;
- Extra : out Char_As_Digit;
- Extra_Rounded : out Boolean;
+ Extra2 : out Unsigned;
+ Extra2_Filled : out Boolean;
Base_Violation : in out Boolean)
is
pragma Assert (Base in 2 .. 16);
@@ -393,8 +332,7 @@ package body System.Value_R is
-- to Precision_Limit.
Precision_Limit_Just_Reached : Boolean;
- -- Set to True if Precision_Limit_Reached was just set to True, but only
- -- used when Round is True.
+ -- Set to True if Precision_Limit_Reached was just set to True
Digit : Char_As_Digit;
-- The current digit
@@ -403,19 +341,16 @@ package body System.Value_R is
-- Temporary
begin
- -- Initialize N, Value, Scale, Extra and Extra_Rounded
+ -- Initialize N, Value, Scale, Extra2 and Extra2_Filled
N := 1;
Value := (others => 0);
Scale := (others => 0);
- Extra := 0;
- Extra_Rounded := False;
+ Extra2 := 0;
+ Extra2_Filled := False;
Precision_Limit_Reached := False;
-
- if Round then
- Precision_Limit_Just_Reached := False;
- end if;
+ Precision_Limit_Just_Reached := False;
pragma Assert (Max <= Str'Last);
@@ -440,15 +375,15 @@ package body System.Value_R is
-- If precision limit has been reached, just ignore any remaining
-- digits for the computation of Value and Scale, but store the
- -- first in Extra and use the second to round Extra. The scanning
- -- should continue only to assess the validity of the string.
+ -- first two digits in Extra2. The scanning should continue only
+ -- to assess the validity of the string.
if Precision_Limit_Reached then
Scale (N) := Scale (N) + 1;
- if Round and then Precision_Limit_Just_Reached then
- Round_Extra (Digit, Base, Value (N), Scale (N), Extra);
- Extra_Rounded := True;
+ if Precision_Limit_Just_Reached then
+ Extra2 := Extra2 + Digit;
+ Extra2_Filled := True;
Precision_Limit_Just_Reached := False;
end if;
@@ -473,11 +408,9 @@ package body System.Value_R is
Value (N) := Uns (Digit);
else
- Extra := Digit;
+ Extra2 := Digit * Base;
Precision_Limit_Reached := True;
- if Round then
- Precision_Limit_Just_Reached := True;
- end if;
+ Precision_Limit_Just_Reached := True;
Scale (N) := Scale (N) + 1;
end if;
end if;
@@ -521,13 +454,13 @@ package body System.Value_R is
-------------------
function Scan_Raw_Real
- (Str : String;
- Ptr : not null access Integer;
- Max : Integer;
- Base : out Unsigned;
- Scale : out Scale_Array;
- Extra : out Unsigned;
- Minus : out Boolean) return Value_Array
+ (Str : String;
+ Ptr : not null access Integer;
+ Max : Integer;
+ Base : out Unsigned;
+ Scale : out Scale_Array;
+ Extra2 : out Unsigned;
+ Minus : out Boolean) return Value_Array
is
pragma Assert (Max <= Str'Last);
@@ -542,8 +475,8 @@ 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.
- Extra_Rounded : Boolean;
- -- True if Extra has been rounded
+ Extra2_Filled : Boolean;
+ -- True if Extra2 has been filled
N : Positive;
-- Index number of the current part
@@ -594,7 +527,7 @@ package body System.Value_R is
Scan_Integral_Digits
(Str, Index, Max, Base, False, Value, Scale, N,
- Char_As_Digit (Extra), Extra_Rounded, Base_Violation);
+ Extra2, Extra2_Filled, Base_Violation);
-- A dot is allowed only if followed by a digit (RM 3.5(39.8))
@@ -607,8 +540,8 @@ package body System.Value_R is
N := 1;
Value := (others => 0);
Scale := (others => 0);
- Extra := 0;
- Extra_Rounded := False;
+ Extra2 := 0;
+ Extra2_Filled := False;
else
Bad_Value (Str);
@@ -658,7 +591,7 @@ package body System.Value_R is
Scan_Integral_Digits
(Str, Index, Max, Base, Base_Char /= ASCII.NUL, Value, Scale,
- N, Char_As_Digit (Extra), Extra_Rounded, Base_Violation);
+ N, Extra2, Extra2_Filled, Base_Violation);
end if;
-- Do we have a dot?
@@ -683,9 +616,9 @@ package body System.Value_R is
if After_Point then
pragma Assert (Index <= Max);
- -- If Extra has been rounded, we are done with it
+ -- If Extra2 has been filled, we are done with it
- if Extra_Rounded then
+ if Extra2_Filled then
declare
Dummy : Unsigned := 0;
begin
@@ -697,7 +630,7 @@ package body System.Value_R is
else
Scan_Decimal_Digits
(Str, Index, Max, Base, Base_Char /= ASCII.NUL, Value, Scale,
- N, Char_As_Digit (Extra), Base_Violation);
+ N, Extra2, Base_Violation);
end if;
end if;
@@ -746,11 +679,11 @@ package body System.Value_R is
--------------------
function Value_Raw_Real
- (Str : String;
- Base : out Unsigned;
- Scale : out Scale_Array;
- Extra : out Unsigned;
- Minus : out Boolean) return Value_Array
+ (Str : String;
+ Base : out Unsigned;
+ Scale : out Scale_Array;
+ Extra2 : out Unsigned;
+ Minus : out Boolean) return Value_Array
is
P : aliased Integer;
V : Value_Array;
@@ -764,14 +697,14 @@ package body System.Value_R is
declare
subtype NT is String (1 .. Str'Length);
begin
- return Value_Raw_Real (NT (Str), Base, Scale, Extra, Minus);
+ return Value_Raw_Real (NT (Str), Base, Scale, Extra2, Minus);
end;
end if;
-- Normal case
P := Str'First;
- V := Scan_Raw_Real (Str, P'Access, Str'Last, Base, Scale, Extra, Minus);
+ V := Scan_Raw_Real (Str, P'Access, Str'Last, Base, Scale, Extra2, Minus);
Scan_Trailing_Blanks (Str, P);
return V;
diff --git a/gcc/ada/libgnat/s-valuer.ads b/gcc/ada/libgnat/s-valuer.ads
index bc5a2e0954a..e48241eba57 100644
--- a/gcc/ada/libgnat/s-valuer.ads
+++ b/gcc/ada/libgnat/s-valuer.ads
@@ -45,9 +45,6 @@ generic
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;
@@ -61,13 +58,13 @@ package System.Value_R is
-- The value split into parts
function Scan_Raw_Real
- (Str : String;
- Ptr : not null access Integer;
- Max : Integer;
- Base : out Unsigned;
- Scale : out Scale_Array;
- Extra : out Unsigned;
- Minus : out Boolean) return Value_Array;
+ (Str : String;
+ Ptr : not null access Integer;
+ Max : Integer;
+ Base : out Unsigned;
+ Scale : out Scale_Array;
+ Extra2 : out Unsigned;
+ 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
@@ -75,11 +72,11 @@ package System.Value_R is
--
-- If a valid real is found after scanning past any initial spaces, then
-- Ptr.all is updated past the last character of the real (but trailing
- -- spaces are not scanned out) and the Base, Scale, Extra and Minus out
+ -- spaces are not scanned out) and the Base, Scale, Extra2 and Minus out
-- parameters are set; if Val is the result of the call, then the real
-- represented by the literal is equal to
--
- -- (Val (1) * Base + Extra) * (Base ** (Scale (1) - 1))
+ -- (Val (1) * Base ** 2 + Extra2) * (Base ** (Scale (1) - 2))
--
-- when Parts = 1 and
--
@@ -109,11 +106,11 @@ package System.Value_R is
-- case is not supported. Most such cases are eliminated by the caller.
function Value_Raw_Real
- (Str : String;
- Base : out Unsigned;
- Scale : out Scale_Array;
- Extra : out Unsigned;
- Minus : out Boolean) return Value_Array;
+ (Str : String;
+ Base : out Unsigned;
+ Scale : out Scale_Array;
+ Extra2 : out Unsigned;
+ 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.
--
2.43.0
