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