Num : Uint;
-- Numerator (always non-negative)
- Den : Uint;
+ Den : Uint;
-- Denominator (always non-zero, always positive if base is zero)
Rbase : Nat;
-- The following universal reals are the values returned by the constant
-- functions. They are initialized by the initialization procedure.
- UR_0 : Ureal;
- UR_M_0 : Ureal;
- UR_Tenth : Ureal;
- UR_Half : Ureal;
- UR_1 : Ureal;
- UR_2 : Ureal;
- UR_10 : Ureal;
- UR_10_36 : Ureal;
- UR_M_10_36 : Ureal;
- UR_100 : Ureal;
- UR_2_128 : Ureal;
- UR_2_80 : Ureal;
- UR_2_M_128 : Ureal;
- UR_2_M_80 : Ureal;
+ UR_0 : Ureal;
+ UR_M_0 : Ureal;
+ UR_Tenth : Ureal;
+ UR_Half : Ureal;
+ UR_1 : Ureal;
+ UR_2 : Ureal;
+ UR_10 : Ureal;
+ UR_10_36 : Ureal;
+ UR_M_10_36 : Ureal;
+ UR_100 : Ureal;
+ UR_2_128 : Ureal;
+ UR_2_80 : Ureal;
+ UR_2_M_128 : Ureal;
+ UR_2_M_80 : Ureal;
Num_Ureal_Constants : constant := 10;
-- This is used for an assertion check in Tree_Read and Tree_Write to
-- Return true if the real quotient of Num / Den is an integer value
function Normalize (Val : Ureal_Entry) return Ureal_Entry;
- -- Normalizes the Ureal_Entry by reducing it to lowest terms (with a
- -- base value of 0).
+ -- Normalizes the Ureal_Entry by reducing it to lowest terms (with a base
+ -- value of 0).
function Same (U1, U2 : Ureal) return Boolean;
pragma Inline (Same);
-- Determines if U1 and U2 are the same Ureal. Note that we cannot use
- -- the equals operator for this test, since that tests for equality,
- -- not identity.
+ -- the equals operator for this test, since that tests for equality, not
+ -- identity.
function Store_Ureal (Val : Ureal_Entry) return Ureal;
- -- This store a new entry in the universal reals table and return
- -- its index in the table.
+ -- This store a new entry in the universal reals table and return its index
+ -- in the table.
+
+ function Store_Ureal_Normalized (Val : Ureal_Entry) return Ureal;
+ pragma Inline (Store_Ureal_Normalized);
+ -- Like Store_Ureal, but normalizes its operand first.
-------------------------
-- Decimal_Exponent_Hi --
return Ureals.Last;
end Store_Ureal;
+ ----------------------------
+ -- Store_Ureal_Normalized --
+ ----------------------------
+
+ function Store_Ureal_Normalized (Val : Ureal_Entry) return Ureal is
+ begin
+ return Store_Ureal (Normalize (Val));
+ end Store_Ureal_Normalized;
+
---------------
-- Tree_Read --
---------------
Val : constant Ureal_Entry := Ureals.Table (Real);
begin
- return Store_Ureal (
- (Num => Val.Num,
- Den => Val.Den,
- Rbase => Val.Rbase,
- Negative => False));
+ return Store_Ureal
+ ((Num => Val.Num,
+ Den => Val.Den,
+ Rbase => Val.Rbase,
+ Negative => False));
end UR_Abs;
------------
function UR_Add (Left : Ureal; Right : Ureal) return Ureal is
Lval : Ureal_Entry := Ureals.Table (Left);
Rval : Ureal_Entry := Ureals.Table (Right);
-
Num : Uint;
begin
-- be negative, even though in stored entries this can never be so)
if Lval.Rbase /= 0 and then Lval.Rbase = Rval.Rbase then
-
declare
Opd_Min, Opd_Max : Ureal_Entry;
Exp_Min, Exp_Max : Uint;
Opd_Min.Num * Lval.Rbase ** (Exp_Max - Exp_Min) + Opd_Max.Num;
if Num = 0 then
- return Store_Ureal (
- (Num => Uint_0,
- Den => Uint_1,
- Rbase => 0,
- Negative => Lval.Negative));
+ return Store_Ureal
+ ((Num => Uint_0,
+ Den => Uint_1,
+ Rbase => 0,
+ Negative => Lval.Negative));
else
- return Store_Ureal (
- (Num => abs Num,
- Den => Exp_Max,
- Rbase => Lval.Rbase,
- Negative => (Num < 0)));
+ return Store_Ureal
+ ((Num => abs Num,
+ Den => Exp_Max,
+ Rbase => Lval.Rbase,
+ Negative => (Num < 0)));
end if;
end;
Num := (Ln.Num * Rn.Den) + (Rn.Num * Ln.Den);
if Num = 0 then
- return Store_Ureal (
- (Num => Uint_0,
- Den => Uint_1,
- Rbase => 0,
- Negative => Lval.Negative));
+ return Store_Ureal
+ ((Num => Uint_0,
+ Den => Uint_1,
+ Rbase => 0,
+ Negative => Lval.Negative));
else
- return Store_Ureal (
- Normalize (
- (Num => abs Num,
- Den => Ln.Den * Rn.Den,
- Rbase => 0,
- Negative => (Num < 0))));
+ return Store_Ureal_Normalized
+ ((Num => abs Num,
+ Den => Ln.Den * Rn.Den,
+ Rbase => 0,
+ Negative => (Num < 0)));
end if;
end;
end if;
function UR_Ceiling (Real : Ureal) return Uint is
Val : constant Ureal_Entry := Normalize (Ureals.Table (Real));
-
begin
if Val.Negative then
return UI_Negate (Val.Num / Val.Den);
pragma Assert (Rval.Num /= Uint_0);
if Lval.Rbase = 0 then
-
if Rval.Rbase = 0 then
- return Store_Ureal (
- Normalize (
- (Num => Lval.Num * Rval.Den,
- Den => Lval.Den * Rval.Num,
- Rbase => 0,
- Negative => Rneg)));
+ return Store_Ureal_Normalized
+ ((Num => Lval.Num * Rval.Den,
+ Den => Lval.Den * Rval.Num,
+ Rbase => 0,
+ Negative => Rneg));
elsif Is_Integer (Lval.Num, Rval.Num * Lval.Den) then
- return Store_Ureal (
- (Num => Lval.Num / (Rval.Num * Lval.Den),
- Den => (-Rval.Den),
- Rbase => Rval.Rbase,
- Negative => Rneg));
+ return Store_Ureal
+ ((Num => Lval.Num / (Rval.Num * Lval.Den),
+ Den => (-Rval.Den),
+ Rbase => Rval.Rbase,
+ Negative => Rneg));
elsif Rval.Den < 0 then
- return Store_Ureal (
- Normalize (
- (Num => Lval.Num,
- Den => Rval.Rbase ** (-Rval.Den) *
- Rval.Num *
- Lval.Den,
- Rbase => 0,
- Negative => Rneg)));
+ return Store_Ureal_Normalized
+ ((Num => Lval.Num,
+ Den => Rval.Rbase ** (-Rval.Den) *
+ Rval.Num *
+ Lval.Den,
+ Rbase => 0,
+ Negative => Rneg));
else
- return Store_Ureal (
- Normalize (
- (Num => Lval.Num * Rval.Rbase ** Rval.Den,
- Den => Rval.Num * Lval.Den,
- Rbase => 0,
- Negative => Rneg)));
+ return Store_Ureal_Normalized
+ ((Num => Lval.Num * Rval.Rbase ** Rval.Den,
+ Den => Rval.Num * Lval.Den,
+ Rbase => 0,
+ Negative => Rneg));
end if;
elsif Is_Integer (Lval.Num, Rval.Num) then
-
if Rval.Rbase = Lval.Rbase then
- return Store_Ureal (
- (Num => Lval.Num / Rval.Num,
- Den => Lval.Den - Rval.Den,
- Rbase => Lval.Rbase,
- Negative => Rneg));
+ return Store_Ureal
+ ((Num => Lval.Num / Rval.Num,
+ Den => Lval.Den - Rval.Den,
+ Rbase => Lval.Rbase,
+ Negative => Rneg));
elsif Rval.Rbase = 0 then
- return Store_Ureal (
- (Num => (Lval.Num / Rval.Num) * Rval.Den,
- Den => Lval.Den,
- Rbase => Lval.Rbase,
- Negative => Rneg));
+ return Store_Ureal
+ ((Num => (Lval.Num / Rval.Num) * Rval.Den,
+ Den => Lval.Den,
+ Rbase => Lval.Rbase,
+ Negative => Rneg));
elsif Rval.Den < 0 then
declare
(Rval.Rbase ** (-Rval.Den));
end if;
- return Store_Ureal (
- (Num => Num,
- Den => Den,
- Rbase => 0,
- Negative => Rneg));
+ return Store_Ureal
+ ((Num => Num,
+ Den => Den,
+ Rbase => 0,
+ Negative => Rneg));
end;
else
- return Store_Ureal (
- (Num => (Lval.Num / Rval.Num) *
- (Rval.Rbase ** Rval.Den),
- Den => Lval.Den,
- Rbase => Lval.Rbase,
- Negative => Rneg));
+ return Store_Ureal
+ ((Num => (Lval.Num / Rval.Num) *
+ (Rval.Rbase ** Rval.Den),
+ Den => Lval.Den,
+ Rbase => Lval.Rbase,
+ Negative => Rneg));
end if;
else
if Lval.Den < 0 then
Num := Lval.Num * (Lval.Rbase ** (-Lval.Den));
Den := Rval.Num;
-
else
Num := Lval.Num;
Den := Rval.Num * (Lval.Rbase ** Lval.Den);
Num := Num * Rval.Den;
end if;
- return Store_Ureal (
- Normalize (
- (Num => Num,
- Den => Den,
- Rbase => 0,
- Negative => Rneg)));
+ return Store_Ureal_Normalized
+ ((Num => Num,
+ Den => Den,
+ Rbase => 0,
+ Negative => Rneg));
end;
end if;
end UR_Div;
if IBas <= 16
and then UR_From_Uint (IBas) = Bas
then
- return Store_Ureal (
- (Num => Uint_1,
- Den => -N,
- Rbase => UI_To_Int (UR_Trunc (Bas)),
- Negative => Neg));
+ return Store_Ureal
+ ((Num => Uint_1,
+ Den => -N,
+ Rbase => UI_To_Int (UR_Trunc (Bas)),
+ Negative => Neg));
-- If the exponent is negative then we raise the numerator and the
-- denominator (after normalization) to the absolute value of the
pragma Assert (Val.Num /= 0);
Val := Normalize (Val);
- return Store_Ureal (
- (Num => Val.Den ** X,
- Den => Val.Num ** X,
- Rbase => 0,
- Negative => Neg));
+ return Store_Ureal
+ ((Num => Val.Den ** X,
+ Den => Val.Num ** X,
+ Rbase => 0,
+ Negative => Neg));
-- If positive, we distinguish the case when the base is not zero, in
-- which case the new denominator is just the product of the old one
else
if Val.Rbase /= 0 then
- return Store_Ureal (
- (Num => Val.Num ** X,
- Den => Val.Den * X,
- Rbase => Val.Rbase,
- Negative => Neg));
+ return Store_Ureal
+ ((Num => Val.Num ** X,
+ Den => Val.Den * X,
+ Rbase => Val.Rbase,
+ Negative => Neg));
-- And when the base is zero, in which case we exponentiate
-- the old denominator.
else
- return Store_Ureal (
- (Num => Val.Num ** X,
- Den => Val.Den ** X,
- Rbase => 0,
- Negative => Neg));
+ return Store_Ureal
+ ((Num => Val.Num ** X,
+ Den => Val.Den ** X,
+ Rbase => 0,
+ Negative => Neg));
end if;
end if;
end UR_Exponentiate;
function UR_Floor (Real : Ureal) return Uint is
Val : constant Ureal_Entry := Normalize (Ureals.Table (Real));
-
begin
if Val.Negative then
return UI_Negate ((Val.Num + Val.Den - 1) / Val.Den);
return Ureal
is
begin
- return Store_Ureal (
- (Num => Num,
- Den => Den,
- Rbase => Rbase,
- Negative => Negative));
+ return Store_Ureal
+ ((Num => Num,
+ Den => Den,
+ Rbase => Rbase,
+ Negative => Negative));
end UR_From_Components;
------------------
function UR_From_Uint (UI : Uint) return Ureal is
begin
return UR_From_Components
- (abs UI, Uint_1, Negative => (UI < 0));
+ (abs UI, Uint_1, Negative => (UI < 0));
end UR_From_Uint;
-----------
begin
if Lval.Rbase = 0 then
if Rval.Rbase = 0 then
- return Store_Ureal (
- Normalize (
- (Num => Num,
- Den => Lval.Den * Rval.Den,
- Rbase => 0,
- Negative => Rneg)));
+ return Store_Ureal_Normalized
+ ((Num => Num,
+ Den => Lval.Den * Rval.Den,
+ Rbase => 0,
+ Negative => Rneg));
elsif Is_Integer (Num, Lval.Den) then
- return Store_Ureal (
- (Num => Num / Lval.Den,
- Den => Rval.Den,
- Rbase => Rval.Rbase,
- Negative => Rneg));
+ return Store_Ureal
+ ((Num => Num / Lval.Den,
+ Den => Rval.Den,
+ Rbase => Rval.Rbase,
+ Negative => Rneg));
elsif Rval.Den < 0 then
- return Store_Ureal (
- Normalize (
- (Num => Num * (Rval.Rbase ** (-Rval.Den)),
- Den => Lval.Den,
- Rbase => 0,
- Negative => Rneg)));
+ return Store_Ureal_Normalized
+ ((Num => Num * (Rval.Rbase ** (-Rval.Den)),
+ Den => Lval.Den,
+ Rbase => 0,
+ Negative => Rneg));
else
- return Store_Ureal (
- Normalize (
- (Num => Num,
- Den => Lval.Den * (Rval.Rbase ** Rval.Den),
- Rbase => 0,
- Negative => Rneg)));
+ return Store_Ureal_Normalized
+ ((Num => Num,
+ Den => Lval.Den * (Rval.Rbase ** Rval.Den),
+ Rbase => 0,
+ Negative => Rneg));
end if;
elsif Lval.Rbase = Rval.Rbase then
- return Store_Ureal (
- (Num => Num,
- Den => Lval.Den + Rval.Den,
- Rbase => Lval.Rbase,
- Negative => Rneg));
+ return Store_Ureal
+ ((Num => Num,
+ Den => Lval.Den + Rval.Den,
+ Rbase => Lval.Rbase,
+ Negative => Rneg));
elsif Rval.Rbase = 0 then
if Is_Integer (Num, Rval.Den) then
- return Store_Ureal (
- (Num => Num / Rval.Den,
- Den => Lval.Den,
- Rbase => Lval.Rbase,
- Negative => Rneg));
+ return Store_Ureal
+ ((Num => Num / Rval.Den,
+ Den => Lval.Den,
+ Rbase => Lval.Rbase,
+ Negative => Rneg));
elsif Lval.Den < 0 then
- return Store_Ureal (
- Normalize (
- (Num => Num * (Lval.Rbase ** (-Lval.Den)),
- Den => Rval.Den,
- Rbase => 0,
- Negative => Rneg)));
+ return Store_Ureal_Normalized
+ ((Num => Num * (Lval.Rbase ** (-Lval.Den)),
+ Den => Rval.Den,
+ Rbase => 0,
+ Negative => Rneg));
else
- return Store_Ureal (
- Normalize (
- (Num => Num,
- Den => Rval.Den * (Lval.Rbase ** Lval.Den),
- Rbase => 0,
- Negative => Rneg)));
+ return Store_Ureal_Normalized
+ ((Num => Num,
+ Den => Rval.Den * (Lval.Rbase ** Lval.Den),
+ Rbase => 0,
+ Negative => Rneg));
end if;
else
Den := Den * (Rval.Rbase ** Rval.Den);
end if;
- return Store_Ureal (
- Normalize (
- (Num => Num,
- Den => Den,
- Rbase => 0,
- Negative => Rneg)));
+ return Store_Ureal_Normalized
+ ((Num => Num,
+ Den => Den,
+ Rbase => 0,
+ Negative => Rneg));
end if;
end UR_Mul;
else
Result :=
Rval.Negative /= Lval.Negative
- or else Rval.Num /= Lval.Num
- or else Rval.Den /= Lval.Den;
+ or else Rval.Num /= Lval.Num
+ or else Rval.Den /= Lval.Den;
Release (Imrk);
Release (Rmrk);
return Result;
function UR_Negate (Real : Ureal) return Ureal is
begin
- return Store_Ureal (
- (Num => Ureals.Table (Real).Num,
- Den => Ureals.Table (Real).Den,
- Rbase => Ureals.Table (Real).Rbase,
- Negative => not Ureals.Table (Real).Negative));
+ return Store_Ureal
+ ((Num => Ureals.Table (Real).Num,
+ Den => Ureals.Table (Real).Den,
+ Rbase => Ureals.Table (Real).Rbase,
+ Negative => not Ureals.Table (Real).Negative));
end UR_Negate;
------------
function UR_Trunc (Real : Ureal) return Uint is
Val : constant Ureal_Entry := Normalize (Ureals.Table (Real));
-
begin
if Val.Negative then
return -(Val.Num / Val.Den);
Write_Str (".0");
end if;
- -- Constants in base 2, 10 or 16 can be written in normal Ada literal
+ -- Constants in base 10 or 16 can be written in normal Ada literal
-- style, as long as they fit in the UI_Image_Buffer. Using hexadecimal
-- notation, 4 bytes are required for the 16# # part, and every fifth
-- character is an underscore. So, a buffer of size N has room for
-
- -- ((N - 4) - (N - 4) / 5) * 4 bits
-
- -- or at least
-
- -- N * 16 / 5 - 12 bits
+ -- ((N - 4) - (N - 4) / 5) * 4 bits,
+ -- or at least
+ -- N * 16 / 5 - 12 bits.
elsif (Val.Rbase = 10 or else Val.Rbase = 16)
and then Num_Bits (Val.Num) < UI_Image_Buffer'Length * 16 / 5 - 12
then
- declare
- Format : UI_Format := Decimal;
- Scale : Uint;
+ pragma Assert (Val.Den /= 0);
- begin
- if Val.Rbase = 16 then
- Write_Str ("16#");
- Format := Hex;
- end if;
-
- -- Use fixed-point format for small scaling values
+ -- Use fixed-point format for small scaling values
- if Val.Den = 1 then
- UI_Write (Val.Num / Val.Rbase, Format);
- Write_Char ('.');
- UI_Write (Val.Num mod Val.Rbase, Format);
+ if (Val.Rbase = 10 and then Val.Den < 0 and then Val.Den > -3)
+ or else (Val.Rbase = 16 and then Val.Den = -1)
+ then
+ UI_Write (Val.Num * Val.Rbase**(-Val.Den), Decimal);
+ Write_Str (".0");
- elsif Val.Den = 2 then
- UI_Write (Val.Num / Val.Rbase**Uint_2, Format);
- Write_Char ('.');
- UI_Write (Val.Num mod Val.Rbase**Uint_2 / Val.Rbase, Format);
- UI_Write (Val.Num mod Val.Rbase, Format);
+ -- Write hexadecimal constants in exponential notation with a zero
+ -- unit digit. This matches the Ada canonical form for floating point
+ -- numbers, and also ensures that the underscores end up in the
+ -- correct place.
- elsif Val.Den = -1 then
- UI_Write (Val.Num, Format);
- Write_Str ("0.0");
+ elsif Val.Rbase = 16 then
+ UI_Image (Val.Num, Hex);
+ pragma Assert (Val.Rbase = 16);
- elsif Val.Den = -2 then
- UI_Write (Val.Num, Format);
- Write_Str ("00.0");
+ Write_Str ("16#0.");
+ Write_Str (UI_Image_Buffer (4 .. UI_Image_Length));
- -- Else use exponential format
+ -- For exponent, exclude 16# # and underscores from length
- else
- UI_Image (Val.Num, Format);
- Scale := UI_From_Int (Int (UI_Image_Length));
+ UI_Image_Length := UI_Image_Length - 4;
+ UI_Image_Length := UI_Image_Length - UI_Image_Length / 5;
- if Format = Decimal then
+ Write_Char ('E');
+ UI_Write (Int (UI_Image_Length) - Val.Den, Decimal);
- -- Write decimal constants with a non-zero unit digit. This
- -- matches usual scientific notation.
+ elsif Val.Den = 1 then
+ UI_Write (Val.Num / 10, Decimal);
+ Write_Char ('.');
+ UI_Write (Val.Num mod 10, Decimal);
- Write_Char (UI_Image_Buffer (1));
- Write_Char ('.');
+ elsif Val.Den = 2 then
+ UI_Write (Val.Num / 100, Decimal);
+ Write_Char ('.');
+ UI_Write (Val.Num / 10 mod 10, Decimal);
+ UI_Write (Val.Num mod 10, Decimal);
- if UI_Image_Length = 1 then
- Write_Char ('0');
- else
- Write_Str (UI_Image_Buffer (2 .. UI_Image_Length));
- end if;
+ -- Else use decimal exponential format
- Scale := Scale - 1; -- First digit is at unit position
- else
- pragma Assert (Format = Hex);
-
- -- Write hexadecimal constants with a zero unit digit. This
- -- matches the Ada canonical form for binary floating point
- -- numbers, and also ensures that the underscores end up in
- -- the correct place.
+ else
+ -- Write decimal constants with a non-zero unit digit. This
+ -- matches usual scientific notation.
- Write_Str ("0.");
- Write_Str (UI_Image_Buffer (4 .. UI_Image_Length));
- Scale := Scale - 4; -- Subtract 16# #
- Scale := Scale - Scale / 5; -- Subtract underscores;
- end if;
+ UI_Image (Val.Num, Decimal);
+ Write_Char (UI_Image_Buffer (1));
+ Write_Char ('.');
- Write_Char ('E');
- Format := Decimal;
- UI_Write (Scale - Val.Den, Decimal);
+ if UI_Image_Length = 1 then
+ Write_Char ('0');
+ else
+ Write_Str (UI_Image_Buffer (2 .. UI_Image_Length));
end if;
- if Format = Hex then
- Write_Char ('#');
- end if;
- end;
+ Write_Char ('E');
+ UI_Write (Int (UI_Image_Length - 1) - Val.Den, Decimal);
+ end if;
- -- Constants in a base other than 10 can still be easily written
- -- in normal Ada literal style if the numerator is one.
+ -- Constants in a base other than 10 can still be easily written in
+ -- normal Ada literal style if the numerator is one.
elsif Val.Rbase /= 0 and then Val.Num = 1 then
Write_Int (Val.Rbase);
projects / gcc.git / commitdiff