-- 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.
-
type Radix_Power_Table is array (Int range 1 .. 4) of Int;
Radix_Powers : constant Radix_Power_Table :=
(Radix ** 1, Radix ** 2, Radix ** 3, Radix ** 4);
+ function Float_Radix return T renames Ureal_2;
+ -- Radix expressed in real form
+
-----------------------
-- Local Subprograms --
-----------------------
-- even, a floor operation or a ceiling operation depending on the setting
-- of Mode (see corresponding descriptions in Urealp).
+ function Eps_Model (RT : R) return T;
+ -- Return the smallest model number of R.
+
+ function Eps_Denorm (RT : R) return T;
+ -- Return the smallest denormal of type R.
+
function Machine_Emin (RT : R) return Int;
-- Return value of the Machine_Emin attribute
begin
if Towards = X then
return X;
+
elsif Towards > X then
return Succ (RT, X);
+
else
return Pred (RT, X);
end if;
function Ceiling (RT : R; X : T) return T is
XT : constant T := Truncation (RT, X);
+
begin
if UR_Is_Negative (X) then
return XT;
+
elsif X = XT then
return X;
+
else
return XT + Ureal_1;
end if;
Calculate_Fraction_And_Exponent : begin
Uintp_Mark := Mark;
- -- Determine correct rounding based on the remainder which is in
- -- N and the divisor D. The rounding is performed on the absolute
- -- value of X, so Ceiling and Floor need to check for the sign of
- -- X explicitly.
+ -- Determine correct rounding based on the remainder
+ -- which is in N and the divisor D. The rounding is
+ -- performed on the absolute value of X, so Ceiling
+ -- and Floor need to check for the sign of X explicitly.
case Mode is
when Round_Even =>
end Calculate_Fraction_And_Exponent;
end Decompose_Int;
+ ----------------
+ -- Eps_Denorm --
+ ----------------
+
+ function Eps_Denorm (RT : R) return T is
+ begin
+ return Float_Radix ** UI_From_Int
+ (Machine_Emin (RT) - Machine_Mantissa (RT));
+ end Eps_Denorm;
+
+ ---------------
+ -- Eps_Model --
+ ---------------
+
+ function Eps_Model (RT : R) return T is
+ begin
+ return Float_Radix ** UI_From_Int (Machine_Emin (RT));
+ end Eps_Model;
+
--------------
-- Exponent --
--------------
----------
function Pred (RT : R; X : T) return T is
+ Result_F : UI;
+ Result_X : UI;
+
begin
- return -Succ (RT, -X);
+ if abs X < Eps_Model (RT) then
+ if Denorm_On_Target then
+ return X - Eps_Denorm (RT);
+
+ elsif X > Ureal_0 then
+
+ -- Target does not support denorms, so predecessor is 0.0
+
+ return Ureal_0;
+
+ else
+ -- Target does not support denorms, and X is 0.0
+ -- or at least bigger than -Eps_Model (RT)
+
+ return -Eps_Model (RT);
+ end if;
+
+ else
+ Decompose_Int (RT, X, Result_F, Result_X, Ceiling);
+ return UR_From_Components
+ (Num => Result_F - 1,
+ Den => Machine_Mantissa (RT) - Result_X,
+ Rbase => Radix,
+ Negative => False);
+ -- Result_F may be false, but this is OK as UR_From_Components
+ -- handles that situation.
+ end if;
end Pred;
---------------
----------
function Succ (RT : R; X : T) return T is
- Emin : constant UI := UI_From_Int (Machine_Emin (RT));
- Mantissa : constant UI := UI_From_Int (Machine_Mantissa (RT));
- Exp : UI := UI_Max (Emin, Exponent (RT, X));
- Frac : T;
- New_Frac : T;
+ Result_F : UI;
+ Result_X : UI;
begin
- if UR_Is_Zero (X) then
- Exp := Emin;
- end if;
+ if abs X < Eps_Model (RT) then
+ if Denorm_On_Target then
+ return X + Eps_Denorm (RT);
- -- Set exponent such that the radix point will be directly
- -- following the mantissa after scaling
+ elsif X < Ureal_0 then
+ -- Target does not support denorms, so successor is 0.0
+ return Ureal_0;
- if Denorm_On_Target or Exp /= Emin then
- Exp := Exp - Mantissa;
- else
- Exp := Exp - 1;
- end if;
-
- Frac := Scaling (RT, X, -Exp);
- New_Frac := Ceiling (RT, Frac);
-
- if New_Frac = Frac then
- if New_Frac = Scaling (RT, -Ureal_1, Mantissa - 1) then
- New_Frac := New_Frac + Scaling (RT, Ureal_1, Uint_Minus_1);
else
- New_Frac := New_Frac + Ureal_1;
+ -- Target does not support denorms, and X is 0.0
+ -- or at least smaller than Eps_Model (RT)
+
+ return Eps_Model (RT);
end if;
- end if;
- return Scaling (RT, New_Frac, Exp);
+ else
+ Decompose_Int (RT, X, Result_F, Result_X, Floor);
+ return UR_From_Components
+ (Num => Result_F + 1,
+ Den => Machine_Mantissa (RT) - Result_X,
+ Rbase => Radix,
+ Negative => False);
+ -- Result_F may be false, but this is OK as UR_From_Components
+ -- handles that situation.
+ end if;
end Succ;
----------------
function Truncation (RT : R; X : T) return T is
pragma Warnings (Off, RT);
+
begin
return UR_From_Uint (UR_Trunc (X));
end Truncation;
OSDN Git Service
