1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
9 -- Copyright (C) 1992-2005, Free Software Foundation, Inc. --
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, 51 Franklin Street, Fifth Floor, --
20 -- Boston, MA 02110-1301, USA. --
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. --
29 -- GNAT was originally developed by the GNAT team at New York University. --
30 -- Extensive contributions were provided by Ada Core Technologies Inc. --
32 ------------------------------------------------------------------------------
34 -- Support for universal real arithmetic
36 with Types
; use Types
;
37 with Uintp
; use Uintp
;
41 ---------------------------------------
42 -- Representation of Universal Reals --
43 ---------------------------------------
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).
50 -- A Ureal value represents an arbitrary precision universal real value,
51 -- stored internally using four components
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
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).
62 -- Negative numbers are represented by the sign of the numerator being
63 -- negative. The denominator is always positive.
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.
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").
75 ------------------------------
76 -- Types for Urealp Package --
77 ------------------------------
79 type Ureal
is private;
80 -- Type used for representation of universal reals
82 No_Ureal
: constant Ureal
;
83 -- Constant used to indicate missing or unset Ureal value
89 function Ureal_0
return Ureal
;
92 function Ureal_M_0
return Ureal
;
95 function Ureal_Tenth
return Ureal
;
98 function Ureal_Half
return Ureal
;
101 function Ureal_1
return Ureal
;
104 function Ureal_2
return Ureal
;
107 function Ureal_10
return Ureal
;
108 -- Returns value 10.0
110 function Ureal_100
return Ureal
;
111 -- Returns value 100.0
113 function Ureal_2_80
return Ureal
;
114 -- Returns value 2.0 ** 80
116 function Ureal_2_M_80
return Ureal
;
117 -- Returns value 2.0 ** (-80)
119 function Ureal_2_128
return Ureal
;
120 -- Returns value 2.0 ** 128
122 function Ureal_2_M_128
return Ureal
;
123 -- Returns value 2.0 ** (-128)
125 function Ureal_10_36
return Ureal
;
126 -- Returns value 10.0 ** 36
128 function Ureal_M_10_36
return Ureal
;
129 -- Returns value -(10.0
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.
142 -- Initializes internal tables from current tree file using the relevant
143 -- Table.Tree_Read routines. Note that Initialize should not be called if
144 -- Tree_Read is used. Tree_Read includes all necessary initialization.
146 procedure Tree_Write
;
147 -- Writes out internal tables to current tree file using the relevant
148 -- Table.Tree_Write routines.
150 function Rbase
(Real
: Ureal
) return Nat
;
151 -- Return the base of the universal real
153 function Denominator
(Real
: Ureal
) return Uint
;
154 -- Return the denominator of the universal real
156 function Numerator
(Real
: Ureal
) return Uint
;
157 -- Return the numerator of the universal real
159 function Norm_Den
(Real
: Ureal
) return Uint
;
160 -- Return the denominator of the universal real after a normalization
162 function Norm_Num
(Real
: Ureal
) return Uint
;
163 -- Return the numerator of the universal real after a normalization
165 function UR_From_Uint
(UI
: Uint
) return Ureal
;
166 -- Returns real corresponding to universal integer value
168 function UR_To_Uint
(Real
: Ureal
) return Uint
;
169 -- Return integer value obtained by accurate rounding of real value.
170 -- The rounding of values half way between two integers is away from
171 -- zero, as required by normal Ada 95 rounding semantics.
173 function UR_Trunc
(Real
: Ureal
) return Uint
;
174 -- Return integer value obtained by a truncation of real towards zero
176 function UR_Ceiling
(Real
: Ureal
) return Uint
;
177 -- Return value of smallest integer not less than the given value
179 function UR_Floor
(Real
: Ureal
) return Uint
;
180 -- Return value of smallest integer not greater than the given value
182 -- Conversion table for above four functions
184 -- Input To_Uint Trunc Ceiling Floor
196 function UR_From_Components
200 Negative
: Boolean := False)
202 -- Builds real value from given numerator, denominator and base. The
203 -- value is negative if Negative is set to true, and otherwise is
206 function UR_Add
(Left
: Ureal
; Right
: Ureal
) return Ureal
;
207 function UR_Add
(Left
: Ureal
; Right
: Uint
) return Ureal
;
208 function UR_Add
(Left
: Uint
; Right
: Ureal
) return Ureal
;
209 -- Returns real sum of operands
211 function UR_Div
(Left
: Ureal
; Right
: Ureal
) return Ureal
;
212 function UR_Div
(Left
: Uint
; Right
: Ureal
) return Ureal
;
213 function UR_Div
(Left
: Ureal
; Right
: Uint
) return Ureal
;
214 -- Returns real quotient of operands. Fatal error if Right is zero
216 function UR_Mul
(Left
: Ureal
; Right
: Ureal
) return Ureal
;
217 function UR_Mul
(Left
: Uint
; Right
: Ureal
) return Ureal
;
218 function UR_Mul
(Left
: Ureal
; Right
: Uint
) return Ureal
;
219 -- Returns real product of operands
221 function UR_Sub
(Left
: Ureal
; Right
: Ureal
) return Ureal
;
222 function UR_Sub
(Left
: Uint
; Right
: Ureal
) return Ureal
;
223 function UR_Sub
(Left
: Ureal
; Right
: Uint
) return Ureal
;
224 -- Returns real difference of operands
226 function UR_Exponentiate
(Real
: Ureal
; N
: Uint
) return Ureal
;
227 -- Returns result of raising Ureal to Uint power.
228 -- Fatal error if Left is 0 and Right is negative.
230 function UR_Abs
(Real
: Ureal
) return Ureal
;
231 -- Returns abs function of real
233 function UR_Negate
(Real
: Ureal
) return Ureal
;
234 -- Returns negative of real
236 function UR_Eq
(Left
, Right
: Ureal
) return Boolean;
237 -- Compares reals for equality
239 function UR_Max
(Left
, Right
: Ureal
) return Ureal
;
240 -- Returns the maximum of two reals
242 function UR_Min
(Left
, Right
: Ureal
) return Ureal
;
243 -- Returns the minimum of two reals
245 function UR_Ne
(Left
, Right
: Ureal
) return Boolean;
246 -- Compares reals for inequality
248 function UR_Lt
(Left
, Right
: Ureal
) return Boolean;
249 -- Compares reals for less than
251 function UR_Le
(Left
, Right
: Ureal
) return Boolean;
252 -- Compares reals for less than or equal
254 function UR_Gt
(Left
, Right
: Ureal
) return Boolean;
255 -- Compares reals for greater than
257 function UR_Ge
(Left
, Right
: Ureal
) return Boolean;
258 -- Compares reals for greater than or equal
260 function UR_Is_Zero
(Real
: Ureal
) return Boolean;
261 -- Tests if real value is zero
263 function UR_Is_Negative
(Real
: Ureal
) return Boolean;
264 -- Tests if real value is negative, note that negative zero gives true
266 function UR_Is_Positive
(Real
: Ureal
) return Boolean;
267 -- Test if real value is greater than zero
269 procedure UR_Write
(Real
: Ureal
);
270 -- Writes value of Real to standard output. Used only for debugging and
271 -- tree/source output. If the result is easily representable as a standard
272 -- Ada literal, it will be given that way, but as a result of evaluation
273 -- of static expressions, it is possible to generate constants (e.g. 1/13)
274 -- which have no such representation. In such cases (and in cases where it
275 -- is too much work to figure out the Ada literal), the string that is
276 -- output is of the form [numerator/denominator].
278 procedure pr
(Real
: Ureal
);
279 pragma Export
(Ada
, pr
);
280 -- Writes value of Real to standard output with a terminating line return,
281 -- using UR_Write as described above. This is for use from the debugger.
283 ------------------------
284 -- Operator Renamings --
285 ------------------------
287 function "+" (Left
: Ureal
; Right
: Ureal
) return Ureal
renames UR_Add
;
288 function "+" (Left
: Uint
; Right
: Ureal
) return Ureal
renames UR_Add
;
289 function "+" (Left
: Ureal
; Right
: Uint
) return Ureal
renames UR_Add
;
291 function "/" (Left
: Ureal
; Right
: Ureal
) return Ureal
renames UR_Div
;
292 function "/" (Left
: Uint
; Right
: Ureal
) return Ureal
renames UR_Div
;
293 function "/" (Left
: Ureal
; Right
: Uint
) return Ureal
renames UR_Div
;
295 function "*" (Left
: Ureal
; Right
: Ureal
) return Ureal
renames UR_Mul
;
296 function "*" (Left
: Uint
; Right
: Ureal
) return Ureal
renames UR_Mul
;
297 function "*" (Left
: Ureal
; Right
: Uint
) return Ureal
renames UR_Mul
;
299 function "-" (Left
: Ureal
; Right
: Ureal
) return Ureal
renames UR_Sub
;
300 function "-" (Left
: Uint
; Right
: Ureal
) return Ureal
renames UR_Sub
;
301 function "-" (Left
: Ureal
; Right
: Uint
) return Ureal
renames UR_Sub
;
303 function "**" (Real
: Ureal
; N
: Uint
) return Ureal
304 renames UR_Exponentiate
;
306 function "abs" (Real
: Ureal
) return Ureal
renames UR_Abs
;
308 function "-" (Real
: Ureal
) return Ureal
renames UR_Negate
;
310 function "=" (Left
, Right
: Ureal
) return Boolean renames UR_Eq
;
312 function "<" (Left
, Right
: Ureal
) return Boolean renames UR_Lt
;
314 function "<=" (Left
, Right
: Ureal
) return Boolean renames UR_Le
;
316 function ">=" (Left
, Right
: Ureal
) return Boolean renames UR_Ge
;
318 function ">" (Left
, Right
: Ureal
) return Boolean renames UR_Gt
;
320 -----------------------------
321 -- Mark/Release Processing --
322 -----------------------------
324 -- The space used by Ureal data is not automatically reclaimed. However,
325 -- a mark-release regime is implemented which allows storage to be
326 -- released back to a previously noted mark. This is used for example
327 -- when doing comparisons, where only intermediate results get stored
328 -- that do not need to be saved for future use.
330 type Save_Mark
is private;
332 function Mark
return Save_Mark
;
333 -- Note mark point for future release
335 procedure Release
(M
: Save_Mark
);
336 -- Release storage allocated since mark was noted
338 ------------------------------------
339 -- Representation of Ureal Values --
340 ------------------------------------
344 type Ureal
is new Int
range Ureal_Low_Bound
.. Ureal_High_Bound
;
345 for Ureal
'Size use 32;
347 No_Ureal
: constant Ureal
:= Ureal
'First;
349 type Save_Mark
is new Int
;
351 pragma Inline
(Denominator
);
352 pragma Inline
(Mark
);
353 pragma Inline
(Norm_Num
);
354 pragma Inline
(Norm_Den
);
355 pragma Inline
(Numerator
);
356 pragma Inline
(Rbase
);
357 pragma Inline
(Release
);
358 pragma Inline
(Ureal_0
);
359 pragma Inline
(Ureal_M_0
);
360 pragma Inline
(Ureal_Tenth
);
361 pragma Inline
(Ureal_Half
);
362 pragma Inline
(Ureal_1
);
363 pragma Inline
(Ureal_2
);
364 pragma Inline
(Ureal_10
);
365 pragma Inline
(UR_From_Components
);