--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/gcc/ada/urealp.ads	Fri Oct 27 22:46:09 2017 +0900
@@ -0,0 +1,369 @@
+------------------------------------------------------------------------------
+--                                                                          --
+--                         GNAT COMPILER COMPONENTS                         --
+--                                                                          --
+--                               U R E A L P                                --
+--                                                                          --
+--                                 S p e c                                  --
+--                                                                          --
+--          Copyright (C) 1992-2013, 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.      --
+--                                                                          --
+------------------------------------------------------------------------------
+
+--  Support for universal real arithmetic
+
+with Types; use Types;
+with Uintp; use Uintp;
+
+package Urealp is
+
+   ---------------------------------------
+   -- Representation of Universal Reals --
+   ---------------------------------------
+
+   --  A universal real value is represented by a single value (which is
+   --  an index into an internal table). These values are not hashed, so
+   --  the equality operator should not be used on Ureal values (instead
+   --  use the UR_Eq function).
+
+   --  A Ureal value represents an arbitrary precision universal real value,
+   --  stored internally using four components:
+
+   --    the numerator (Uint, always non-negative)
+   --    the denominator (Uint, always non-zero, always positive if base = 0)
+   --    a real base (Nat, either zero, or in the range 2 .. 16)
+   --    a sign flag (Boolean), set if negative
+
+   --  Negative numbers are represented by the sign flag being True.
+
+   --  If the base is zero, then the absolute value of the Ureal is simply
+   --  numerator/denominator, where denominator is positive. If the base is
+   --  non-zero, then the absolute value is numerator / (base ** denominator).
+   --  In that case, since base is positive, (base ** denominator) is also
+   --  positive, even when denominator is negative or null.
+
+   --  A normalized Ureal value has base = 0, and numerator/denominator
+   --  reduced to lowest terms, with zero itself being represented as 0/1.
+   --  This is a canonical format, so that for normalized Ureal values it
+   --  is the case that two equal values always have the same denominator
+   --  and numerator values.
+
+   --  Note: a value of minus zero is legitimate, and the operations in
+   --  Urealp preserve the handling of signed zeroes in accordance with
+   --  the rules of IEEE P754 ("IEEE floating point").
+
+   ------------------------------
+   -- Types for Urealp Package --
+   ------------------------------
+
+   type Ureal is private;
+   --  Type used for representation of universal reals
+
+   No_Ureal : constant Ureal;
+   --  Constant used to indicate missing or unset Ureal value
+
+   ---------------------
+   -- Ureal Constants --
+   ---------------------
+
+   function Ureal_0 return Ureal;
+   --  Returns value 0.0
+
+   function Ureal_M_0 return Ureal;
+   --  Returns value -0.0
+
+   function Ureal_Tenth return Ureal;
+   --  Returns value 0.1
+
+   function Ureal_Half return Ureal;
+   --  Returns value 0.5
+
+   function Ureal_1 return Ureal;
+   --  Returns value 1.0
+
+   function Ureal_2 return Ureal;
+   --  Returns value 2.0
+
+   function Ureal_10 return Ureal;
+   --  Returns value 10.0
+
+   function Ureal_100 return Ureal;
+   --  Returns value 100.0
+
+   function Ureal_2_80 return Ureal;
+   --  Returns value 2.0 ** 80
+
+   function Ureal_2_M_80 return Ureal;
+   --  Returns value 2.0 ** (-80)
+
+   function Ureal_2_128 return Ureal;
+   --  Returns value 2.0 ** 128
+
+   function Ureal_2_M_128 return Ureal;
+   --  Returns value 2.0 ** (-128)
+
+   function Ureal_10_36 return Ureal;
+   --  Returns value 10.0 ** 36
+
+   function Ureal_M_10_36 return Ureal;
+   --  Returns value -10.0 ** 36
+
+   -----------------
+   -- Subprograms --
+   -----------------
+
+   procedure Initialize;
+   --  Initialize Ureal tables. Note that Initialize must not be called if
+   --  Tree_Read is used. Note also that there is no Lock routine in this
+   --  unit. These tables are among the few tables that can be expanded
+   --  during Gigi processing.
+
+   procedure Tree_Read;
+   --  Initializes internal tables from current tree file using the relevant
+   --  Table.Tree_Read routines. Note that Initialize should not be called if
+   --  Tree_Read is used. Tree_Read includes all necessary initialization.
+
+   procedure Tree_Write;
+   --  Writes out internal tables to current tree file using the relevant
+   --  Table.Tree_Write routines.
+
+   function Rbase (Real : Ureal) return Nat;
+   --  Return the base of the universal real
+
+   function Denominator (Real : Ureal) return Uint;
+   --  Return the denominator of the universal real
+
+   function Numerator (Real : Ureal) return Uint;
+   --  Return the numerator of the universal real
+
+   function Norm_Den (Real : Ureal) return Uint;
+   --  Return the denominator of the universal real after a normalization
+
+   function Norm_Num (Real : Ureal) return Uint;
+   --  Return the numerator of the universal real after a normalization
+
+   function UR_From_Uint (UI : Uint) return Ureal;
+   --  Returns real corresponding to universal integer value
+
+   function UR_To_Uint (Real : Ureal) return Uint;
+   --  Return integer value obtained by accurate rounding of real value.
+   --  The rounding of values half way between two integers is away from
+   --  zero, as required by normal Ada 95 rounding semantics.
+
+   function UR_Trunc (Real : Ureal) return Uint;
+   --  Return integer value obtained by a truncation of real towards zero
+
+   function UR_Ceiling (Real : Ureal) return Uint;
+   --  Return value of smallest integer not less than the given value
+
+   function UR_Floor (Real : Ureal) return Uint;
+   --  Return value of smallest integer not greater than the given value
+
+   --  Conversion table for above four functions
+
+   --    Input    To_Uint    Trunc    Ceiling    Floor
+   --     1.0        1         1         1         1
+   --     1.2        1         1         2         1
+   --     1.5        2         1         2         1
+   --     1.7        2         1         2         1
+   --     2.0        2         2         2         2
+   --    -1.0       -1        -1        -1        -1
+   --    -1.2       -1        -1        -1        -2
+   --    -1.5       -2        -1        -1        -2
+   --    -1.7       -2        -1        -1        -2
+   --    -2.0       -2        -2        -2        -2
+
+   function UR_From_Components
+     (Num      : Uint;
+      Den      : Uint;
+      Rbase    : Nat := 0;
+      Negative : Boolean := False)
+      return     Ureal;
+   --  Builds real value from given numerator, denominator and base. The
+   --  value is negative if Negative is set to true, and otherwise is
+   --  non-negative.
+
+   function UR_Add (Left : Ureal; Right : Ureal) return Ureal;
+   function UR_Add (Left : Ureal; Right : Uint)  return Ureal;
+   function UR_Add (Left : Uint;  Right : Ureal) return Ureal;
+   --  Returns real sum of operands
+
+   function UR_Div (Left : Ureal; Right : Ureal) return Ureal;
+   function UR_Div (Left : Uint;  Right : Ureal) return Ureal;
+   function UR_Div (Left : Ureal; Right : Uint)  return Ureal;
+   --  Returns real quotient of operands. Fatal error if Right is zero
+
+   function UR_Mul (Left : Ureal; Right : Ureal) return Ureal;
+   function UR_Mul (Left : Uint;  Right : Ureal) return Ureal;
+   function UR_Mul (Left : Ureal; Right : Uint)  return Ureal;
+   --  Returns real product of operands
+
+   function UR_Sub (Left : Ureal; Right : Ureal) return Ureal;
+   function UR_Sub (Left : Uint;  Right : Ureal) return Ureal;
+   function UR_Sub (Left : Ureal; Right : Uint)  return Ureal;
+   --  Returns real difference of operands
+
+   function UR_Exponentiate (Real  : Ureal; N : Uint) return  Ureal;
+   --  Returns result of raising Ureal to Uint power.
+   --  Fatal error if Left is 0 and Right is negative.
+
+   function UR_Abs (Real : Ureal) return Ureal;
+   --  Returns abs function of real
+
+   function UR_Negate (Real : Ureal) return Ureal;
+   --  Returns negative of real
+
+   function UR_Eq (Left, Right : Ureal) return Boolean;
+   --  Compares reals for equality
+
+   function UR_Max (Left, Right : Ureal) return Ureal;
+   --  Returns the maximum of two reals
+
+   function UR_Min (Left, Right : Ureal) return Ureal;
+   --  Returns the minimum of two reals
+
+   function UR_Ne (Left, Right : Ureal) return Boolean;
+   --  Compares reals for inequality
+
+   function UR_Lt (Left, Right : Ureal) return Boolean;
+   --  Compares reals for less than
+
+   function UR_Le (Left, Right : Ureal) return Boolean;
+   --  Compares reals for less than or equal
+
+   function UR_Gt (Left, Right : Ureal) return Boolean;
+   --  Compares reals for greater than
+
+   function UR_Ge (Left, Right : Ureal) return Boolean;
+   --  Compares reals for greater than or equal
+
+   function UR_Is_Zero (Real : Ureal) return Boolean;
+   --  Tests if real value is zero
+
+   function UR_Is_Negative (Real : Ureal) return Boolean;
+   --  Tests if real value is negative, note that negative zero gives true
+
+   function UR_Is_Positive (Real : Ureal) return Boolean;
+   --  Test if real value is greater than zero
+
+   procedure UR_Write (Real : Ureal; Brackets : Boolean := False);
+   --  Writes value of Real to standard output. Used for debugging and
+   --  tree/source output, and also for -gnatR representation output. If the
+   --  result is easily representable as a standard Ada literal, it will be
+   --  given that way, but as a result of evaluation of static expressions, it
+   --  is possible to generate constants (e.g. 1/13) which have no such
+   --  representation. In such cases (and in cases where it is too much work to
+   --  figure out the Ada literal), the string that is output is of the form
+   --  of some expression such as integer/integer, or integer*integer**integer.
+   --  In the case where an expression is output, if Brackets is set to True,
+   --  the expression is surrounded by square brackets.
+
+   procedure pr (Real : Ureal);
+   pragma Export (Ada, pr);
+   --  Writes value of Real to standard output with a terminating line return,
+   --  using UR_Write as described above. This is for use from the debugger.
+
+   ------------------------
+   -- Operator Renamings --
+   ------------------------
+
+   function "+" (Left : Ureal; Right : Ureal) return Ureal renames UR_Add;
+   function "+" (Left : Uint;  Right : Ureal) return Ureal renames UR_Add;
+   function "+" (Left : Ureal; Right : Uint)  return Ureal renames UR_Add;
+
+   function "/" (Left : Ureal; Right : Ureal) return Ureal renames UR_Div;
+   function "/" (Left : Uint;  Right : Ureal) return Ureal renames UR_Div;
+   function "/" (Left : Ureal; Right : Uint)  return Ureal renames UR_Div;
+
+   function "*" (Left : Ureal; Right : Ureal) return Ureal renames UR_Mul;
+   function "*" (Left : Uint;  Right : Ureal) return Ureal renames UR_Mul;
+   function "*" (Left : Ureal; Right : Uint)  return Ureal renames UR_Mul;
+
+   function "-" (Left : Ureal; Right : Ureal) return Ureal renames UR_Sub;
+   function "-" (Left : Uint;  Right : Ureal) return Ureal renames UR_Sub;
+   function "-" (Left : Ureal; Right : Uint)  return Ureal renames UR_Sub;
+
+   function "**"  (Real  : Ureal; N : Uint) return Ureal
+                                                     renames UR_Exponentiate;
+
+   function "abs" (Real : Ureal) return Ureal renames UR_Abs;
+
+   function "-"   (Real : Ureal) return Ureal renames UR_Negate;
+
+   function "="   (Left, Right : Ureal) return Boolean renames UR_Eq;
+
+   function "<"   (Left, Right : Ureal) return Boolean renames UR_Lt;
+
+   function "<="  (Left, Right : Ureal) return Boolean renames UR_Le;
+
+   function ">="  (Left, Right : Ureal) return Boolean renames UR_Ge;
+
+   function ">"   (Left, Right : Ureal) return Boolean renames UR_Gt;
+
+   -----------------------------
+   -- Mark/Release Processing --
+   -----------------------------
+
+   --  The space used by Ureal data is not automatically reclaimed. However,
+   --  a mark-release regime is implemented which allows storage to be
+   --  released back to a previously noted mark. This is used for example
+   --  when doing comparisons, where only intermediate results get stored
+   --  that do not need to be saved for future use.
+
+   type Save_Mark is private;
+
+   function Mark return Save_Mark;
+   --  Note mark point for future release
+
+   procedure Release (M : Save_Mark);
+   --  Release storage allocated since mark was noted
+
+   ------------------------------------
+   -- Representation of Ureal Values --
+   ------------------------------------
+
+private
+
+   type Ureal is new Int range Ureal_Low_Bound .. Ureal_High_Bound;
+   for Ureal'Size use 32;
+
+   No_Ureal : constant Ureal := Ureal'First;
+
+   type Save_Mark is new Int;
+
+   pragma Inline (Denominator);
+   pragma Inline (Mark);
+   pragma Inline (Norm_Num);
+   pragma Inline (Norm_Den);
+   pragma Inline (Numerator);
+   pragma Inline (Rbase);
+   pragma Inline (Release);
+   pragma Inline (Ureal_0);
+   pragma Inline (Ureal_M_0);
+   pragma Inline (Ureal_Tenth);
+   pragma Inline (Ureal_Half);
+   pragma Inline (Ureal_1);
+   pragma Inline (Ureal_2);
+   pragma Inline (Ureal_10);
+   pragma Inline (UR_From_Components);
+
+end Urealp;