------------------------------------------------------------------------------ -- -- -- GNAT COMPILER COMPONENTS -- -- -- -- U R E A L P -- -- -- -- S p e c -- -- -- -- -- -- Copyright (C) 1992-2002 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); 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;