1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
9 -- Copyright (C) 1992-2003 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, 59 Temple Place - Suite 330, Boston, --
20 -- MA 02111-1307, 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 Tree_Read.
143 -- Note that Initialize should not be called if Tree_Read is used.
144 -- Tree_Read includes all necessary initialization.
146 procedure Tree_Write
;
147 -- Writes out internal tables to current tree file using Tree_Write
149 function Rbase
(Real
: Ureal
) return Nat
;
150 -- Return the base of the universal real.
152 function Denominator
(Real
: Ureal
) return Uint
;
153 -- Return the denominator of the universal real.
155 function Numerator
(Real
: Ureal
) return Uint
;
156 -- Return the numerator of the universal real.
158 function Norm_Den
(Real
: Ureal
) return Uint
;
159 -- Return the denominator of the universal real after a normalization.
161 function Norm_Num
(Real
: Ureal
) return Uint
;
162 -- Return the numerator of the universal real after a normalization.
164 function UR_From_Uint
(UI
: Uint
) return Ureal
;
165 -- Returns real corresponding to universal integer value
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.
172 function UR_Trunc
(Real
: Ureal
) return Uint
;
173 -- Return integer value obtained by a truncation of real towards zero
175 function UR_Ceiling
(Real
: Ureal
) return Uint
;
176 -- Return value of smallest integer not less than the given value
178 function UR_Floor
(Real
: Ureal
) return Uint
;
179 -- Return value of smallest integer not greater than the given value
181 -- Conversion table for above four functions
183 -- Input To_Uint Trunc Ceiling Floor
195 function UR_From_Components
199 Negative
: Boolean := False)
201 -- Builds real value from given numerator, denominator and base. The
202 -- value is negative if Negative is set to true, and otherwise is
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
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
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
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
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.
229 function UR_Abs
(Real
: Ureal
) return Ureal
;
230 -- Returns abs function of real
232 function UR_Negate
(Real
: Ureal
) return Ureal
;
233 -- Returns negative of real
235 function UR_Eq
(Left
, Right
: Ureal
) return Boolean;
236 -- Compares reals for equality.
238 function UR_Max
(Left
, Right
: Ureal
) return Ureal
;
239 -- Returns the maximum of two reals
241 function UR_Min
(Left
, Right
: Ureal
) return Ureal
;
242 -- Returns the minimum of two reals
244 function UR_Ne
(Left
, Right
: Ureal
) return Boolean;
245 -- Compares reals for inequality.
247 function UR_Lt
(Left
, Right
: Ureal
) return Boolean;
248 -- Compares reals for less than.
250 function UR_Le
(Left
, Right
: Ureal
) return Boolean;
251 -- Compares reals for less than or equal.
253 function UR_Gt
(Left
, Right
: Ureal
) return Boolean;
254 -- Compares reals for greater than.
256 function UR_Ge
(Left
, Right
: Ureal
) return Boolean;
257 -- Compares reals for greater than or equal.
259 function UR_Is_Zero
(Real
: Ureal
) return Boolean;
260 -- Tests if real value is zero
262 function UR_Is_Negative
(Real
: Ureal
) return Boolean;
263 -- Tests if real value is negative, note that negative zero gives true
265 function UR_Is_Positive
(Real
: Ureal
) return Boolean;
266 -- Test if real value is greater than zero
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].
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.
282 ------------------------
283 -- Operator Renamings --
284 ------------------------
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
;
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
;
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
;
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
;
302 function "**" (Real
: Ureal
; N
: Uint
) return Ureal
303 renames UR_Exponentiate
;
305 function "abs" (Real
: Ureal
) return Ureal
renames UR_Abs
;
307 function "-" (Real
: Ureal
) return Ureal
renames UR_Negate
;
309 function "=" (Left
, Right
: Ureal
) return Boolean renames UR_Eq
;
311 function "<" (Left
, Right
: Ureal
) return Boolean renames UR_Lt
;
313 function "<=" (Left
, Right
: Ureal
) return Boolean renames UR_Le
;
315 function ">=" (Left
, Right
: Ureal
) return Boolean renames UR_Ge
;
317 function ">" (Left
, Right
: Ureal
) return Boolean renames UR_Gt
;
319 -----------------------------
320 -- Mark/Release Processing --
321 -----------------------------
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.
329 type Save_Mark
is private;
331 function Mark
return Save_Mark
;
332 -- Note mark point for future release
334 procedure Release
(M
: Save_Mark
);
335 -- Release storage allocated since mark was noted
337 ------------------------------------
338 -- Representation of Ureal Values --
339 ------------------------------------
343 type Ureal
is new Int
range Ureal_Low_Bound
.. Ureal_High_Bound
;
344 for Ureal
'Size use 32;
346 No_Ureal
: constant Ureal
:= Ureal
'First;
348 type Save_Mark
is new Int
;
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
);