aboutsummaryrefslogtreecommitdiffstats
path: root/gcc-4.8.3/gcc/ada/urealp.ads
diff options
context:
space:
mode:
Diffstat (limited to 'gcc-4.8.3/gcc/ada/urealp.ads')
-rw-r--r--gcc-4.8.3/gcc/ada/urealp.ads369
1 files changed, 369 insertions, 0 deletions
diff --git a/gcc-4.8.3/gcc/ada/urealp.ads b/gcc-4.8.3/gcc/ada/urealp.ads
new file mode 100644
index 000000000..54fe8ffe1
--- /dev/null
+++ b/gcc-4.8.3/gcc/ada/urealp.ads
@@ -0,0 +1,369 @@
+------------------------------------------------------------------------------
+-- --
+-- GNAT COMPILER COMPONENTS --
+-- --
+-- U R E A L P --
+-- --
+-- S p e c --
+-- --
+-- Copyright (C) 1992-2012, 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
+
+ -----------------
+ -- 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;