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