Skip to content

R
riscv-gcc-1
Commit 1937a0c4 by Geert Bosch Committed by Arnaud Charlet
Options

eval_fat.adb (Decompose_Int): Handle argument of zero. 

2007-12-06  Geert Bosch  <bosch@adacore.com>

	* eval_fat.adb (Decompose_Int): Handle argument of zero.
	(Compose): Remove special casing of zero.
	(Exponent): Likewise.
	(Fraction): Likewise.
	(Machine): Likewise.
	(Decompose): Update comment.

From-SVN: r130827
parent 987c5cec
Showing with 128 additions and 147 deletions
gcc/ada/eval_fat.adb
......@@ -32,13 +32,13 @@ with Targparm; use Targparm;
package body Eval_Fat is
Radix : constant Int := 2;
-- This code is currently only correct for the radix 2 case. We use
-- the symbolic value Radix where possible to help in the unlikely
-- case of anyone ever having to adjust this code for another value,
-- and for documentation purposes.
-- This code is currently only correct for the radix 2 case. We use the
-- symbolic value Radix where possible to help in the unlikely case of
-- anyone ever having to adjust this code for another value, and for
-- documentation purposes.
-- Another assumption is that the range of the floating-point type
-- is symmetric around zero.
-- Another assumption is that the range of the floating-point type is
-- symmetric around zero.
type Radix_Power_Table is array (Int range 1 .. 4) of Int;
......@@ -55,10 +55,9 @@ package body Eval_Fat is
Fraction : out T;
Exponent : out UI;
Mode : Rounding_Mode := Round);
-- Decomposes a non-zero floating-point number into fraction and
-- exponent parts. The fraction is in the interval 1.0 / Radix ..
-- T'Pred (1.0) and uses Rbase = Radix.
-- The result is rounded to a nearest machine number.
-- Decomposes a non-zero floating-point number into fraction and exponent
-- parts. The fraction is in the interval 1.0 / Radix .. T'Pred (1.0) and
-- uses Rbase = Radix. The result is rounded to a nearest machine number.
procedure Decompose_Int
(RT : R;
......@@ -116,12 +115,8 @@ package body Eval_Fat is
Arg_Exp : UI;
pragma Warnings (Off, Arg_Exp);
begin
if UR_Is_Zero (Fraction) then
return Fraction;
else
Decompose (RT, Fraction, Arg_Frac, Arg_Exp);
return Scaling (RT, Arg_Frac, Exponent);
end if;
Decompose (RT, Fraction, Arg_Frac, Arg_Exp);
return Scaling (RT, Arg_Frac, Exponent);
end Compose;
---------------
......@@ -175,10 +170,10 @@ package body Eval_Fat is
-- Decompose_Int --
-------------------
-- This procedure should be modified with care, as there are many
-- non-obvious details that may cause problems that are hard to
-- detect. The cases of positive and negative zeroes are also
-- special and should be verified separately.
-- This procedure should be modified with care, as there are many non-
-- obvious details that may cause problems that are hard to detect. For
-- zero arguments, Fraction and Exponent are set to zero. Note that sign
-- of zero cannot be preserved.
procedure Decompose_Int
(RT : R;
......@@ -204,13 +199,19 @@ package body Eval_Fat is
-- intermediate values (this routine generates lots of junk!)
begin
if N = Uint_0 then
Fraction := Uint_0;
Exponent := Uint_0;
return;
end if;
Calculate_D_And_Exponent_1 : begin
Uintp_Mark := Mark;
Exponent := Uint_0;
-- In cases where Base > 1, the actual denominator is
-- Base**D. For cases where Base is a power of Radix, use
-- the value 1 for the Denominator and adjust the exponent.
-- In cases where Base > 1, the actual denominator is Base**D. For
-- cases where Base is a power of Radix, use the value 1 for the
-- Denominator and adjust the exponent.
-- Note: Exponent has different sign from D, because D is a divisor
......@@ -230,13 +231,13 @@ package body Eval_Fat is
Calculate_Exponent : begin
Uintp_Mark := Mark;
-- For bases that are a multiple of the Radix, divide
-- the base by Radix and adjust the Exponent. This will
-- help because D will be much smaller and faster to process.
-- For bases that are a multiple of the Radix, divide the base by
-- Radix and adjust the Exponent. This will help because D will be
-- much smaller and faster to process.
-- This occurs for decimal bases on a machine with binary
-- floating-point for example. When calculating 1E40,
-- with Radix = 2, N will be 93 bits instead of 133.
-- This occurs for decimal bases on machines with binary floating-
-- point for example. When calculating 1E40, with Radix = 2, N
-- will be 93 bits instead of 133.
-- N E
-- ------ * Radix
......@@ -264,11 +265,10 @@ package body Eval_Fat is
Release_And_Save (Uintp_Mark, Exponent);
end Calculate_Exponent;
-- For remaining bases we must actually compute
-- the exponentiation.
-- For remaining bases we must actually compute the exponentiation
-- Because the exponentiation can be negative, and D must
-- be integer, the numerator is corrected instead.
-- Because the exponentiation can be negative, and D must be integer,
-- the numerator is corrected instead.
Calculate_N_And_D : begin
Uintp_Mark := Mark;
......@@ -286,29 +286,25 @@ package body Eval_Fat is
Base := 0;
end if;
-- Now scale N and D so that N / D is a value in the
-- interval [1.0 / Radix, 1.0) and adjust Exponent accordingly,
-- so the value N / D * Radix ** Exponent remains unchanged.
-- Now scale N and D so that N / D is a value in the interval [1.0 /
-- Radix, 1.0) and adjust Exponent accordingly, so the value N / D *
-- Radix ** Exponent remains unchanged.
-- Step 1 - Adjust N so N / D >= 1 / Radix, or N = 0
-- N and D are positive, so N / D >= 1 / Radix implies N * Radix >= D.
-- This scaling is not possible for N is Uint_0 as there
-- is no way to scale Uint_0 so the first digit is non-zero.
-- As this scaling is not possible for N is Uint_0, zero is handled
-- explicitly at the start of this subprogram.
Calculate_N_And_Exponent : begin
Uintp_Mark := Mark;
N_Times_Radix := N * Radix;
if N /= Uint_0 then
while not (N_Times_Radix >= D) loop
N := N_Times_Radix;
Exponent := Exponent - 1;
N_Times_Radix := N * Radix;
end loop;
end if;
while not (N_Times_Radix >= D) loop
N := N_Times_Radix;
Exponent := Exponent - 1;
N_Times_Radix := N * Radix;
end loop;
Release_And_Save (Uintp_Mark, N, Exponent);
end Calculate_N_And_Exponent;
......@@ -322,8 +318,8 @@ package body Eval_Fat is
while not (N < D) loop
-- As N / D >= 1, N / (D * Radix) will be at least 1 / Radix,
-- so the result of Step 1 stays valid
-- As N / D >= 1, N / (D * Radix) will be at least 1 / Radix, so
-- the result of Step 1 stays valid
D := D * Radix;
Exponent := Exponent + 1;
......@@ -334,14 +330,14 @@ package body Eval_Fat is
-- Here the value N / D is in the range [1.0 / Radix .. 1.0)
-- Now find the fraction by doing a very simple-minded
-- division until enough digits have been computed.
-- Now find the fraction by doing a very simple-minded division until
-- enough digits have been computed.
-- This division works for all radices, but is only efficient for
-- a binary radix. It is just like a manual division algorithm,
-- but instead of moving the denominator one digit right, we move
-- the numerator one digit left so the numerator and denominator
-- remain integral.
-- This division works for all radices, but is only efficient for a
-- binary radix. It is just like a manual division algorithm, but
-- instead of moving the denominator one digit right, we move the
-- numerator one digit left so the numerator and denominator remain
-- integral.
Fraction := Uint_0;
Even := True;
......@@ -380,8 +376,8 @@ package body Eval_Fat is
when Round_Even =>
-- This rounding mode should not be used for static
-- expressions, but only for compile-time evaluation
-- of non-static expressions.
-- expressions, but only for compile-time evaluation of
-- non-static expressions.
if (Even and then N * 2 > D)
or else
......@@ -392,9 +388,9 @@ package body Eval_Fat is
when Round =>
-- Do not round to even as is done with IEEE arithmetic,
-- but instead round away from zero when the result is
-- exactly between two machine numbers. See RM 4.9(38).
-- Do not round to even as is done with IEEE arithmetic, but
-- instead round away from zero when the result is exactly
-- between two machine numbers. See RM 4.9(38).
if N * 2 >= D then
Fraction := Fraction + 1;
......@@ -411,8 +407,8 @@ package body Eval_Fat is
end if;
end case;
-- The result must be normalized to [1.0/Radix, 1.0),
-- so adjust if the result is 1.0 because of rounding.
-- The result must be normalized to [1.0/Radix, 1.0), so adjust if
-- the result is 1.0 because of rounding.
if Fraction = Most_Significant_Digit * Radix then
Fraction := Most_Significant_Digit;
......@@ -438,12 +434,8 @@ package body Eval_Fat is
X_Exp : UI;
pragma Warnings (Off, X_Frac);
begin
if UR_Is_Zero (X) then
return Uint_0;
else
Decompose_Int (RT, X, X_Frac, X_Exp, Round_Even);
return X_Exp;
end if;
Decompose_Int (RT, X, X_Frac, X_Exp, Round_Even);
return X_Exp;
end Exponent;
-----------
......@@ -474,12 +466,8 @@ package body Eval_Fat is
X_Exp : UI;
pragma Warnings (Off, X_Exp);
begin
if UR_Is_Zero (X) then
return X;
else
Decompose (RT, X, X_Frac, X_Exp);
return X_Frac;
end if;
Decompose (RT, X, X_Frac, X_Exp);
return X_Frac;
end Fraction;
------------------
......@@ -511,81 +499,74 @@ package body Eval_Fat is
Emin : constant UI := UI_From_Int (Machine_Emin (RT));
begin
if UR_Is_Zero (X) then
return X;
Decompose (RT, X, X_Frac, X_Exp, Mode);
-- Case of denormalized number or (gradual) underflow
-- A denormalized number is one with the minimum exponent Emin, but that
-- breaks the assumption that the first digit of the mantissa is a one.
-- This allows the first non-zero digit to be in any of the remaining
-- Mant - 1 spots. The gap between subsequent denormalized numbers is
-- the same as for the smallest normalized numbers. However, the number
-- of significant digits left decreases as a result of the mantissa now
-- having leading seros.
if X_Exp < Emin then
declare
Emin_Den : constant UI :=
UI_From_Int
(Machine_Emin (RT) - Machine_Mantissa (RT) + 1);
begin
if X_Exp < Emin_Den or not Denorm_On_Target then
if UR_Is_Negative (X) then
Error_Msg_N
("floating-point value underflows to -0.0?", Enode);
return Ureal_M_0;
else
Error_Msg_N
("floating-point value underflows to 0.0?", Enode);
return Ureal_0;
end if;
else
Decompose (RT, X, X_Frac, X_Exp, Mode);
-- Case of denormalized number or (gradual) underflow
-- A denormalized number is one with the minimum exponent Emin, but
-- that breaks the assumption that the first digit of the mantissa
-- is a one. This allows the first non-zero digit to be in any
-- of the remaining Mant - 1 spots. The gap between subsequent
-- denormalized numbers is the same as for the smallest normalized
-- numbers. However, the number of significant digits left decreases
-- as a result of the mantissa now having leading seros.
if X_Exp < Emin then
declare
Emin_Den : constant UI :=
UI_From_Int
(Machine_Emin (RT) - Machine_Mantissa (RT) + 1);
begin
if X_Exp < Emin_Den or not Denorm_On_Target then
if UR_Is_Negative (X) then
Error_Msg_N
("floating-point value underflows to -0.0?", Enode);
return Ureal_M_0;
elsif Denorm_On_Target then
else
Error_Msg_N
("floating-point value underflows to 0.0?", Enode);
return Ureal_0;
end if;
-- Emin - Mant <= X_Exp < Emin, so result is denormal. Handle
-- gradual underflow by first computing the number of
-- significant bits still available for the mantissa and
-- then truncating the fraction to this number of bits.
elsif Denorm_On_Target then
-- Emin - Mant <= X_Exp < Emin, so result is denormal.
-- Handle gradual underflow by first computing the
-- number of significant bits still available for the
-- mantissa and then truncating the fraction to this
-- number of bits.
-- If this value is different from the original
-- fraction, precision is lost due to gradual underflow.
-- We probably should round here and prevent double
-- rounding as a result of first rounding to a model
-- number and then to a machine number. However, this
-- is an extremely rare case that is not worth the extra
-- complexity. In any case, a warning is issued in cases
-- where gradual underflow occurs.
declare
Denorm_Sig_Bits : constant UI := X_Exp - Emin_Den + 1;
X_Frac_Denorm : constant T := UR_From_Components
(UR_Trunc (Scaling (RT, abs X_Frac, Denorm_Sig_Bits)),
Denorm_Sig_Bits,
Radix,
UR_Is_Negative (X));
begin
if X_Frac_Denorm /= X_Frac then
Error_Msg_N
("gradual underflow causes loss of precision?",
Enode);
X_Frac := X_Frac_Denorm;
end if;
end;
end if;
end;
end if;
-- If this value is different from the original fraction,
-- precision is lost due to gradual underflow.
-- We probably should round here and prevent double rounding as
-- a result of first rounding to a model number and then to a
-- machine number. However, this is an extremely rare case that
-- is not worth the extra complexity. In any case, a warning is
-- issued in cases where gradual underflow occurs.
declare
Denorm_Sig_Bits : constant UI := X_Exp - Emin_Den + 1;
X_Frac_Denorm : constant T := UR_From_Components
(UR_Trunc (Scaling (RT, abs X_Frac, Denorm_Sig_Bits)),
Denorm_Sig_Bits,
Radix,
UR_Is_Negative (X));
return Scaling (RT, X_Frac, X_Exp);
begin
if X_Frac_Denorm /= X_Frac then
Error_Msg_N
("gradual underflow causes loss of precision?",
Enode);
X_Frac := X_Frac_Denorm;
end if;
end;
end if;
end;
end if;
return Scaling (RT, X_Frac, X_Exp);
end Machine;
------------------
......@@ -848,8 +829,8 @@ package body Eval_Fat is
Exp := Emin;
end if;
-- Set exponent such that the radix point will be directly
-- following the mantissa after scaling
-- Set exponent such that the radix point will be directly following the
-- mantissa after scaling.
if Denorm_On_Target or Exp /= Emin then
Exp := Exp - Mantissa;
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment