+++ /dev/null
-------------------------------------------------------------------------------
--- --
--- GNAT COMPILER COMPONENTS --
--- --
--- U R E A L P --
--- --
--- S p e c --
--- --
--- $Revision: 1.1.16.2 $
--- --
--- Copyright (C) 1992-1998 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 2, 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. See the GNU General Public License --
--- for more details. You should have received a copy of the GNU General --
--- Public License distributed with GNAT; see file COPYING. If not, write --
--- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
--- MA 02111-1307, USA. --
--- --
--- As a special exception, if other files instantiate generics from this --
--- unit, or you link this unit with other files to produce an executable, --
--- this unit does not by itself cause the resulting executable to be --
--- covered by the GNU General Public License. This exception does not --
--- however invalidate any other reasons why the executable file might be --
--- covered by the GNU Public License. --
--- --
--- 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
-
- -- If the base is zero, then the absolute value of the Ureal is simply
- -- numerator/denominator. If the base is non-zero, then the absolute
- -- value is num / (rbase ** den).
-
- -- Negative numbers are represented by the sign of the numerator being
- -- negative. The denominator is always positive.
-
- -- 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_128 return Ureal;
- -- Returns value 2.0 ** 128
-
- function Ureal_2_M_128 return Ureal;
- -- Returns value 2.0 ** (-128)
-
- -----------------
- -- 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 Tree_Read.
- -- 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 Tree_Write
-
- 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);
- -- Writes value of Real to standard output. Used only for debugging and
- -- tree/source 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 [numerator/denominator].
-
- procedure pr (Real : Ureal);
- -- 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;