diff options
Diffstat (limited to 'gcc/ada/urealp.ads')
| -rw-r--r-- | gcc/ada/urealp.ads | 355 |
1 files changed, 355 insertions, 0 deletions
diff --git a/gcc/ada/urealp.ads b/gcc/ada/urealp.ads new file mode 100644 index 00000000000..9896e0d9968 --- /dev/null +++ b/gcc/ada/urealp.ads @@ -0,0 +1,355 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT COMPILER COMPONENTS -- +-- -- +-- U R E A L P -- +-- -- +-- S p e c -- +-- -- +-- $Revision: 1.35 $ -- +-- -- +-- 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. -- +-- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). -- +-- -- +------------------------------------------------------------------------------ + +-- 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; |