|
111
|
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-2013, 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 with Types; use Types;
|
|
|
35 with Uintp; use Uintp;
|
|
|
36
|
|
|
37 package Urealp is
|
|
|
38
|
|
|
39 ---------------------------------------
|
|
|
40 -- Representation of Universal Reals --
|
|
|
41 ---------------------------------------
|
|
|
42
|
|
|
43 -- A universal real value is represented by a single value (which is
|
|
|
44 -- an index into an internal table). These values are not hashed, so
|
|
|
45 -- the equality operator should not be used on Ureal values (instead
|
|
|
46 -- use the UR_Eq function).
|
|
|
47
|
|
|
48 -- A Ureal value represents an arbitrary precision universal real value,
|
|
|
49 -- stored internally using four components:
|
|
|
50
|
|
|
51 -- the numerator (Uint, always non-negative)
|
|
|
52 -- the denominator (Uint, always non-zero, always positive if base = 0)
|
|
|
53 -- a real base (Nat, either zero, or in the range 2 .. 16)
|
|
|
54 -- a sign flag (Boolean), set if negative
|
|
|
55
|
|
|
56 -- Negative numbers are represented by the sign flag being True.
|
|
|
57
|
|
|
58 -- If the base is zero, then the absolute value of the Ureal is simply
|
|
|
59 -- numerator/denominator, where denominator is positive. If the base is
|
|
|
60 -- non-zero, then the absolute value is numerator / (base ** denominator).
|
|
|
61 -- In that case, since base is positive, (base ** denominator) is also
|
|
|
62 -- positive, even when denominator is negative or null.
|
|
|
63
|
|
|
64 -- A normalized Ureal value has base = 0, and numerator/denominator
|
|
|
65 -- reduced to lowest terms, with zero itself being represented as 0/1.
|
|
|
66 -- This is a canonical format, so that for normalized Ureal values it
|
|
|
67 -- is the case that two equal values always have the same denominator
|
|
|
68 -- and numerator values.
|
|
|
69
|
|
|
70 -- Note: a value of minus zero is legitimate, and the operations in
|
|
|
71 -- Urealp preserve the handling of signed zeroes in accordance with
|
|
|
72 -- the rules of IEEE P754 ("IEEE floating point").
|
|
|
73
|
|
|
74 ------------------------------
|
|
|
75 -- Types for Urealp Package --
|
|
|
76 ------------------------------
|
|
|
77
|
|
|
78 type Ureal is private;
|
|
|
79 -- Type used for representation of universal reals
|
|
|
80
|
|
|
81 No_Ureal : constant Ureal;
|
|
|
82 -- Constant used to indicate missing or unset Ureal value
|
|
|
83
|
|
|
84 ---------------------
|
|
|
85 -- Ureal Constants --
|
|
|
86 ---------------------
|
|
|
87
|
|
|
88 function Ureal_0 return Ureal;
|
|
|
89 -- Returns value 0.0
|
|
|
90
|
|
|
91 function Ureal_M_0 return Ureal;
|
|
|
92 -- Returns value -0.0
|
|
|
93
|
|
|
94 function Ureal_Tenth return Ureal;
|
|
|
95 -- Returns value 0.1
|
|
|
96
|
|
|
97 function Ureal_Half return Ureal;
|
|
|
98 -- Returns value 0.5
|
|
|
99
|
|
|
100 function Ureal_1 return Ureal;
|
|
|
101 -- Returns value 1.0
|
|
|
102
|
|
|
103 function Ureal_2 return Ureal;
|
|
|
104 -- Returns value 2.0
|
|
|
105
|
|
|
106 function Ureal_10 return Ureal;
|
|
|
107 -- Returns value 10.0
|
|
|
108
|
|
|
109 function Ureal_100 return Ureal;
|
|
|
110 -- Returns value 100.0
|
|
|
111
|
|
|
112 function Ureal_2_80 return Ureal;
|
|
|
113 -- Returns value 2.0 ** 80
|
|
|
114
|
|
|
115 function Ureal_2_M_80 return Ureal;
|
|
|
116 -- Returns value 2.0 ** (-80)
|
|
|
117
|
|
|
118 function Ureal_2_128 return Ureal;
|
|
|
119 -- Returns value 2.0 ** 128
|
|
|
120
|
|
|
121 function Ureal_2_M_128 return Ureal;
|
|
|
122 -- Returns value 2.0 ** (-128)
|
|
|
123
|
|
|
124 function Ureal_10_36 return Ureal;
|
|
|
125 -- Returns value 10.0 ** 36
|
|
|
126
|
|
|
127 function Ureal_M_10_36 return Ureal;
|
|
|
128 -- Returns value -10.0 ** 36
|
|
|
129
|
|
|
130 -----------------
|
|
|
131 -- Subprograms --
|
|
|
132 -----------------
|
|
|
133
|
|
|
134 procedure Initialize;
|
|
|
135 -- Initialize Ureal tables. Note that Initialize must not be called if
|
|
|
136 -- Tree_Read is used. Note also that there is no Lock routine in this
|
|
|
137 -- unit. These tables are among the few tables that can be expanded
|
|
|
138 -- during Gigi processing.
|
|
|
139
|
|
|
140 procedure Tree_Read;
|
|
|
141 -- Initializes internal tables from current tree file using the relevant
|
|
|
142 -- Table.Tree_Read routines. Note that Initialize should not be called if
|
|
|
143 -- Tree_Read is used. Tree_Read includes all necessary initialization.
|
|
|
144
|
|
|
145 procedure Tree_Write;
|
|
|
146 -- Writes out internal tables to current tree file using the relevant
|
|
|
147 -- Table.Tree_Write routines.
|
|
|
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; Brackets : Boolean := False);
|
|
|
269 -- Writes value of Real to standard output. Used for debugging and
|
|
|
270 -- tree/source output, and also for -gnatR representation output. If the
|
|
|
271 -- result is easily representable as a standard Ada literal, it will be
|
|
|
272 -- given that way, but as a result of evaluation of static expressions, it
|
|
|
273 -- is possible to generate constants (e.g. 1/13) which have no such
|
|
|
274 -- representation. In such cases (and in cases where it is too much work to
|
|
|
275 -- figure out the Ada literal), the string that is output is of the form
|
|
|
276 -- of some expression such as integer/integer, or integer*integer**integer.
|
|
|
277 -- In the case where an expression is output, if Brackets is set to True,
|
|
|
278 -- the expression is surrounded by square brackets.
|
|
|
279
|
|
|
280 procedure pr (Real : Ureal);
|
|
|
281 pragma Export (Ada, pr);
|
|
|
282 -- Writes value of Real to standard output with a terminating line return,
|
|
|
283 -- using UR_Write as described above. This is for use from the debugger.
|
|
|
284
|
|
|
285 ------------------------
|
|
|
286 -- Operator Renamings --
|
|
|
287 ------------------------
|
|
|
288
|
|
|
289 function "+" (Left : Ureal; Right : Ureal) return Ureal renames UR_Add;
|
|
|
290 function "+" (Left : Uint; Right : Ureal) return Ureal renames UR_Add;
|
|
|
291 function "+" (Left : Ureal; Right : Uint) return Ureal renames UR_Add;
|
|
|
292
|
|
|
293 function "/" (Left : Ureal; Right : Ureal) return Ureal renames UR_Div;
|
|
|
294 function "/" (Left : Uint; Right : Ureal) return Ureal renames UR_Div;
|
|
|
295 function "/" (Left : Ureal; Right : Uint) return Ureal renames UR_Div;
|
|
|
296
|
|
|
297 function "*" (Left : Ureal; Right : Ureal) return Ureal renames UR_Mul;
|
|
|
298 function "*" (Left : Uint; Right : Ureal) return Ureal renames UR_Mul;
|
|
|
299 function "*" (Left : Ureal; Right : Uint) return Ureal renames UR_Mul;
|
|
|
300
|
|
|
301 function "-" (Left : Ureal; Right : Ureal) return Ureal renames UR_Sub;
|
|
|
302 function "-" (Left : Uint; Right : Ureal) return Ureal renames UR_Sub;
|
|
|
303 function "-" (Left : Ureal; Right : Uint) return Ureal renames UR_Sub;
|
|
|
304
|
|
|
305 function "**" (Real : Ureal; N : Uint) return Ureal
|
|
|
306 renames UR_Exponentiate;
|
|
|
307
|
|
|
308 function "abs" (Real : Ureal) return Ureal renames UR_Abs;
|
|
|
309
|
|
|
310 function "-" (Real : Ureal) return Ureal renames UR_Negate;
|
|
|
311
|
|
|
312 function "=" (Left, Right : Ureal) return Boolean renames UR_Eq;
|
|
|
313
|
|
|
314 function "<" (Left, Right : Ureal) return Boolean renames UR_Lt;
|
|
|
315
|
|
|
316 function "<=" (Left, Right : Ureal) return Boolean renames UR_Le;
|
|
|
317
|
|
|
318 function ">=" (Left, Right : Ureal) return Boolean renames UR_Ge;
|
|
|
319
|
|
|
320 function ">" (Left, Right : Ureal) return Boolean renames UR_Gt;
|
|
|
321
|
|
|
322 -----------------------------
|
|
|
323 -- Mark/Release Processing --
|
|
|
324 -----------------------------
|
|
|
325
|
|
|
326 -- The space used by Ureal data is not automatically reclaimed. However,
|
|
|
327 -- a mark-release regime is implemented which allows storage to be
|
|
|
328 -- released back to a previously noted mark. This is used for example
|
|
|
329 -- when doing comparisons, where only intermediate results get stored
|
|
|
330 -- that do not need to be saved for future use.
|
|
|
331
|
|
|
332 type Save_Mark is private;
|
|
|
333
|
|
|
334 function Mark return Save_Mark;
|
|
|
335 -- Note mark point for future release
|
|
|
336
|
|
|
337 procedure Release (M : Save_Mark);
|
|
|
338 -- Release storage allocated since mark was noted
|
|
|
339
|
|
|
340 ------------------------------------
|
|
|
341 -- Representation of Ureal Values --
|
|
|
342 ------------------------------------
|
|
|
343
|
|
|
344 private
|
|
|
345
|
|
|
346 type Ureal is new Int range Ureal_Low_Bound .. Ureal_High_Bound;
|
|
|
347 for Ureal'Size use 32;
|
|
|
348
|
|
|
349 No_Ureal : constant Ureal := Ureal'First;
|
|
|
350
|
|
|
351 type Save_Mark is new Int;
|
|
|
352
|
|
|
353 pragma Inline (Denominator);
|
|
|
354 pragma Inline (Mark);
|
|
|
355 pragma Inline (Norm_Num);
|
|
|
356 pragma Inline (Norm_Den);
|
|
|
357 pragma Inline (Numerator);
|
|
|
358 pragma Inline (Rbase);
|
|
|
359 pragma Inline (Release);
|
|
|
360 pragma Inline (Ureal_0);
|
|
|
361 pragma Inline (Ureal_M_0);
|
|
|
362 pragma Inline (Ureal_Tenth);
|
|
|
363 pragma Inline (Ureal_Half);
|
|
|
364 pragma Inline (Ureal_1);
|
|
|
365 pragma Inline (Ureal_2);
|
|
|
366 pragma Inline (Ureal_10);
|
|
|
367 pragma Inline (UR_From_Components);
|
|
|
368
|
|
|
369 end Urealp;
|
