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-2019, 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 3, 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. -- 17-- -- 18-- As a special exception under Section 7 of GPL version 3, you are granted -- 19-- additional permissions described in the GCC Runtime Library Exception, -- 20-- version 3.1, as published by the Free Software Foundation. -- 21-- -- 22-- You should have received a copy of the GNU General Public License and -- 23-- a copy of the GCC Runtime Library Exception along with this program; -- 24-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- 25-- <http://www.gnu.org/licenses/>. -- 26-- -- 27-- GNAT was originally developed by the GNAT team at New York University. -- 28-- Extensive contributions were provided by Ada Core Technologies Inc. -- 29-- -- 30------------------------------------------------------------------------------ 31 32-- Support for universal real arithmetic 33 34-- WARNING: There is a C version of this package. Any changes to this 35-- source file must be properly reflected in the C header file urealp.h 36 37with Types; use Types; 38with Uintp; use Uintp; 39 40package Urealp is 41 42 --------------------------------------- 43 -- Representation of Universal Reals -- 44 --------------------------------------- 45 46 -- A universal real value is represented by a single value (which is 47 -- an index into an internal table). These values are not hashed, so 48 -- the equality operator should not be used on Ureal values (instead 49 -- use the UR_Eq function). 50 51 -- A Ureal value represents an arbitrary precision universal real value, 52 -- stored internally using four components: 53 54 -- the numerator (Uint, always non-negative) 55 -- the denominator (Uint, always non-zero, always positive if base = 0) 56 -- a real base (Nat, either zero, or in the range 2 .. 16) 57 -- a sign flag (Boolean), set if negative 58 59 -- Negative numbers are represented by the sign flag being True. 60 61 -- If the base is zero, then the absolute value of the Ureal is simply 62 -- numerator/denominator, where denominator is positive. If the base is 63 -- non-zero, then the absolute value is numerator / (base ** denominator). 64 -- In that case, since base is positive, (base ** denominator) is also 65 -- positive, even when denominator is negative or null. 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_80 return Ureal; 116 -- Returns value 2.0 ** 80 117 118 function Ureal_2_M_80 return Ureal; 119 -- Returns value 2.0 ** (-80) 120 121 function Ureal_2_128 return Ureal; 122 -- Returns value 2.0 ** 128 123 124 function Ureal_2_M_128 return Ureal; 125 -- Returns value 2.0 ** (-128) 126 127 function Ureal_10_36 return Ureal; 128 -- Returns value 10.0 ** 36 129 130 function Ureal_M_10_36 return Ureal; 131 -- Returns value -10.0 ** 36 132 133 ----------------- 134 -- Subprograms -- 135 ----------------- 136 137 procedure Initialize; 138 -- Initialize Ureal tables. Note that Initialize must not be called if 139 -- Tree_Read is used. Note also that there is no Lock routine in this 140 -- unit. These tables are among the few tables that can be expanded 141 -- during Gigi processing. 142 143 procedure Tree_Read; 144 -- Initializes internal tables from current tree file using the relevant 145 -- Table.Tree_Read routines. Note that Initialize should not be called if 146 -- Tree_Read is used. Tree_Read includes all necessary initialization. 147 148 procedure Tree_Write; 149 -- Writes out internal tables to current tree file using the relevant 150 -- Table.Tree_Write routines. 151 152 function Rbase (Real : Ureal) return Nat; 153 -- Return the base of the universal real 154 155 function Denominator (Real : Ureal) return Uint; 156 -- Return the denominator of the universal real 157 158 function Numerator (Real : Ureal) return Uint; 159 -- Return the numerator of the universal real 160 161 function Norm_Den (Real : Ureal) return Uint; 162 -- Return the denominator of the universal real after a normalization 163 164 function Norm_Num (Real : Ureal) return Uint; 165 -- Return the numerator of the universal real after a normalization 166 167 function UR_From_Uint (UI : Uint) return Ureal; 168 -- Returns real corresponding to universal integer value 169 170 function UR_To_Uint (Real : Ureal) return Uint; 171 -- Return integer value obtained by accurate rounding of real value. 172 -- The rounding of values half way between two integers is away from 173 -- zero, as required by normal Ada 95 rounding semantics. 174 175 function UR_Trunc (Real : Ureal) return Uint; 176 -- Return integer value obtained by a truncation of real towards zero 177 178 function UR_Ceiling (Real : Ureal) return Uint; 179 -- Return value of smallest integer not less than the given value 180 181 function UR_Floor (Real : Ureal) return Uint; 182 -- Return value of smallest integer not greater than the given value 183 184 -- Conversion table for above four functions 185 186 -- Input To_Uint Trunc Ceiling Floor 187 -- 1.0 1 1 1 1 188 -- 1.2 1 1 2 1 189 -- 1.5 2 1 2 1 190 -- 1.7 2 1 2 1 191 -- 2.0 2 2 2 2 192 -- -1.0 -1 -1 -1 -1 193 -- -1.2 -1 -1 -1 -2 194 -- -1.5 -2 -1 -1 -2 195 -- -1.7 -2 -1 -1 -2 196 -- -2.0 -2 -2 -2 -2 197 198 function UR_From_Components 199 (Num : Uint; 200 Den : Uint; 201 Rbase : Nat := 0; 202 Negative : Boolean := False) 203 return Ureal; 204 -- Builds real value from given numerator, denominator and base. The 205 -- value is negative if Negative is set to true, and otherwise is 206 -- non-negative. 207 208 function UR_Add (Left : Ureal; Right : Ureal) return Ureal; 209 function UR_Add (Left : Ureal; Right : Uint) return Ureal; 210 function UR_Add (Left : Uint; Right : Ureal) return Ureal; 211 -- Returns real sum of operands 212 213 function UR_Div (Left : Ureal; Right : Ureal) return Ureal; 214 function UR_Div (Left : Uint; Right : Ureal) return Ureal; 215 function UR_Div (Left : Ureal; Right : Uint) return Ureal; 216 -- Returns real quotient of operands. Fatal error if Right is zero 217 218 function UR_Mul (Left : Ureal; Right : Ureal) return Ureal; 219 function UR_Mul (Left : Uint; Right : Ureal) return Ureal; 220 function UR_Mul (Left : Ureal; Right : Uint) return Ureal; 221 -- Returns real product of operands 222 223 function UR_Sub (Left : Ureal; Right : Ureal) return Ureal; 224 function UR_Sub (Left : Uint; Right : Ureal) return Ureal; 225 function UR_Sub (Left : Ureal; Right : Uint) return Ureal; 226 -- Returns real difference of operands 227 228 function UR_Exponentiate (Real : Ureal; N : Uint) return Ureal; 229 -- Returns result of raising Ureal to Uint power. 230 -- Fatal error if Left is 0 and Right is negative. 231 232 function UR_Abs (Real : Ureal) return Ureal; 233 -- Returns abs function of real 234 235 function UR_Negate (Real : Ureal) return Ureal; 236 -- Returns negative of real 237 238 function UR_Eq (Left, Right : Ureal) return Boolean; 239 -- Compares reals for equality 240 241 function UR_Max (Left, Right : Ureal) return Ureal; 242 -- Returns the maximum of two reals 243 244 function UR_Min (Left, Right : Ureal) return Ureal; 245 -- Returns the minimum of two reals 246 247 function UR_Ne (Left, Right : Ureal) return Boolean; 248 -- Compares reals for inequality 249 250 function UR_Lt (Left, Right : Ureal) return Boolean; 251 -- Compares reals for less than 252 253 function UR_Le (Left, Right : Ureal) return Boolean; 254 -- Compares reals for less than or equal 255 256 function UR_Gt (Left, Right : Ureal) return Boolean; 257 -- Compares reals for greater than 258 259 function UR_Ge (Left, Right : Ureal) return Boolean; 260 -- Compares reals for greater than or equal 261 262 function UR_Is_Zero (Real : Ureal) return Boolean; 263 -- Tests if real value is zero 264 265 function UR_Is_Negative (Real : Ureal) return Boolean; 266 -- Tests if real value is negative, note that negative zero gives true 267 268 function UR_Is_Positive (Real : Ureal) return Boolean; 269 -- Test if real value is greater than zero 270 271 procedure UR_Write (Real : Ureal; Brackets : Boolean := False); 272 -- Writes value of Real to standard output. Used for debugging and 273 -- tree/source output, and also for -gnatR representation output. If the 274 -- result is easily representable as a standard Ada literal, it will be 275 -- given that way, but as a result of evaluation of static expressions, it 276 -- is possible to generate constants (e.g. 1/13) which have no such 277 -- representation. In such cases (and in cases where it is too much work to 278 -- figure out the Ada literal), the string that is output is of the form 279 -- of some expression such as integer/integer, or integer*integer**integer. 280 -- In the case where an expression is output, if Brackets is set to True, 281 -- the expression is surrounded by square brackets. 282 283 procedure pr (Real : Ureal); 284 pragma Export (Ada, pr); 285 -- Writes value of Real to standard output with a terminating line return, 286 -- using UR_Write as described above. This is for use from the debugger. 287 288 ------------------------ 289 -- Operator Renamings -- 290 ------------------------ 291 292 function "+" (Left : Ureal; Right : Ureal) return Ureal renames UR_Add; 293 function "+" (Left : Uint; Right : Ureal) return Ureal renames UR_Add; 294 function "+" (Left : Ureal; Right : Uint) return Ureal renames UR_Add; 295 296 function "/" (Left : Ureal; Right : Ureal) return Ureal renames UR_Div; 297 function "/" (Left : Uint; Right : Ureal) return Ureal renames UR_Div; 298 function "/" (Left : Ureal; Right : Uint) return Ureal renames UR_Div; 299 300 function "*" (Left : Ureal; Right : Ureal) return Ureal renames UR_Mul; 301 function "*" (Left : Uint; Right : Ureal) return Ureal renames UR_Mul; 302 function "*" (Left : Ureal; Right : Uint) return Ureal renames UR_Mul; 303 304 function "-" (Left : Ureal; Right : Ureal) return Ureal renames UR_Sub; 305 function "-" (Left : Uint; Right : Ureal) return Ureal renames UR_Sub; 306 function "-" (Left : Ureal; Right : Uint) return Ureal renames UR_Sub; 307 308 function "**" (Real : Ureal; N : Uint) return Ureal 309 renames UR_Exponentiate; 310 311 function "abs" (Real : Ureal) return Ureal renames UR_Abs; 312 313 function "-" (Real : Ureal) return Ureal renames UR_Negate; 314 315 function "=" (Left, Right : Ureal) return Boolean renames UR_Eq; 316 317 function "<" (Left, Right : Ureal) return Boolean renames UR_Lt; 318 319 function "<=" (Left, Right : Ureal) return Boolean renames UR_Le; 320 321 function ">=" (Left, Right : Ureal) return Boolean renames UR_Ge; 322 323 function ">" (Left, Right : Ureal) return Boolean renames UR_Gt; 324 325 ----------------------------- 326 -- Mark/Release Processing -- 327 ----------------------------- 328 329 -- The space used by Ureal data is not automatically reclaimed. However, 330 -- a mark-release regime is implemented which allows storage to be 331 -- released back to a previously noted mark. This is used for example 332 -- when doing comparisons, where only intermediate results get stored 333 -- that do not need to be saved for future use. 334 335 type Save_Mark is private; 336 337 function Mark return Save_Mark; 338 -- Note mark point for future release 339 340 procedure Release (M : Save_Mark); 341 -- Release storage allocated since mark was noted 342 343 ------------------------------------ 344 -- Representation of Ureal Values -- 345 ------------------------------------ 346 347private 348 349 type Ureal is new Int range Ureal_Low_Bound .. Ureal_High_Bound; 350 for Ureal'Size use 32; 351 352 No_Ureal : constant Ureal := Ureal'First; 353 354 type Save_Mark is new Int; 355 356 pragma Inline (Denominator); 357 pragma Inline (Mark); 358 pragma Inline (Norm_Num); 359 pragma Inline (Norm_Den); 360 pragma Inline (Numerator); 361 pragma Inline (Rbase); 362 pragma Inline (Release); 363 pragma Inline (Ureal_0); 364 pragma Inline (Ureal_M_0); 365 pragma Inline (Ureal_Tenth); 366 pragma Inline (Ureal_Half); 367 pragma Inline (Ureal_1); 368 pragma Inline (Ureal_2); 369 pragma Inline (Ureal_10); 370 pragma Inline (UR_From_Components); 371 372end Urealp; 373