Subversion Repositories openrisc

------------------------------------------------------------------------------

--                                                                          --

--                         GNAT COMPILER COMPONENTS                         --

--                                                                          --

--                               U R E A L P                                --

--                                                                          --

--                                 B o d y                                  --

--                                                                          --

--          Copyright (C) 1992-2011, Free Software Foundation, Inc.         --

--                                                                          --

-- GNAT is free software;  you can  redistribute it  and/or modify it under --

-- terms of the  GNU General Public License as published  by the Free Soft- --

-- ware  Foundation;  either version 3,  or (at your option) any later ver- --

-- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --

-- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --

-- or FITNESS FOR A PARTICULAR PURPOSE.                                     --

--                                                                          --

-- As a special exception under Section 7 of GPL version 3, you are granted --

-- additional permissions described in the GCC Runtime Library Exception,   --

-- version 3.1, as published by the Free Software Foundation.               --

--                                                                          --

-- You should have received a copy of the GNU General Public License and    --

-- a copy of the GCC Runtime Library Exception along with this program;     --

-- see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see    --

-- <http://www.gnu.org/licenses/>.                                          --

--                                                                          --

-- GNAT was originally developed  by the GNAT team at  New York University. --

-- Extensive contributions were provided by Ada Core Technologies Inc.      --

--                                                                          --

------------------------------------------------------------------------------

with Alloc;

with Output;  use Output;

with Table;

with Tree_IO; use Tree_IO;

package body Urealp is

   Ureal_First_Entry : constant Ureal := Ureal'Succ (No_Ureal);

   --  First subscript allocated in Ureal table (note that we can't just

   --  add 1 to No_Ureal, since "+" means something different for Ureals!

   type Ureal_Entry is record

      Num  : Uint;

      --  Numerator (always non-negative)

      Den : Uint;

      --  Denominator (always non-zero, always positive if base is zero)

      Rbase : Nat;

      --  Base value. If Rbase is zero, then the value is simply Num / Den.

      --  If Rbase is non-zero, then the value is Num / (Rbase ** Den)

      Negative : Boolean;

      --  Flag set if value is negative

   end record;

   --  The following representation clause ensures that the above record

   --  has no holes. We do this so that when instances of this record are

   --  written by Tree_Gen, we do not write uninitialized values to the file.

   for Ureal_Entry use record

      Num      at  0 range 0 .. 31;

      Den      at  4 range 0 .. 31;

      Rbase    at  8 range 0 .. 31;

      Negative at 12 range 0 .. 31;

   end record;

   for Ureal_Entry'Size use 16 * 8;

   --  This ensures that we did not leave out any fields

   package Ureals is new Table.Table (

     Table_Component_Type => Ureal_Entry,

     Table_Index_Type     => Ureal'Base,

     Table_Low_Bound      => Ureal_First_Entry,

     Table_Initial        => Alloc.Ureals_Initial,

     Table_Increment      => Alloc.Ureals_Increment,

     Table_Name           => "Ureals");

   --  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;

   Num_Ureal_Constants : constant := 10;

   --  This is used for an assertion check in Tree_Read and Tree_Write to

   --  help remember to add values to these routines when we add to the list.

   Normalized_Real : Ureal := No_Ureal;

   --  Used to memoize Norm_Num and Norm_Den, if either of these functions

   --  is called, this value is set and Normalized_Entry contains the result

   --  of the normalization. On subsequent calls, this is used to avoid the

   --  call to Normalize if it has already been made.

   Normalized_Entry : Ureal_Entry;

   --  Entry built by most recent call to Normalize

   -----------------------

   -- Local Subprograms --

   -----------------------

   function Decimal_Exponent_Hi (V : Ureal) return Int;

   --  Returns an estimate of the exponent of Val represented as a normalized

   --  decimal number (non-zero digit before decimal point), The estimate is

   --  either correct, or high, but never low. The accuracy of the estimate

   --  affects only the efficiency of the comparison routines.

   function Decimal_Exponent_Lo (V : Ureal) return Int;

   --  Returns an estimate of the exponent of Val represented as a normalized

   --  decimal number (non-zero digit before decimal point), The estimate is

   --  either correct, or low, but never high. The accuracy of the estimate

   --  affects only the efficiency of the comparison routines.

   function Equivalent_Decimal_Exponent (U : Ureal_Entry) return Int;

   --  U is a Ureal entry for which the base value is non-zero, the value

   --  returned is the equivalent decimal exponent value, i.e. the value of

   --  Den, adjusted as though the base were base 10. The value is rounded

   --  toward zero (truncated), and so its value can be off by one.

   function Is_Integer (Num, Den : Uint) return Boolean;

   --  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).

   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.

   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.

   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 --

   -------------------------

   function Decimal_Exponent_Hi (V : Ureal) return Int is

      Val : constant Ureal_Entry := Ureals.Table (V);

   begin

      --  Zero always returns zero

      if UR_Is_Zero (V) then

         return 0;

      --  For numbers in rational form, get the maximum number of digits in the

      --  numerator and the minimum number of digits in the denominator, and

      --  subtract. For example:

      --     1000 / 99 = 1.010E+1

      --     9999 / 10 = 9.999E+2

      --  This estimate may of course be high, but that is acceptable

      elsif Val.Rbase = 0 then

         return UI_Decimal_Digits_Hi (Val.Num) -

                UI_Decimal_Digits_Lo (Val.Den);

      --  For based numbers, just subtract the decimal exponent from the

      --  high estimate of the number of digits in the numerator and add

      --  one to accommodate possible round off errors for non-decimal

      --  bases. For example:

      --     1_500_000 / 10**4 = 1.50E-2

      else -- Val.Rbase /= 0

         return UI_Decimal_Digits_Hi (Val.Num) -

                Equivalent_Decimal_Exponent (Val) + 1;

      end if;

   end Decimal_Exponent_Hi;

   -------------------------

   -- Decimal_Exponent_Lo --

   -------------------------

   function Decimal_Exponent_Lo (V : Ureal) return Int is

      Val : constant Ureal_Entry := Ureals.Table (V);

   begin

      --  Zero always returns zero

      if UR_Is_Zero (V) then

         return 0;

      --  For numbers in rational form, get min digits in numerator, max digits

      --  in denominator, and subtract and subtract one more for possible loss

      --  during the division. For example:

      --     1000 / 99 = 1.010E+1

      --     9999 / 10 = 9.999E+2

      --  This estimate may of course be low, but that is acceptable

      elsif Val.Rbase = 0 then

         return UI_Decimal_Digits_Lo (Val.Num) -

                UI_Decimal_Digits_Hi (Val.Den) - 1;

      --  For based numbers, just subtract the decimal exponent from the

      --  low estimate of the number of digits in the numerator and subtract

      --  one to accommodate possible round off errors for non-decimal

      --  bases. For example:

      --     1_500_000 / 10**4 = 1.50E-2

      else -- Val.Rbase /= 0

         return UI_Decimal_Digits_Lo (Val.Num) -

                Equivalent_Decimal_Exponent (Val) - 1;

      end if;

   end Decimal_Exponent_Lo;

   -----------------

   -- Denominator --

   -----------------

   function Denominator (Real : Ureal) return Uint is

   begin

      return Ureals.Table (Real).Den;

   end Denominator;

   ---------------------------------

   -- Equivalent_Decimal_Exponent --

   ---------------------------------

   function Equivalent_Decimal_Exponent (U : Ureal_Entry) return Int is

      type Ratio is record

         Num : Nat;

         Den : Nat;

      end record;

      --  The following table is a table of logs to the base 10. All values

      --  have at least 15 digits of precision, and do not exceed the true

      --  value. To avoid the use of floating point, and as a result potential

      --  target dependency, each entry is represented as a fraction of two

      --  integers.

      Logs : constant array (Nat range 1 .. 16) of Ratio :=

        (1 => (Num =>           0, Den =>            1),  -- 0

         2 => (Num =>  15_392_313, Den =>   51_132_157),  -- 0.301029995663981

         3 => (Num => 731_111_920, Den => 1532_339_867),  -- 0.477121254719662

         4 => (Num =>  30_784_626, Den =>   51_132_157),  -- 0.602059991327962

         5 => (Num => 111_488_153, Den =>  159_503_487),  -- 0.698970004336018

         6 => (Num =>  84_253_929, Den =>  108_274_489),  -- 0.778151250383643

         7 => (Num =>  35_275_468, Den =>   41_741_273),  -- 0.845098040014256

         8 => (Num =>  46_176_939, Den =>   51_132_157),  -- 0.903089986991943

         9 => (Num => 417_620_173, Den =>  437_645_744),  -- 0.954242509439324

        10 => (Num =>           1, Den =>            1),  -- 1.000000000000000

        11 => (Num => 136_507_510, Den =>  131_081_687),  -- 1.041392685158225

        12 => (Num =>  26_797_783, Den =>   24_831_587),  -- 1.079181246047624

        13 => (Num =>  73_333_297, Den =>   65_832_160),  -- 1.113943352306836

        14 => (Num => 102_941_258, Den =>   89_816_543),  -- 1.146128035678238

        15 => (Num =>  53_385_559, Den =>   45_392_361),  -- 1.176091259055681

        16 => (Num =>  78_897_839, Den =>   65_523_237)); -- 1.204119982655924

      function Scale (X : Int; R : Ratio) return Int;

      --  Compute the value of X scaled by R

      -----------

      -- Scale --

      -----------

      function Scale (X : Int; R : Ratio) return Int is

         type Wide_Int is range -2**63 .. 2**63 - 1;

      begin

         return Int (Wide_Int (X) * Wide_Int (R.Num) / Wide_Int (R.Den));

      end Scale;

   begin

      pragma Assert (U.Rbase /= 0);

      return Scale (UI_To_Int (U.Den), Logs (U.Rbase));

   end Equivalent_Decimal_Exponent;

   ----------------

   -- Initialize --

   ----------------

   procedure Initialize is

   begin

      Ureals.Init;

      UR_0       := UR_From_Components (Uint_0, Uint_1,         0, False);

      UR_M_0     := UR_From_Components (Uint_0, Uint_1,         0, True);

      UR_Half    := UR_From_Components (Uint_1, Uint_1,         2, False);

      UR_Tenth   := UR_From_Components (Uint_1, Uint_1,        10, False);

      UR_1       := UR_From_Components (Uint_1, Uint_1,         0, False);

      UR_2       := UR_From_Components (Uint_1, Uint_Minus_1,   2, False);

      UR_10      := UR_From_Components (Uint_1, Uint_Minus_1,  10, False);

      UR_10_36   := UR_From_Components (Uint_1, Uint_Minus_36, 10, False);

      UR_M_10_36 := UR_From_Components (Uint_1, Uint_Minus_36, 10, True);

      UR_100     := UR_From_Components (Uint_1, Uint_Minus_2,  10, False);

      UR_2_128   := UR_From_Components (Uint_1, Uint_Minus_128, 2, False);

      UR_2_M_128 := UR_From_Components (Uint_1, Uint_128,       2, False);

      UR_2_80    := UR_From_Components (Uint_1, Uint_Minus_80,  2, False);

      UR_2_M_80  := UR_From_Components (Uint_1, Uint_80,        2, False);

   end Initialize;

   ----------------

   -- Is_Integer --

   ----------------

   function Is_Integer (Num, Den : Uint) return Boolean is

   begin

      return (Num / Den) * Den = Num;

   end Is_Integer;

   ----------

   -- Mark --

   ----------

   function Mark return Save_Mark is

   begin

      return Save_Mark (Ureals.Last);

   end Mark;

   --------------

   -- Norm_Den --

   --------------

   function Norm_Den (Real : Ureal) return Uint is

   begin

      if not Same (Real, Normalized_Real) then

         Normalized_Real  := Real;

         Normalized_Entry := Normalize (Ureals.Table (Real));

      end if;

      return Normalized_Entry.Den;

   end Norm_Den;

   --------------

   -- Norm_Num --

   --------------

   function Norm_Num (Real : Ureal) return Uint is

   begin

      if not Same (Real, Normalized_Real) then

         Normalized_Real  := Real;

         Normalized_Entry := Normalize (Ureals.Table (Real));

      end if;

      return Normalized_Entry.Num;

   end Norm_Num;

   ---------------

   -- Normalize --

   ---------------

   function Normalize (Val : Ureal_Entry) return Ureal_Entry is

      J   : Uint;

      K   : Uint;

      Tmp : Uint;

      Num : Uint;

      Den : Uint;

      M   : constant Uintp.Save_Mark := Uintp.Mark;

   begin

      --  Start by setting J to the greatest of the absolute values of the

      --  numerator and the denominator (taking into account the base value),

      --  and K to the lesser of the two absolute values. The gcd of Num and

      --  Den is the gcd of J and K.

      if Val.Rbase = 0 then

         J := Val.Num;

         K := Val.Den;

      elsif Val.Den < 0 then

         J := Val.Num * Val.Rbase ** (-Val.Den);

         K := Uint_1;

      else

         J := Val.Num;

         K := Val.Rbase ** Val.Den;

      end if;

      Num := J;

      Den := K;

      if K > J then

         Tmp := J;

         J := K;

         K := Tmp;

      end if;

      J := UI_GCD (J, K);

      Num := Num / J;

      Den := Den / J;

      Uintp.Release_And_Save (M, Num, Den);

      --  Divide numerator and denominator by gcd and return result

      return (Num      => Num,

              Den      => Den,

              Rbase    => 0,

              Negative => Val.Negative);

   end Normalize;

   ---------------

   -- Numerator --

   ---------------

   function Numerator (Real : Ureal) return Uint is

   begin

      return Ureals.Table (Real).Num;

   end Numerator;

   --------

   -- pr --

   --------

   procedure pr (Real : Ureal) is

   begin

      UR_Write (Real);

      Write_Eol;

   end pr;

   -----------

   -- Rbase --

   -----------

   function Rbase (Real : Ureal) return Nat is

   begin

      return Ureals.Table (Real).Rbase;

   end Rbase;

   -------------

   -- Release --

   -------------

   procedure Release (M : Save_Mark) is

   begin

      Ureals.Set_Last (Ureal (M));

   end Release;

   ----------

   -- Same --

   ----------

   function Same (U1, U2 : Ureal) return Boolean is

   begin

      return Int (U1) = Int (U2);

   end Same;

   -----------------

   -- Store_Ureal --

   -----------------

   function Store_Ureal (Val : Ureal_Entry) return Ureal is

   begin

      Ureals.Append (Val);

      --  Normalize representation of signed values

      if Val.Num < 0 then

         Ureals.Table (Ureals.Last).Negative := True;

         Ureals.Table (Ureals.Last).Num := -Val.Num;

      end if;

      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 --

   ---------------

   procedure Tree_Read is

   begin

      pragma Assert (Num_Ureal_Constants = 10);

      Ureals.Tree_Read;

      Tree_Read_Int (Int (UR_0));

      Tree_Read_Int (Int (UR_M_0));

      Tree_Read_Int (Int (UR_Tenth));

      Tree_Read_Int (Int (UR_Half));

      Tree_Read_Int (Int (UR_1));

      Tree_Read_Int (Int (UR_2));

      Tree_Read_Int (Int (UR_10));

      Tree_Read_Int (Int (UR_100));

      Tree_Read_Int (Int (UR_2_128));

      Tree_Read_Int (Int (UR_2_M_128));

      --  Clear the normalization cache

      Normalized_Real := No_Ureal;

   end Tree_Read;

   ----------------

   -- Tree_Write --

   ----------------

   procedure Tree_Write is

   begin

      pragma Assert (Num_Ureal_Constants = 10);

      Ureals.Tree_Write;

      Tree_Write_Int (Int (UR_0));

      Tree_Write_Int (Int (UR_M_0));

      Tree_Write_Int (Int (UR_Tenth));

      Tree_Write_Int (Int (UR_Half));

      Tree_Write_Int (Int (UR_1));

      Tree_Write_Int (Int (UR_2));

      Tree_Write_Int (Int (UR_10));

      Tree_Write_Int (Int (UR_100));

      Tree_Write_Int (Int (UR_2_128));

      Tree_Write_Int (Int (UR_2_M_128));

   end Tree_Write;

   ------------

   -- UR_Abs --

   ------------

   function UR_Abs (Real : Ureal) return Ureal is

      Val : constant Ureal_Entry := Ureals.Table (Real);

   begin

      return Store_Ureal

               ((Num      => Val.Num,

                 Den      => Val.Den,

                 Rbase    => Val.Rbase,

                 Negative => False));

   end UR_Abs;

   ------------

   -- UR_Add --

   ------------

   function UR_Add (Left : Uint; Right : Ureal) return Ureal is

   begin

      return UR_From_Uint (Left) + Right;

   end UR_Add;

   function UR_Add (Left : Ureal; Right : Uint) return Ureal is

   begin

      return Left + UR_From_Uint (Right);

   end UR_Add;

   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

      --  Note, in the temporary Ureal_Entry values used in this procedure,

      --  we store the sign as the sign of the numerator (i.e. xxx.Num may

      --  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;

         begin

            if Lval.Negative then

               Lval.Num := (-Lval.Num);

            end if;

            if Rval.Negative then

               Rval.Num := (-Rval.Num);

            end if;

            if Lval.Den < Rval.Den then

               Exp_Min := Lval.Den;

               Exp_Max := Rval.Den;

               Opd_Min := Lval;

               Opd_Max := Rval;

            else

               Exp_Min := Rval.Den;

               Exp_Max := Lval.Den;

               Opd_Min := Rval;

               Opd_Max := Lval;

            end if;

            Num :=

              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));

            else

               return Store_Ureal

                        ((Num      => abs Num,

                          Den      => Exp_Max,

                          Rbase    => Lval.Rbase,

                          Negative => (Num < 0)));

            end if;

         end;

      else

         declare

            Ln : Ureal_Entry := Normalize (Lval);

            Rn : Ureal_Entry := Normalize (Rval);

         begin

            if Ln.Negative then

               Ln.Num := (-Ln.Num);

            end if;

            if Rn.Negative then

               Rn.Num := (-Rn.Num);

            end if;

            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));

            else

               return Store_Ureal_Normalized

                        ((Num      => abs Num,

                          Den      => Ln.Den * Rn.Den,

                          Rbase    => 0,

                          Negative => (Num < 0)));

            end if;

         end;

      end if;

   end UR_Add;

   ----------------

   -- UR_Ceiling --

   ----------------

   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);

      else

         return (Val.Num + Val.Den - 1) / Val.Den;

      end if;

   end UR_Ceiling;

   ------------

   -- UR_Div --

   ------------

   function UR_Div (Left : Uint; Right : Ureal) return Ureal is

   begin

      return UR_From_Uint (Left) / Right;

   end UR_Div;

   function UR_Div (Left : Ureal; Right : Uint) return Ureal is

   begin

      return Left / UR_From_Uint (Right);

   end UR_Div;

   function UR_Div (Left, Right : Ureal) return Ureal is

      Lval : constant Ureal_Entry := Ureals.Table (Left);

      Rval : constant Ureal_Entry := Ureals.Table (Right);

      Rneg : constant Boolean     := Rval.Negative xor Lval.Negative;

   begin

      pragma Assert (Rval.Num /= Uint_0);

      if Lval.Rbase = 0 then

         if Rval.Rbase = 0 then

            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));

         elsif Rval.Den < 0 then

            return Store_Ureal_Normalized

                     ((Num      => Lval.Num,

                       Den      => Rval.Rbase ** (-Rval.Den) *

                                   Rval.Num *

                                   Lval.Den,

                       Rbase    => 0,

                       Negative => Rneg));

         else

            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));

         elsif Rval.Rbase = 0 then

            return Store_Ureal

                     ((Num      => (Lval.Num / Rval.Num) * Rval.Den,

                       Den      => Lval.Den,

                       Rbase    => Lval.Rbase,

                       Negative => Rneg));

         elsif Rval.Den < 0 then

            declare

               Num, Den : Uint;

            begin

               if Lval.Den < 0 then

                  Num := (Lval.Num / Rval.Num) * (Lval.Rbase ** (-Lval.Den));

                  Den := Rval.Rbase ** (-Rval.Den);

               else

                  Num := Lval.Num / Rval.Num;

                  Den := (Lval.Rbase ** Lval.Den) *

                         (Rval.Rbase ** (-Rval.Den));

               end if;

               return Store_Ureal

                        ((Num      => Num,

                          Den      => Den,

                          Rbase    => 0,

                          Negative => Rneg));

            end;