gcc/ada/urealp.ads

   1 ------------------------------------------------------------------------------
   2 --                                                                          --
   3 --                         GNAT COMPILER COMPONENTS                         --
   4 --                                                                          --
   5 --                               U R E A L P                                --
   6 --                                                                          --
   7 --                                 S p e c                                  --
   8 --                                                                          --
   9 --                             $Revision$
  10 --                                                                          --
  11 --          Copyright (C) 1992-2002 Free Software Foundation, Inc.          --
  12 --                                                                          --
  13 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
  14 -- terms of the  GNU General Public License as published  by the Free Soft- --
  15 -- ware  Foundation;  either version 2,  or (at your option) any later ver- --
  16 -- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
  17 -- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
  18 -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  19 -- for  more details.  You should have  received  a copy of the GNU General --
  20 -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
  21 -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
  22 -- MA 02111-1307, USA.                                                      --
  23 --                                                                          --
  24 -- As a special exception,  if other files  instantiate  generics from this --
  25 -- unit, or you link  this unit with other files  to produce an executable, --
  26 -- this  unit  does not  by itself cause  the resulting  executable  to  be --
  27 -- covered  by the  GNU  General  Public  License.  This exception does not --
  28 -- however invalidate  any other reasons why  the executable file  might be --
  29 -- covered by the  GNU Public License.                                      --
  30 --                                                                          --
  31 -- GNAT was originally developed  by the GNAT team at  New York University. --
  32 -- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
  33 --                                                                          --
  34 ------------------------------------------------------------------------------
  35
  36 --  Support for universal real arithmetic
  37
  38 with Types; use Types;
  39 with Uintp; use Uintp;
  40
  41 package Urealp is
  42
  43    ---------------------------------------
  44    -- Representation of Universal Reals --
  45    ---------------------------------------
  46
  47    --  A universal real value is represented by a single value (which is
  48    --  an index into an internal table). These values are not hashed, so
  49    --  the equality operator should not be used on Ureal values (instead
  50    --  use the UR_Eq function).
  51
  52    --  A Ureal value represents an arbitrary precision universal real value,
  53    --  stored internally using four components
  54
  55    --    the numerator (Uint, always non-negative)
  56    --    the denominator (Uint, always non-zero, always positive if base = 0)
  57    --    a real base (Nat, either zero, or in the range 2 .. 16)
  58    --    a sign flag (Boolean), set if negative
  59
  60    --  If the base is zero, then the absolute value of the Ureal is simply
  61    --  numerator/denominator. If the base is non-zero, then the absolute
  62    --  value is num / (rbase ** den).
  63
  64    --  Negative numbers are represented by the sign of the numerator being
  65    --  negative. The denominator is always positive.
  66
  67    --  A normalized Ureal value has base = 0, and numerator/denominator
  68    --  reduced to lowest terms, with zero itself being represented as 0/1.
  69    --  This is a canonical format, so that for normalized Ureal values it
  70    --  is the case that two equal values always have the same denominator
  71    --  and numerator values.
  72
  73    --  Note: a value of minus zero is legitimate, and the operations in
  74    --  Urealp preserve the handling of signed zeroes in accordance with
  75    --  the rules of IEEE P754 ("IEEE floating point").
  76
  77    ------------------------------
  78    -- Types for Urealp Package --
  79    ------------------------------
  80
  81    type Ureal is private;
  82    --  Type used for representation of universal reals
  83
  84    No_Ureal : constant Ureal;
  85    --  Constant used to indicate missing or unset Ureal value
  86
  87    ---------------------
  88    -- Ureal Constants --
  89    ---------------------
  90
  91    function Ureal_0 return Ureal;
  92    --  Returns value 0.0
  93
  94    function Ureal_M_0 return Ureal;
  95    --  Returns value -0.0
  96
  97    function Ureal_Tenth return Ureal;
  98    --  Returns value 0.1
  99
 100    function Ureal_Half return Ureal;
 101    --  Returns value 0.5
 102
 103    function Ureal_1 return Ureal;
 104    --  Returns value 1.0
 105
 106    function Ureal_2 return Ureal;
 107    --  Returns value 2.0
 108
 109    function Ureal_10 return Ureal;
 110    --  Returns value 10.0
 111
 112    function Ureal_100 return Ureal;
 113    --  Returns value 100.0
 114
 115    function Ureal_2_128 return Ureal;
 116    --  Returns value 2.0 ** 128
 117
 118    function Ureal_2_M_128 return Ureal;
 119    --  Returns value 2.0 ** (-128)
 120
 121    -----------------
 122    -- Subprograms --
 123    -----------------
 124
 125    procedure Initialize;
 126    --  Initialize Ureal tables. Note that Initialize must not be called if
 127    --  Tree_Read is used. Note also that there is no Lock routine in this
 128    --  unit. These tables are among the few tables that can be expanded
 129    --  during Gigi processing.
 130
 131    procedure Tree_Read;
 132    --  Initializes internal tables from current tree file using Tree_Read.
 133    --  Note that Initialize should not be called if Tree_Read is used.
 134    --  Tree_Read includes all necessary initialization.
 135
 136    procedure Tree_Write;
 137    --  Writes out internal tables to current tree file using Tree_Write
 138
 139    function Rbase (Real : Ureal) return Nat;
 140    --  Return the base of the universal real.
 141
 142    function Denominator (Real : Ureal) return Uint;
 143    --  Return the denominator of the universal real.
 144
 145    function Numerator (Real : Ureal) return Uint;
 146    --  Return the numerator of the universal real.
 147
 148    function Norm_Den (Real : Ureal) return Uint;
 149    --  Return the denominator of the universal real after a normalization.
 150
 151    function Norm_Num (Real : Ureal) return Uint;
 152    --  Return the numerator of the universal real after a normalization.
 153
 154    function UR_From_Uint (UI : Uint) return Ureal;
 155    --  Returns real corresponding to universal integer value
 156
 157    function UR_To_Uint (Real : Ureal) return Uint;
 158    --  Return integer value obtained by accurate rounding of real value.
 159    --  The rounding of values half way between two integers is away from
 160    --  zero, as required by normal Ada 95 rounding semantics.
 161
 162    function UR_Trunc (Real : Ureal) return Uint;
 163    --  Return integer value obtained by a truncation of real towards zero
 164
 165    function UR_Ceiling (Real : Ureal) return Uint;
 166    --  Return value of smallest integer not less than the given value
 167
 168    function UR_Floor (Real : Ureal) return Uint;
 169    --  Return value of smallest integer not greater than the given value
 170
 171    --  Conversion table for above four functions
 172
 173    --    Input    To_Uint    Trunc    Ceiling    Floor
 174    --     1.0        1         1         1         1
 175    --     1.2        1         1         2         1
 176    --     1.5        2         1         2         1
 177    --     1.7        2         1         2         1
 178    --     2.0        2         2         2         2
 179    --    -1.0       -1        -1        -1        -1
 180    --    -1.2       -1        -1        -1        -2
 181    --    -1.5       -2        -1        -1        -2
 182    --    -1.7       -2        -1        -1        -2
 183    --    -2.0       -2        -2        -2        -2
 184
 185    function UR_From_Components
 186      (Num      : Uint;
 187       Den      : Uint;
 188       Rbase    : Nat := 0;
 189       Negative : Boolean := False)
 190       return     Ureal;
 191    --  Builds real value from given numerator, denominator and base. The
 192    --  value is negative if Negative is set to true, and otherwise is
 193    --  non-negative.
 194
 195    function UR_Add (Left : Ureal; Right : Ureal) return Ureal;
 196    function UR_Add (Left : Ureal; Right : Uint)  return Ureal;
 197    function UR_Add (Left : Uint;  Right : Ureal) return Ureal;
 198    --  Returns real sum of operands
 199
 200    function UR_Div (Left : Ureal; Right : Ureal) return Ureal;
 201    function UR_Div (Left : Uint;  Right : Ureal) return Ureal;
 202    function UR_Div (Left : Ureal; Right : Uint)  return Ureal;
 203    --  Returns real quotient of operands. Fatal error if Right is zero
 204
 205    function UR_Mul (Left : Ureal; Right : Ureal) return Ureal;
 206    function UR_Mul (Left : Uint;  Right : Ureal) return Ureal;
 207    function UR_Mul (Left : Ureal; Right : Uint)  return Ureal;
 208    --  Returns real product of operands
 209
 210    function UR_Sub (Left : Ureal; Right : Ureal) return Ureal;
 211    function UR_Sub (Left : Uint;  Right : Ureal) return Ureal;
 212    function UR_Sub (Left : Ureal; Right : Uint)  return Ureal;
 213    --  Returns real difference of operands
 214
 215    function UR_Exponentiate (Real  : Ureal; N : Uint) return  Ureal;
 216    --  Returns result of raising Ureal to Uint power.
 217    --  Fatal error if Left is 0 and Right is negative.
 218
 219    function UR_Abs (Real : Ureal) return Ureal;
 220    --  Returns abs function of real
 221
 222    function UR_Negate (Real : Ureal) return Ureal;
 223    --  Returns negative of real
 224
 225    function UR_Eq (Left, Right : Ureal) return Boolean;
 226    --  Compares reals for equality.
 227
 228    function UR_Max (Left, Right : Ureal) return Ureal;
 229    --  Returns the maximum of two reals
 230
 231    function UR_Min (Left, Right : Ureal) return Ureal;
 232    --  Returns the minimum of two reals
 233
 234    function UR_Ne (Left, Right : Ureal) return Boolean;
 235    --  Compares reals for inequality.
 236
 237    function UR_Lt (Left, Right : Ureal) return Boolean;
 238    --  Compares reals for less than.
 239
 240    function UR_Le (Left, Right : Ureal) return Boolean;
 241    --  Compares reals for less than or equal.
 242
 243    function UR_Gt (Left, Right : Ureal) return Boolean;
 244    --  Compares reals for greater than.
 245
 246    function UR_Ge (Left, Right : Ureal) return Boolean;
 247    --  Compares reals for greater than or equal.
 248
 249    function UR_Is_Zero (Real : Ureal) return Boolean;
 250    --  Tests if real value is zero
 251
 252    function UR_Is_Negative (Real : Ureal) return Boolean;
 253    --  Tests if real value is negative, note that negative zero gives true
 254
 255    function UR_Is_Positive (Real : Ureal) return Boolean;
 256    --  Test if real value is greater than zero
 257
 258    procedure UR_Write (Real : Ureal);
 259    --  Writes value of Real to standard output. Used only for debugging and
 260    --  tree/source output. If the result is easily representable as a standard
 261    --  Ada literal, it will be given that way, but as a result of evaluation
 262    --  of static expressions, it is possible to generate constants (e.g. 1/13)
 263    --  which have no such representation. In such cases (and in cases where it
 264    --  is too much work to figure out the Ada literal), the string that is
 265    --  output is of the form [numerator/denominator].
 266
 267    procedure pr (Real : Ureal);
 268    pragma Export (Ada, pr);
 269    --  Writes value of Real to standard output with a terminating line return,
 270    --  using UR_Write as described above. This is for use from the debugger.
 271
 272    ------------------------
 273    -- Operator Renamings --
 274    ------------------------
 275
 276    function "+" (Left : Ureal; Right : Ureal) return Ureal renames UR_Add;
 277    function "+" (Left : Uint;  Right : Ureal) return Ureal renames UR_Add;
 278    function "+" (Left : Ureal; Right : Uint)  return Ureal renames UR_Add;
 279
 280    function "/" (Left : Ureal; Right : Ureal) return Ureal renames UR_Div;
 281    function "/" (Left : Uint;  Right : Ureal) return Ureal renames UR_Div;
 282    function "/" (Left : Ureal; Right : Uint)  return Ureal renames UR_Div;
 283
 284    function "*" (Left : Ureal; Right : Ureal) return Ureal renames UR_Mul;
 285    function "*" (Left : Uint;  Right : Ureal) return Ureal renames UR_Mul;
 286    function "*" (Left : Ureal; Right : Uint)  return Ureal renames UR_Mul;
 287
 288    function "-" (Left : Ureal; Right : Ureal) return Ureal renames UR_Sub;
 289    function "-" (Left : Uint;  Right : Ureal) return Ureal renames UR_Sub;
 290    function "-" (Left : Ureal; Right : Uint)  return Ureal renames UR_Sub;
 291
 292    function "**"  (Real  : Ureal; N : Uint) return Ureal
 293                                                      renames UR_Exponentiate;
 294
 295    function "abs" (Real : Ureal) return Ureal renames UR_Abs;
 296
 297    function "-"   (Real : Ureal) return Ureal renames UR_Negate;
 298
 299    function "="   (Left, Right : Ureal) return Boolean renames UR_Eq;
 300
 301    function "<"   (Left, Right : Ureal) return Boolean renames UR_Lt;
 302
 303    function "<="  (Left, Right : Ureal) return Boolean renames UR_Le;
 304
 305    function ">="  (Left, Right : Ureal) return Boolean renames UR_Ge;
 306
 307    function ">"   (Left, Right : Ureal) return Boolean renames UR_Gt;
 308
 309    -----------------------------
 310    -- Mark/Release Processing --
 311    -----------------------------
 312
 313    --  The space used by Ureal data is not automatically reclaimed. However,
 314    --  a mark-release regime is implemented which allows storage to be
 315    --  released back to a previously noted mark. This is used for example
 316    --  when doing comparisons, where only intermediate results get stored
 317    --  that do not need to be saved for future use.
 318
 319    type Save_Mark is private;
 320
 321    function Mark return Save_Mark;
 322    --  Note mark point for future release
 323
 324    procedure Release (M : Save_Mark);
 325    --  Release storage allocated since mark was noted
 326
 327    ------------------------------------
 328    -- Representation of Ureal Values --
 329    ------------------------------------
 330
 331 private
 332
 333    type Ureal is new Int range Ureal_Low_Bound .. Ureal_High_Bound;
 334    for Ureal'Size use 32;
 335
 336    No_Ureal : constant Ureal := Ureal'First;
 337
 338    type Save_Mark is new Int;
 339
 340    pragma Inline (Denominator);
 341    pragma Inline (Mark);
 342    pragma Inline (Norm_Num);
 343    pragma Inline (Norm_Den);
 344    pragma Inline (Numerator);
 345    pragma Inline (Rbase);
 346    pragma Inline (Release);
 347    pragma Inline (Ureal_0);
 348    pragma Inline (Ureal_M_0);
 349    pragma Inline (Ureal_Tenth);
 350    pragma Inline (Ureal_Half);
 351    pragma Inline (Ureal_1);
 352    pragma Inline (Ureal_2);
 353    pragma Inline (Ureal_10);
 354    pragma Inline (UR_From_Components);
 355
 356 end Urealp;