|
111
|
1 ------------------------------------------------------------------------------
|
|
|
2 -- --
|
|
|
3 -- GNAT COMPILER COMPONENTS --
|
|
|
4 -- --
|
|
|
5 -- U R E A L P --
|
|
|
6 -- --
|
|
|
7 -- B o d y --
|
|
|
8 -- --
|
|
131
|
9 -- Copyright (C) 1992-2018, Free Software Foundation, Inc. --
|
|
111
|
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 with Alloc;
|
|
|
33 with Output; use Output;
|
|
|
34 with Table;
|
|
|
35 with Tree_IO; use Tree_IO;
|
|
|
36
|
|
|
37 package body Urealp is
|
|
|
38
|
|
|
39 Ureal_First_Entry : constant Ureal := Ureal'Succ (No_Ureal);
|
|
|
40 -- First subscript allocated in Ureal table (note that we can't just
|
|
|
41 -- add 1 to No_Ureal, since "+" means something different for Ureals).
|
|
|
42
|
|
|
43 type Ureal_Entry is record
|
|
|
44 Num : Uint;
|
|
|
45 -- Numerator (always non-negative)
|
|
|
46
|
|
|
47 Den : Uint;
|
|
|
48 -- Denominator (always non-zero, always positive if base is zero)
|
|
|
49
|
|
|
50 Rbase : Nat;
|
|
|
51 -- Base value. If Rbase is zero, then the value is simply Num / Den.
|
|
|
52 -- If Rbase is non-zero, then the value is Num / (Rbase ** Den)
|
|
|
53
|
|
|
54 Negative : Boolean;
|
|
|
55 -- Flag set if value is negative
|
|
|
56 end record;
|
|
|
57
|
|
|
58 -- The following representation clause ensures that the above record
|
|
|
59 -- has no holes. We do this so that when instances of this record are
|
|
|
60 -- written by Tree_Gen, we do not write uninitialized values to the file.
|
|
|
61
|
|
|
62 for Ureal_Entry use record
|
|
|
63 Num at 0 range 0 .. 31;
|
|
|
64 Den at 4 range 0 .. 31;
|
|
|
65 Rbase at 8 range 0 .. 31;
|
|
|
66 Negative at 12 range 0 .. 31;
|
|
|
67 end record;
|
|
|
68
|
|
|
69 for Ureal_Entry'Size use 16 * 8;
|
|
|
70 -- This ensures that we did not leave out any fields
|
|
|
71
|
|
|
72 package Ureals is new Table.Table (
|
|
|
73 Table_Component_Type => Ureal_Entry,
|
|
|
74 Table_Index_Type => Ureal'Base,
|
|
|
75 Table_Low_Bound => Ureal_First_Entry,
|
|
|
76 Table_Initial => Alloc.Ureals_Initial,
|
|
|
77 Table_Increment => Alloc.Ureals_Increment,
|
|
|
78 Table_Name => "Ureals");
|
|
|
79
|
|
|
80 -- The following universal reals are the values returned by the constant
|
|
|
81 -- functions. They are initialized by the initialization procedure.
|
|
|
82
|
|
|
83 UR_0 : Ureal;
|
|
|
84 UR_M_0 : Ureal;
|
|
|
85 UR_Tenth : Ureal;
|
|
|
86 UR_Half : Ureal;
|
|
|
87 UR_1 : Ureal;
|
|
|
88 UR_2 : Ureal;
|
|
|
89 UR_10 : Ureal;
|
|
|
90 UR_10_36 : Ureal;
|
|
|
91 UR_M_10_36 : Ureal;
|
|
|
92 UR_100 : Ureal;
|
|
|
93 UR_2_128 : Ureal;
|
|
|
94 UR_2_80 : Ureal;
|
|
|
95 UR_2_M_128 : Ureal;
|
|
|
96 UR_2_M_80 : Ureal;
|
|
|
97
|
|
|
98 Num_Ureal_Constants : constant := 10;
|
|
|
99 -- This is used for an assertion check in Tree_Read and Tree_Write to
|
|
|
100 -- help remember to add values to these routines when we add to the list.
|
|
|
101
|
|
|
102 Normalized_Real : Ureal := No_Ureal;
|
|
|
103 -- Used to memoize Norm_Num and Norm_Den, if either of these functions
|
|
|
104 -- is called, this value is set and Normalized_Entry contains the result
|
|
|
105 -- of the normalization. On subsequent calls, this is used to avoid the
|
|
|
106 -- call to Normalize if it has already been made.
|
|
|
107
|
|
|
108 Normalized_Entry : Ureal_Entry;
|
|
|
109 -- Entry built by most recent call to Normalize
|
|
|
110
|
|
|
111 -----------------------
|
|
|
112 -- Local Subprograms --
|
|
|
113 -----------------------
|
|
|
114
|
|
|
115 function Decimal_Exponent_Hi (V : Ureal) return Int;
|
|
|
116 -- Returns an estimate of the exponent of Val represented as a normalized
|
|
|
117 -- decimal number (non-zero digit before decimal point), The estimate is
|
|
|
118 -- either correct, or high, but never low. The accuracy of the estimate
|
|
|
119 -- affects only the efficiency of the comparison routines.
|
|
|
120
|
|
|
121 function Decimal_Exponent_Lo (V : Ureal) return Int;
|
|
|
122 -- Returns an estimate of the exponent of Val represented as a normalized
|
|
|
123 -- decimal number (non-zero digit before decimal point), The estimate is
|
|
|
124 -- either correct, or low, but never high. The accuracy of the estimate
|
|
|
125 -- affects only the efficiency of the comparison routines.
|
|
|
126
|
|
|
127 function Equivalent_Decimal_Exponent (U : Ureal_Entry) return Int;
|
|
|
128 -- U is a Ureal entry for which the base value is non-zero, the value
|
|
|
129 -- returned is the equivalent decimal exponent value, i.e. the value of
|
|
|
130 -- Den, adjusted as though the base were base 10. The value is rounded
|
|
|
131 -- toward zero (truncated), and so its value can be off by one.
|
|
|
132
|
|
|
133 function Is_Integer (Num, Den : Uint) return Boolean;
|
|
|
134 -- Return true if the real quotient of Num / Den is an integer value
|
|
|
135
|
|
|
136 function Normalize (Val : Ureal_Entry) return Ureal_Entry;
|
|
|
137 -- Normalizes the Ureal_Entry by reducing it to lowest terms (with a base
|
|
|
138 -- value of 0).
|
|
|
139
|
|
|
140 function Same (U1, U2 : Ureal) return Boolean;
|
|
|
141 pragma Inline (Same);
|
|
|
142 -- Determines if U1 and U2 are the same Ureal. Note that we cannot use
|
|
|
143 -- the equals operator for this test, since that tests for equality, not
|
|
|
144 -- identity.
|
|
|
145
|
|
|
146 function Store_Ureal (Val : Ureal_Entry) return Ureal;
|
|
|
147 -- This store a new entry in the universal reals table and return its index
|
|
|
148 -- in the table.
|
|
|
149
|
|
|
150 function Store_Ureal_Normalized (Val : Ureal_Entry) return Ureal;
|
|
|
151 pragma Inline (Store_Ureal_Normalized);
|
|
|
152 -- Like Store_Ureal, but normalizes its operand first
|
|
|
153
|
|
|
154 -------------------------
|
|
|
155 -- Decimal_Exponent_Hi --
|
|
|
156 -------------------------
|
|
|
157
|
|
|
158 function Decimal_Exponent_Hi (V : Ureal) return Int is
|
|
|
159 Val : constant Ureal_Entry := Ureals.Table (V);
|
|
|
160
|
|
|
161 begin
|
|
|
162 -- Zero always returns zero
|
|
|
163
|
|
|
164 if UR_Is_Zero (V) then
|
|
|
165 return 0;
|
|
|
166
|
|
|
167 -- For numbers in rational form, get the maximum number of digits in the
|
|
|
168 -- numerator and the minimum number of digits in the denominator, and
|
|
|
169 -- subtract. For example:
|
|
|
170
|
|
|
171 -- 1000 / 99 = 1.010E+1
|
|
|
172 -- 9999 / 10 = 9.999E+2
|
|
|
173
|
|
|
174 -- This estimate may of course be high, but that is acceptable
|
|
|
175
|
|
|
176 elsif Val.Rbase = 0 then
|
|
|
177 return UI_Decimal_Digits_Hi (Val.Num) -
|
|
|
178 UI_Decimal_Digits_Lo (Val.Den);
|
|
|
179
|
|
|
180 -- For based numbers, just subtract the decimal exponent from the
|
|
|
181 -- high estimate of the number of digits in the numerator and add
|
|
|
182 -- one to accommodate possible round off errors for non-decimal
|
|
|
183 -- bases. For example:
|
|
|
184
|
|
|
185 -- 1_500_000 / 10**4 = 1.50E-2
|
|
|
186
|
|
|
187 else -- Val.Rbase /= 0
|
|
|
188 return UI_Decimal_Digits_Hi (Val.Num) -
|
|
|
189 Equivalent_Decimal_Exponent (Val) + 1;
|
|
|
190 end if;
|
|
|
191 end Decimal_Exponent_Hi;
|
|
|
192
|
|
|
193 -------------------------
|
|
|
194 -- Decimal_Exponent_Lo --
|
|
|
195 -------------------------
|
|
|
196
|
|
|
197 function Decimal_Exponent_Lo (V : Ureal) return Int is
|
|
|
198 Val : constant Ureal_Entry := Ureals.Table (V);
|
|
|
199
|
|
|
200 begin
|
|
|
201 -- Zero always returns zero
|
|
|
202
|
|
|
203 if UR_Is_Zero (V) then
|
|
|
204 return 0;
|
|
|
205
|
|
|
206 -- For numbers in rational form, get min digits in numerator, max digits
|
|
|
207 -- in denominator, and subtract and subtract one more for possible loss
|
|
|
208 -- during the division. For example:
|
|
|
209
|
|
|
210 -- 1000 / 99 = 1.010E+1
|
|
|
211 -- 9999 / 10 = 9.999E+2
|
|
|
212
|
|
|
213 -- This estimate may of course be low, but that is acceptable
|
|
|
214
|
|
|
215 elsif Val.Rbase = 0 then
|
|
|
216 return UI_Decimal_Digits_Lo (Val.Num) -
|
|
|
217 UI_Decimal_Digits_Hi (Val.Den) - 1;
|
|
|
218
|
|
|
219 -- For based numbers, just subtract the decimal exponent from the
|
|
|
220 -- low estimate of the number of digits in the numerator and subtract
|
|
|
221 -- one to accommodate possible round off errors for non-decimal
|
|
|
222 -- bases. For example:
|
|
|
223
|
|
|
224 -- 1_500_000 / 10**4 = 1.50E-2
|
|
|
225
|
|
|
226 else -- Val.Rbase /= 0
|
|
|
227 return UI_Decimal_Digits_Lo (Val.Num) -
|
|
|
228 Equivalent_Decimal_Exponent (Val) - 1;
|
|
|
229 end if;
|
|
|
230 end Decimal_Exponent_Lo;
|
|
|
231
|
|
|
232 -----------------
|
|
|
233 -- Denominator --
|
|
|
234 -----------------
|
|
|
235
|
|
|
236 function Denominator (Real : Ureal) return Uint is
|
|
|
237 begin
|
|
|
238 return Ureals.Table (Real).Den;
|
|
|
239 end Denominator;
|
|
|
240
|
|
|
241 ---------------------------------
|
|
|
242 -- Equivalent_Decimal_Exponent --
|
|
|
243 ---------------------------------
|
|
|
244
|
|
|
245 function Equivalent_Decimal_Exponent (U : Ureal_Entry) return Int is
|
|
|
246
|
|
|
247 type Ratio is record
|
|
|
248 Num : Nat;
|
|
|
249 Den : Nat;
|
|
|
250 end record;
|
|
|
251
|
|
|
252 -- The following table is a table of logs to the base 10. All values
|
|
|
253 -- have at least 15 digits of precision, and do not exceed the true
|
|
|
254 -- value. To avoid the use of floating point, and as a result potential
|
|
|
255 -- target dependency, each entry is represented as a fraction of two
|
|
|
256 -- integers.
|
|
|
257
|
|
|
258 Logs : constant array (Nat range 1 .. 16) of Ratio :=
|
|
|
259 (1 => (Num => 0, Den => 1), -- 0
|
|
|
260 2 => (Num => 15_392_313, Den => 51_132_157), -- 0.301029995663981
|
|
|
261 3 => (Num => 731_111_920, Den => 1532_339_867), -- 0.477121254719662
|
|
|
262 4 => (Num => 30_784_626, Den => 51_132_157), -- 0.602059991327962
|
|
|
263 5 => (Num => 111_488_153, Den => 159_503_487), -- 0.698970004336018
|
|
|
264 6 => (Num => 84_253_929, Den => 108_274_489), -- 0.778151250383643
|
|
|
265 7 => (Num => 35_275_468, Den => 41_741_273), -- 0.845098040014256
|
|
|
266 8 => (Num => 46_176_939, Den => 51_132_157), -- 0.903089986991943
|
|
|
267 9 => (Num => 417_620_173, Den => 437_645_744), -- 0.954242509439324
|
|
|
268 10 => (Num => 1, Den => 1), -- 1.000000000000000
|
|
|
269 11 => (Num => 136_507_510, Den => 131_081_687), -- 1.041392685158225
|
|
|
270 12 => (Num => 26_797_783, Den => 24_831_587), -- 1.079181246047624
|
|
|
271 13 => (Num => 73_333_297, Den => 65_832_160), -- 1.113943352306836
|
|
|
272 14 => (Num => 102_941_258, Den => 89_816_543), -- 1.146128035678238
|
|
|
273 15 => (Num => 53_385_559, Den => 45_392_361), -- 1.176091259055681
|
|
|
274 16 => (Num => 78_897_839, Den => 65_523_237)); -- 1.204119982655924
|
|
|
275
|
|
|
276 function Scale (X : Int; R : Ratio) return Int;
|
|
|
277 -- Compute the value of X scaled by R
|
|
|
278
|
|
|
279 -----------
|
|
|
280 -- Scale --
|
|
|
281 -----------
|
|
|
282
|
|
|
283 function Scale (X : Int; R : Ratio) return Int is
|
|
|
284 type Wide_Int is range -2**63 .. 2**63 - 1;
|
|
|
285
|
|
|
286 begin
|
|
|
287 return Int (Wide_Int (X) * Wide_Int (R.Num) / Wide_Int (R.Den));
|
|
|
288 end Scale;
|
|
|
289
|
|
|
290 begin
|
|
|
291 pragma Assert (U.Rbase /= 0);
|
|
|
292 return Scale (UI_To_Int (U.Den), Logs (U.Rbase));
|
|
|
293 end Equivalent_Decimal_Exponent;
|
|
|
294
|
|
|
295 ----------------
|
|
|
296 -- Initialize --
|
|
|
297 ----------------
|
|
|
298
|
|
|
299 procedure Initialize is
|
|
|
300 begin
|
|
|
301 Ureals.Init;
|
|
|
302 UR_0 := UR_From_Components (Uint_0, Uint_1, 0, False);
|
|
|
303 UR_M_0 := UR_From_Components (Uint_0, Uint_1, 0, True);
|
|
|
304 UR_Half := UR_From_Components (Uint_1, Uint_1, 2, False);
|
|
|
305 UR_Tenth := UR_From_Components (Uint_1, Uint_1, 10, False);
|
|
|
306 UR_1 := UR_From_Components (Uint_1, Uint_1, 0, False);
|
|
|
307 UR_2 := UR_From_Components (Uint_1, Uint_Minus_1, 2, False);
|
|
|
308 UR_10 := UR_From_Components (Uint_1, Uint_Minus_1, 10, False);
|
|
|
309 UR_10_36 := UR_From_Components (Uint_1, Uint_Minus_36, 10, False);
|
|
|
310 UR_M_10_36 := UR_From_Components (Uint_1, Uint_Minus_36, 10, True);
|
|
|
311 UR_100 := UR_From_Components (Uint_1, Uint_Minus_2, 10, False);
|
|
|
312 UR_2_128 := UR_From_Components (Uint_1, Uint_Minus_128, 2, False);
|
|
|
313 UR_2_M_128 := UR_From_Components (Uint_1, Uint_128, 2, False);
|
|
|
314 UR_2_80 := UR_From_Components (Uint_1, Uint_Minus_80, 2, False);
|
|
|
315 UR_2_M_80 := UR_From_Components (Uint_1, Uint_80, 2, False);
|
|
|
316 end Initialize;
|
|
|
317
|
|
|
318 ----------------
|
|
|
319 -- Is_Integer --
|
|
|
320 ----------------
|
|
|
321
|
|
|
322 function Is_Integer (Num, Den : Uint) return Boolean is
|
|
|
323 begin
|
|
|
324 return (Num / Den) * Den = Num;
|
|
|
325 end Is_Integer;
|
|
|
326
|
|
|
327 ----------
|
|
|
328 -- Mark --
|
|
|
329 ----------
|
|
|
330
|
|
|
331 function Mark return Save_Mark is
|
|
|
332 begin
|
|
|
333 return Save_Mark (Ureals.Last);
|
|
|
334 end Mark;
|
|
|
335
|
|
|
336 --------------
|
|
|
337 -- Norm_Den --
|
|
|
338 --------------
|
|
|
339
|
|
|
340 function Norm_Den (Real : Ureal) return Uint is
|
|
|
341 begin
|
|
|
342 if not Same (Real, Normalized_Real) then
|
|
|
343 Normalized_Real := Real;
|
|
|
344 Normalized_Entry := Normalize (Ureals.Table (Real));
|
|
|
345 end if;
|
|
|
346
|
|
|
347 return Normalized_Entry.Den;
|
|
|
348 end Norm_Den;
|
|
|
349
|
|
|
350 --------------
|
|
|
351 -- Norm_Num --
|
|
|
352 --------------
|
|
|
353
|
|
|
354 function Norm_Num (Real : Ureal) return Uint is
|
|
|
355 begin
|
|
|
356 if not Same (Real, Normalized_Real) then
|
|
|
357 Normalized_Real := Real;
|
|
|
358 Normalized_Entry := Normalize (Ureals.Table (Real));
|
|
|
359 end if;
|
|
|
360
|
|
|
361 return Normalized_Entry.Num;
|
|
|
362 end Norm_Num;
|
|
|
363
|
|
|
364 ---------------
|
|
|
365 -- Normalize --
|
|
|
366 ---------------
|
|
|
367
|
|
|
368 function Normalize (Val : Ureal_Entry) return Ureal_Entry is
|
|
|
369 J : Uint;
|
|
|
370 K : Uint;
|
|
|
371 Tmp : Uint;
|
|
|
372 Num : Uint;
|
|
|
373 Den : Uint;
|
|
|
374 M : constant Uintp.Save_Mark := Uintp.Mark;
|
|
|
375
|
|
|
376 begin
|
|
|
377 -- Start by setting J to the greatest of the absolute values of the
|
|
|
378 -- numerator and the denominator (taking into account the base value),
|
|
|
379 -- and K to the lesser of the two absolute values. The gcd of Num and
|
|
|
380 -- Den is the gcd of J and K.
|
|
|
381
|
|
|
382 if Val.Rbase = 0 then
|
|
|
383 J := Val.Num;
|
|
|
384 K := Val.Den;
|
|
|
385
|
|
|
386 elsif Val.Den < 0 then
|
|
|
387 J := Val.Num * Val.Rbase ** (-Val.Den);
|
|
|
388 K := Uint_1;
|
|
|
389
|
|
|
390 else
|
|
|
391 J := Val.Num;
|
|
|
392 K := Val.Rbase ** Val.Den;
|
|
|
393 end if;
|
|
|
394
|
|
|
395 Num := J;
|
|
|
396 Den := K;
|
|
|
397
|
|
|
398 if K > J then
|
|
|
399 Tmp := J;
|
|
|
400 J := K;
|
|
|
401 K := Tmp;
|
|
|
402 end if;
|
|
|
403
|
|
|
404 J := UI_GCD (J, K);
|
|
|
405 Num := Num / J;
|
|
|
406 Den := Den / J;
|
|
|
407 Uintp.Release_And_Save (M, Num, Den);
|
|
|
408
|
|
|
409 -- Divide numerator and denominator by gcd and return result
|
|
|
410
|
|
|
411 return (Num => Num,
|
|
|
412 Den => Den,
|
|
|
413 Rbase => 0,
|
|
|
414 Negative => Val.Negative);
|
|
|
415 end Normalize;
|
|
|
416
|
|
|
417 ---------------
|
|
|
418 -- Numerator --
|
|
|
419 ---------------
|
|
|
420
|
|
|
421 function Numerator (Real : Ureal) return Uint is
|
|
|
422 begin
|
|
|
423 return Ureals.Table (Real).Num;
|
|
|
424 end Numerator;
|
|
|
425
|
|
|
426 --------
|
|
|
427 -- pr --
|
|
|
428 --------
|
|
|
429
|
|
|
430 procedure pr (Real : Ureal) is
|
|
|
431 begin
|
|
|
432 UR_Write (Real);
|
|
|
433 Write_Eol;
|
|
|
434 end pr;
|
|
|
435
|
|
|
436 -----------
|
|
|
437 -- Rbase --
|
|
|
438 -----------
|
|
|
439
|
|
|
440 function Rbase (Real : Ureal) return Nat is
|
|
|
441 begin
|
|
|
442 return Ureals.Table (Real).Rbase;
|
|
|
443 end Rbase;
|
|
|
444
|
|
|
445 -------------
|
|
|
446 -- Release --
|
|
|
447 -------------
|
|
|
448
|
|
|
449 procedure Release (M : Save_Mark) is
|
|
|
450 begin
|
|
|
451 Ureals.Set_Last (Ureal (M));
|
|
|
452 end Release;
|
|
|
453
|
|
|
454 ----------
|
|
|
455 -- Same --
|
|
|
456 ----------
|
|
|
457
|
|
|
458 function Same (U1, U2 : Ureal) return Boolean is
|
|
|
459 begin
|
|
|
460 return Int (U1) = Int (U2);
|
|
|
461 end Same;
|
|
|
462
|
|
|
463 -----------------
|
|
|
464 -- Store_Ureal --
|
|
|
465 -----------------
|
|
|
466
|
|
|
467 function Store_Ureal (Val : Ureal_Entry) return Ureal is
|
|
|
468 begin
|
|
|
469 Ureals.Append (Val);
|
|
|
470
|
|
|
471 -- Normalize representation of signed values
|
|
|
472
|
|
|
473 if Val.Num < 0 then
|
|
|
474 Ureals.Table (Ureals.Last).Negative := True;
|
|
|
475 Ureals.Table (Ureals.Last).Num := -Val.Num;
|
|
|
476 end if;
|
|
|
477
|
|
|
478 return Ureals.Last;
|
|
|
479 end Store_Ureal;
|
|
|
480
|
|
|
481 ----------------------------
|
|
|
482 -- Store_Ureal_Normalized --
|
|
|
483 ----------------------------
|
|
|
484
|
|
|
485 function Store_Ureal_Normalized (Val : Ureal_Entry) return Ureal is
|
|
|
486 begin
|
|
|
487 return Store_Ureal (Normalize (Val));
|
|
|
488 end Store_Ureal_Normalized;
|
|
|
489
|
|
|
490 ---------------
|
|
|
491 -- Tree_Read --
|
|
|
492 ---------------
|
|
|
493
|
|
|
494 procedure Tree_Read is
|
|
|
495 begin
|
|
|
496 pragma Assert (Num_Ureal_Constants = 10);
|
|
|
497
|
|
|
498 Ureals.Tree_Read;
|
|
|
499 Tree_Read_Int (Int (UR_0));
|
|
|
500 Tree_Read_Int (Int (UR_M_0));
|
|
|
501 Tree_Read_Int (Int (UR_Tenth));
|
|
|
502 Tree_Read_Int (Int (UR_Half));
|
|
|
503 Tree_Read_Int (Int (UR_1));
|
|
|
504 Tree_Read_Int (Int (UR_2));
|
|
|
505 Tree_Read_Int (Int (UR_10));
|
|
|
506 Tree_Read_Int (Int (UR_100));
|
|
|
507 Tree_Read_Int (Int (UR_2_128));
|
|
|
508 Tree_Read_Int (Int (UR_2_M_128));
|
|
|
509
|
|
|
510 -- Clear the normalization cache
|
|
|
511
|
|
|
512 Normalized_Real := No_Ureal;
|
|
|
513 end Tree_Read;
|
|
|
514
|
|
|
515 ----------------
|
|
|
516 -- Tree_Write --
|
|
|
517 ----------------
|
|
|
518
|
|
|
519 procedure Tree_Write is
|
|
|
520 begin
|
|
|
521 pragma Assert (Num_Ureal_Constants = 10);
|
|
|
522
|
|
|
523 Ureals.Tree_Write;
|
|
|
524 Tree_Write_Int (Int (UR_0));
|
|
|
525 Tree_Write_Int (Int (UR_M_0));
|
|
|
526 Tree_Write_Int (Int (UR_Tenth));
|
|
|
527 Tree_Write_Int (Int (UR_Half));
|
|
|
528 Tree_Write_Int (Int (UR_1));
|
|
|
529 Tree_Write_Int (Int (UR_2));
|
|
|
530 Tree_Write_Int (Int (UR_10));
|
|
|
531 Tree_Write_Int (Int (UR_100));
|
|
|
532 Tree_Write_Int (Int (UR_2_128));
|
|
|
533 Tree_Write_Int (Int (UR_2_M_128));
|
|
|
534 end Tree_Write;
|
|
|
535
|
|
|
536 ------------
|
|
|
537 -- UR_Abs --
|
|
|
538 ------------
|
|
|
539
|
|
|
540 function UR_Abs (Real : Ureal) return Ureal is
|
|
|
541 Val : constant Ureal_Entry := Ureals.Table (Real);
|
|
|
542
|
|
|
543 begin
|
|
|
544 return Store_Ureal
|
|
|
545 ((Num => Val.Num,
|
|
|
546 Den => Val.Den,
|
|
|
547 Rbase => Val.Rbase,
|
|
|
548 Negative => False));
|
|
|
549 end UR_Abs;
|
|
|
550
|
|
|
551 ------------
|
|
|
552 -- UR_Add --
|
|
|
553 ------------
|
|
|
554
|
|
|
555 function UR_Add (Left : Uint; Right : Ureal) return Ureal is
|
|
|
556 begin
|
|
|
557 return UR_From_Uint (Left) + Right;
|
|
|
558 end UR_Add;
|
|
|
559
|
|
|
560 function UR_Add (Left : Ureal; Right : Uint) return Ureal is
|
|
|
561 begin
|
|
|
562 return Left + UR_From_Uint (Right);
|
|
|
563 end UR_Add;
|
|
|
564
|
|
|
565 function UR_Add (Left : Ureal; Right : Ureal) return Ureal is
|
|
|
566 Lval : Ureal_Entry := Ureals.Table (Left);
|
|
|
567 Rval : Ureal_Entry := Ureals.Table (Right);
|
|
|
568 Num : Uint;
|
|
|
569
|
|
|
570 begin
|
|
|
571 -- Note, in the temporary Ureal_Entry values used in this procedure,
|
|
|
572 -- we store the sign as the sign of the numerator (i.e. xxx.Num may
|
|
|
573 -- be negative, even though in stored entries this can never be so)
|
|
|
574
|
|
|
575 if Lval.Rbase /= 0 and then Lval.Rbase = Rval.Rbase then
|
|
|
576 declare
|
|
|
577 Opd_Min, Opd_Max : Ureal_Entry;
|
|
|
578 Exp_Min, Exp_Max : Uint;
|
|
|
579
|
|
|
580 begin
|
|
|
581 if Lval.Negative then
|
|
|
582 Lval.Num := (-Lval.Num);
|
|
|
583 end if;
|
|
|
584
|
|
|
585 if Rval.Negative then
|
|
|
586 Rval.Num := (-Rval.Num);
|
|
|
587 end if;
|
|
|
588
|
|
|
589 if Lval.Den < Rval.Den then
|
|
|
590 Exp_Min := Lval.Den;
|
|
|
591 Exp_Max := Rval.Den;
|
|
|
592 Opd_Min := Lval;
|
|
|
593 Opd_Max := Rval;
|
|
|
594 else
|
|
|
595 Exp_Min := Rval.Den;
|
|
|
596 Exp_Max := Lval.Den;
|
|
|
597 Opd_Min := Rval;
|
|
|
598 Opd_Max := Lval;
|
|
|
599 end if;
|
|
|
600
|
|
|
601 Num :=
|
|
|
602 Opd_Min.Num * Lval.Rbase ** (Exp_Max - Exp_Min) + Opd_Max.Num;
|
|
|
603
|
|
|
604 if Num = 0 then
|
|
|
605 return Store_Ureal
|
|
|
606 ((Num => Uint_0,
|
|
|
607 Den => Uint_1,
|
|
|
608 Rbase => 0,
|
|
|
609 Negative => Lval.Negative));
|
|
|
610
|
|
|
611 else
|
|
|
612 return Store_Ureal
|
|
|
613 ((Num => abs Num,
|
|
|
614 Den => Exp_Max,
|
|
|
615 Rbase => Lval.Rbase,
|
|
|
616 Negative => (Num < 0)));
|
|
|
617 end if;
|
|
|
618 end;
|
|
|
619
|
|
|
620 else
|
|
|
621 declare
|
|
|
622 Ln : Ureal_Entry := Normalize (Lval);
|
|
|
623 Rn : Ureal_Entry := Normalize (Rval);
|
|
|
624
|
|
|
625 begin
|
|
|
626 if Ln.Negative then
|
|
|
627 Ln.Num := (-Ln.Num);
|
|
|
628 end if;
|
|
|
629
|
|
|
630 if Rn.Negative then
|
|
|
631 Rn.Num := (-Rn.Num);
|
|
|
632 end if;
|
|
|
633
|
|
|
634 Num := (Ln.Num * Rn.Den) + (Rn.Num * Ln.Den);
|
|
|
635
|
|
|
636 if Num = 0 then
|
|
|
637 return Store_Ureal
|
|
|
638 ((Num => Uint_0,
|
|
|
639 Den => Uint_1,
|
|
|
640 Rbase => 0,
|
|
|
641 Negative => Lval.Negative));
|
|
|
642
|
|
|
643 else
|
|
|
644 return Store_Ureal_Normalized
|
|
|
645 ((Num => abs Num,
|
|
|
646 Den => Ln.Den * Rn.Den,
|
|
|
647 Rbase => 0,
|
|
|
648 Negative => (Num < 0)));
|
|
|
649 end if;
|
|
|
650 end;
|
|
|
651 end if;
|
|
|
652 end UR_Add;
|
|
|
653
|
|
|
654 ----------------
|
|
|
655 -- UR_Ceiling --
|
|
|
656 ----------------
|
|
|
657
|
|
|
658 function UR_Ceiling (Real : Ureal) return Uint is
|
|
|
659 Val : constant Ureal_Entry := Normalize (Ureals.Table (Real));
|
|
|
660 begin
|
|
|
661 if Val.Negative then
|
|
|
662 return UI_Negate (Val.Num / Val.Den);
|
|
|
663 else
|
|
|
664 return (Val.Num + Val.Den - 1) / Val.Den;
|
|
|
665 end if;
|
|
|
666 end UR_Ceiling;
|
|
|
667
|
|
|
668 ------------
|
|
|
669 -- UR_Div --
|
|
|
670 ------------
|
|
|
671
|
|
|
672 function UR_Div (Left : Uint; Right : Ureal) return Ureal is
|
|
|
673 begin
|
|
|
674 return UR_From_Uint (Left) / Right;
|
|
|
675 end UR_Div;
|
|
|
676
|
|
|
677 function UR_Div (Left : Ureal; Right : Uint) return Ureal is
|
|
|
678 begin
|
|
|
679 return Left / UR_From_Uint (Right);
|
|
|
680 end UR_Div;
|
|
|
681
|
|
|
682 function UR_Div (Left, Right : Ureal) return Ureal is
|
|
|
683 Lval : constant Ureal_Entry := Ureals.Table (Left);
|
|
|
684 Rval : constant Ureal_Entry := Ureals.Table (Right);
|
|
|
685 Rneg : constant Boolean := Rval.Negative xor Lval.Negative;
|
|
|
686
|
|
|
687 begin
|
|
|
688 pragma Assert (Rval.Num /= Uint_0);
|
|
|
689
|
|
|
690 if Lval.Rbase = 0 then
|
|
|
691 if Rval.Rbase = 0 then
|
|
|
692 return Store_Ureal_Normalized
|
|
|
693 ((Num => Lval.Num * Rval.Den,
|
|
|
694 Den => Lval.Den * Rval.Num,
|
|
|
695 Rbase => 0,
|
|
|
696 Negative => Rneg));
|
|
|
697
|
|
|
698 elsif Is_Integer (Lval.Num, Rval.Num * Lval.Den) then
|
|
|
699 return Store_Ureal
|
|
|
700 ((Num => Lval.Num / (Rval.Num * Lval.Den),
|
|
|
701 Den => (-Rval.Den),
|
|
|
702 Rbase => Rval.Rbase,
|
|
|
703 Negative => Rneg));
|
|
|
704
|
|
|
705 elsif Rval.Den < 0 then
|
|
|
706 return Store_Ureal_Normalized
|
|
|
707 ((Num => Lval.Num,
|
|
|
708 Den => Rval.Rbase ** (-Rval.Den) *
|
|
|
709 Rval.Num *
|
|
|
710 Lval.Den,
|
|
|
711 Rbase => 0,
|
|
|
712 Negative => Rneg));
|
|
|
713
|
|
|
714 else
|
|
|
715 return Store_Ureal_Normalized
|
|
|
716 ((Num => Lval.Num * Rval.Rbase ** Rval.Den,
|
|
|
717 Den => Rval.Num * Lval.Den,
|
|
|
718 Rbase => 0,
|
|
|
719 Negative => Rneg));
|
|
|
720 end if;
|
|
|
721
|
|
|
722 elsif Is_Integer (Lval.Num, Rval.Num) then
|
|
|
723 if Rval.Rbase = Lval.Rbase then
|
|
|
724 return Store_Ureal
|
|
|
725 ((Num => Lval.Num / Rval.Num,
|
|
|
726 Den => Lval.Den - Rval.Den,
|
|
|
727 Rbase => Lval.Rbase,
|
|
|
728 Negative => Rneg));
|
|
|
729
|
|
|
730 elsif Rval.Rbase = 0 then
|
|
|
731 return Store_Ureal
|
|
|
732 ((Num => (Lval.Num / Rval.Num) * Rval.Den,
|
|
|
733 Den => Lval.Den,
|
|
|
734 Rbase => Lval.Rbase,
|
|
|
735 Negative => Rneg));
|
|
|
736
|
|
|
737 elsif Rval.Den < 0 then
|
|
|
738 declare
|
|
|
739 Num, Den : Uint;
|
|
|
740
|
|
|
741 begin
|
|
|
742 if Lval.Den < 0 then
|
|
|
743 Num := (Lval.Num / Rval.Num) * (Lval.Rbase ** (-Lval.Den));
|
|
|
744 Den := Rval.Rbase ** (-Rval.Den);
|
|
|
745 else
|
|
|
746 Num := Lval.Num / Rval.Num;
|
|
|
747 Den := (Lval.Rbase ** Lval.Den) *
|
|
|
748 (Rval.Rbase ** (-Rval.Den));
|
|
|
749 end if;
|
|
|
750
|
|
|
751 return Store_Ureal
|
|
|
752 ((Num => Num,
|
|
|
753 Den => Den,
|
|
|
754 Rbase => 0,
|
|
|
755 Negative => Rneg));
|
|
|
756 end;
|
|
|
757
|
|
|
758 else
|
|
|
759 return Store_Ureal
|
|
|
760 ((Num => (Lval.Num / Rval.Num) *
|
|
|
761 (Rval.Rbase ** Rval.Den),
|
|
|
762 Den => Lval.Den,
|
|
|
763 Rbase => Lval.Rbase,
|
|
|
764 Negative => Rneg));
|
|
|
765 end if;
|
|
|
766
|
|
|
767 else
|
|
|
768 declare
|
|
|
769 Num, Den : Uint;
|
|
|
770
|
|
|
771 begin
|
|
|
772 if Lval.Den < 0 then
|
|
|
773 Num := Lval.Num * (Lval.Rbase ** (-Lval.Den));
|
|
|
774 Den := Rval.Num;
|
|
|
775 else
|
|
|
776 Num := Lval.Num;
|
|
|
777 Den := Rval.Num * (Lval.Rbase ** Lval.Den);
|
|
|
778 end if;
|
|
|
779
|
|
|
780 if Rval.Rbase /= 0 then
|
|
|
781 if Rval.Den < 0 then
|
|
|
782 Den := Den * (Rval.Rbase ** (-Rval.Den));
|
|
|
783 else
|
|
|
784 Num := Num * (Rval.Rbase ** Rval.Den);
|
|
|
785 end if;
|
|
|
786
|
|
|
787 else
|
|
|
788 Num := Num * Rval.Den;
|
|
|
789 end if;
|
|
|
790
|
|
|
791 return Store_Ureal_Normalized
|
|
|
792 ((Num => Num,
|
|
|
793 Den => Den,
|
|
|
794 Rbase => 0,
|
|
|
795 Negative => Rneg));
|
|
|
796 end;
|
|
|
797 end if;
|
|
|
798 end UR_Div;
|
|
|
799
|
|
|
800 -----------
|
|
|
801 -- UR_Eq --
|
|
|
802 -----------
|
|
|
803
|
|
|
804 function UR_Eq (Left, Right : Ureal) return Boolean is
|
|
|
805 begin
|
|
|
806 return not UR_Ne (Left, Right);
|
|
|
807 end UR_Eq;
|
|
|
808
|
|
|
809 ---------------------
|
|
|
810 -- UR_Exponentiate --
|
|
|
811 ---------------------
|
|
|
812
|
|
|
813 function UR_Exponentiate (Real : Ureal; N : Uint) return Ureal is
|
|
|
814 X : constant Uint := abs N;
|
|
|
815 Bas : Ureal;
|
|
|
816 Val : Ureal_Entry;
|
|
|
817 Neg : Boolean;
|
|
|
818 IBas : Uint;
|
|
|
819
|
|
|
820 begin
|
|
|
821 -- If base is negative, then the resulting sign depends on whether
|
|
|
822 -- the exponent is even or odd (even => positive, odd = negative)
|
|
|
823
|
|
|
824 if UR_Is_Negative (Real) then
|
|
|
825 Neg := (N mod 2) /= 0;
|
|
|
826 Bas := UR_Negate (Real);
|
|
|
827 else
|
|
|
828 Neg := False;
|
|
|
829 Bas := Real;
|
|
|
830 end if;
|
|
|
831
|
|
|
832 Val := Ureals.Table (Bas);
|
|
|
833
|
|
|
834 -- If the base is a small integer, then we can return the result in
|
|
|
835 -- exponential form, which can save a lot of time for junk exponents.
|
|
|
836
|
|
|
837 IBas := UR_Trunc (Bas);
|
|
|
838
|
|
|
839 if IBas <= 16
|
|
|
840 and then UR_From_Uint (IBas) = Bas
|
|
|
841 then
|
|
|
842 return Store_Ureal
|
|
|
843 ((Num => Uint_1,
|
|
|
844 Den => -N,
|
|
|
845 Rbase => UI_To_Int (UR_Trunc (Bas)),
|
|
|
846 Negative => Neg));
|
|
|
847
|
|
|
848 -- If the exponent is negative then we raise the numerator and the
|
|
|
849 -- denominator (after normalization) to the absolute value of the
|
|
|
850 -- exponent and we return the reciprocal. An assert error will happen
|
|
|
851 -- if the numerator is zero.
|
|
|
852
|
|
|
853 elsif N < 0 then
|
|
|
854 pragma Assert (Val.Num /= 0);
|
|
|
855 Val := Normalize (Val);
|
|
|
856
|
|
|
857 return Store_Ureal
|
|
|
858 ((Num => Val.Den ** X,
|
|
|
859 Den => Val.Num ** X,
|
|
|
860 Rbase => 0,
|
|
|
861 Negative => Neg));
|
|
|
862
|
|
|
863 -- If positive, we distinguish the case when the base is not zero, in
|
|
|
864 -- which case the new denominator is just the product of the old one
|
|
|
865 -- with the exponent,
|
|
|
866
|
|
|
867 else
|
|
|
868 if Val.Rbase /= 0 then
|
|
|
869
|
|
|
870 return Store_Ureal
|
|
|
871 ((Num => Val.Num ** X,
|
|
|
872 Den => Val.Den * X,
|
|
|
873 Rbase => Val.Rbase,
|
|
|
874 Negative => Neg));
|
|
|
875
|
|
|
876 -- And when the base is zero, in which case we exponentiate
|
|
|
877 -- the old denominator.
|
|
|
878
|
|
|
879 else
|
|
|
880 return Store_Ureal
|
|
|
881 ((Num => Val.Num ** X,
|
|
|
882 Den => Val.Den ** X,
|
|
|
883 Rbase => 0,
|
|
|
884 Negative => Neg));
|
|
|
885 end if;
|
|
|
886 end if;
|
|
|
887 end UR_Exponentiate;
|
|
|
888
|
|
|
889 --------------
|
|
|
890 -- UR_Floor --
|
|
|
891 --------------
|
|
|
892
|
|
|
893 function UR_Floor (Real : Ureal) return Uint is
|
|
|
894 Val : constant Ureal_Entry := Normalize (Ureals.Table (Real));
|
|
|
895 begin
|
|
|
896 if Val.Negative then
|
|
|
897 return UI_Negate ((Val.Num + Val.Den - 1) / Val.Den);
|
|
|
898 else
|
|
|
899 return Val.Num / Val.Den;
|
|
|
900 end if;
|
|
|
901 end UR_Floor;
|
|
|
902
|
|
|
903 ------------------------
|
|
|
904 -- UR_From_Components --
|
|
|
905 ------------------------
|
|
|
906
|
|
|
907 function UR_From_Components
|
|
|
908 (Num : Uint;
|
|
|
909 Den : Uint;
|
|
|
910 Rbase : Nat := 0;
|
|
|
911 Negative : Boolean := False)
|
|
|
912 return Ureal
|
|
|
913 is
|
|
|
914 begin
|
|
|
915 return Store_Ureal
|
|
|
916 ((Num => Num,
|
|
|
917 Den => Den,
|
|
|
918 Rbase => Rbase,
|
|
|
919 Negative => Negative));
|
|
|
920 end UR_From_Components;
|
|
|
921
|
|
|
922 ------------------
|
|
|
923 -- UR_From_Uint --
|
|
|
924 ------------------
|
|
|
925
|
|
|
926 function UR_From_Uint (UI : Uint) return Ureal is
|
|
|
927 begin
|
|
|
928 return UR_From_Components
|
|
|
929 (abs UI, Uint_1, Negative => (UI < 0));
|
|
|
930 end UR_From_Uint;
|
|
|
931
|
|
|
932 -----------
|
|
|
933 -- UR_Ge --
|
|
|
934 -----------
|
|
|
935
|
|
|
936 function UR_Ge (Left, Right : Ureal) return Boolean is
|
|
|
937 begin
|
|
|
938 return not (Left < Right);
|
|
|
939 end UR_Ge;
|
|
|
940
|
|
|
941 -----------
|
|
|
942 -- UR_Gt --
|
|
|
943 -----------
|
|
|
944
|
|
|
945 function UR_Gt (Left, Right : Ureal) return Boolean is
|
|
|
946 begin
|
|
|
947 return (Right < Left);
|
|
|
948 end UR_Gt;
|
|
|
949
|
|
|
950 --------------------
|
|
|
951 -- UR_Is_Negative --
|
|
|
952 --------------------
|
|
|
953
|
|
|
954 function UR_Is_Negative (Real : Ureal) return Boolean is
|
|
|
955 begin
|
|
|
956 return Ureals.Table (Real).Negative;
|
|
|
957 end UR_Is_Negative;
|
|
|
958
|
|
|
959 --------------------
|
|
|
960 -- UR_Is_Positive --
|
|
|
961 --------------------
|
|
|
962
|
|
|
963 function UR_Is_Positive (Real : Ureal) return Boolean is
|
|
|
964 begin
|
|
|
965 return not Ureals.Table (Real).Negative
|
|
|
966 and then Ureals.Table (Real).Num /= 0;
|
|
|
967 end UR_Is_Positive;
|
|
|
968
|
|
|
969 ----------------
|
|
|
970 -- UR_Is_Zero --
|
|
|
971 ----------------
|
|
|
972
|
|
|
973 function UR_Is_Zero (Real : Ureal) return Boolean is
|
|
|
974 begin
|
|
|
975 return Ureals.Table (Real).Num = 0;
|
|
|
976 end UR_Is_Zero;
|
|
|
977
|
|
|
978 -----------
|
|
|
979 -- UR_Le --
|
|
|
980 -----------
|
|
|
981
|
|
|
982 function UR_Le (Left, Right : Ureal) return Boolean is
|
|
|
983 begin
|
|
|
984 return not (Right < Left);
|
|
|
985 end UR_Le;
|
|
|
986
|
|
|
987 -----------
|
|
|
988 -- UR_Lt --
|
|
|
989 -----------
|
|
|
990
|
|
|
991 function UR_Lt (Left, Right : Ureal) return Boolean is
|
|
|
992 begin
|
|
|
993 -- An operand is not less than itself
|
|
|
994
|
|
|
995 if Same (Left, Right) then
|
|
|
996 return False;
|
|
|
997
|
|
|
998 -- Deal with zero cases
|
|
|
999
|
|
|
1000 elsif UR_Is_Zero (Left) then
|
|
|
1001 return UR_Is_Positive (Right);
|
|
|
1002
|
|
|
1003 elsif UR_Is_Zero (Right) then
|
|
|
1004 return Ureals.Table (Left).Negative;
|
|
|
1005
|
|
|
1006 -- Different signs are decisive (note we dealt with zero cases)
|
|
|
1007
|
|
|
1008 elsif Ureals.Table (Left).Negative
|
|
|
1009 and then not Ureals.Table (Right).Negative
|
|
|
1010 then
|
|
|
1011 return True;
|
|
|
1012
|
|
|
1013 elsif not Ureals.Table (Left).Negative
|
|
|
1014 and then Ureals.Table (Right).Negative
|
|
|
1015 then
|
|
|
1016 return False;
|
|
|
1017
|
|
|
1018 -- Signs are same, do rapid check based on worst case estimates of
|
|
|
1019 -- decimal exponent, which will often be decisive. Precise test
|
|
|
1020 -- depends on whether operands are positive or negative.
|
|
|
1021
|
|
|
1022 elsif Decimal_Exponent_Hi (Left) < Decimal_Exponent_Lo (Right) then
|
|
|
1023 return UR_Is_Positive (Left);
|
|
|
1024
|
|
|
1025 elsif Decimal_Exponent_Lo (Left) > Decimal_Exponent_Hi (Right) then
|
|
|
1026 return UR_Is_Negative (Left);
|
|
|
1027
|
|
|
1028 -- If we fall through, full gruesome test is required. This happens
|
|
|
1029 -- if the numbers are close together, or in some weird (/=10) base.
|
|
|
1030
|
|
|
1031 else
|
|
|
1032 declare
|
|
|
1033 Imrk : constant Uintp.Save_Mark := Mark;
|
|
|
1034 Rmrk : constant Urealp.Save_Mark := Mark;
|
|
|
1035 Lval : Ureal_Entry;
|
|
|
1036 Rval : Ureal_Entry;
|
|
|
1037 Result : Boolean;
|
|
|
1038
|
|
|
1039 begin
|
|
|
1040 Lval := Ureals.Table (Left);
|
|
|
1041 Rval := Ureals.Table (Right);
|
|
|
1042
|
|
|
1043 -- An optimization. If both numbers are based, then subtract
|
|
|
1044 -- common value of base to avoid unnecessarily giant numbers
|
|
|
1045
|
|
|
1046 if Lval.Rbase = Rval.Rbase and then Lval.Rbase /= 0 then
|
|
|
1047 if Lval.Den < Rval.Den then
|
|
|
1048 Rval.Den := Rval.Den - Lval.Den;
|
|
|
1049 Lval.Den := Uint_0;
|
|
|
1050 else
|
|
|
1051 Lval.Den := Lval.Den - Rval.Den;
|
|
|
1052 Rval.Den := Uint_0;
|
|
|
1053 end if;
|
|
|
1054 end if;
|
|
|
1055
|
|
|
1056 Lval := Normalize (Lval);
|
|
|
1057 Rval := Normalize (Rval);
|
|
|
1058
|
|
|
1059 if Lval.Negative then
|
|
|
1060 Result := (Lval.Num * Rval.Den) > (Rval.Num * Lval.Den);
|
|
|
1061 else
|
|
|
1062 Result := (Lval.Num * Rval.Den) < (Rval.Num * Lval.Den);
|
|
|
1063 end if;
|
|
|
1064
|
|
|
1065 Release (Imrk);
|
|
|
1066 Release (Rmrk);
|
|
|
1067 return Result;
|
|
|
1068 end;
|
|
|
1069 end if;
|
|
|
1070 end UR_Lt;
|
|
|
1071
|
|
|
1072 ------------
|
|
|
1073 -- UR_Max --
|
|
|
1074 ------------
|
|
|
1075
|
|
|
1076 function UR_Max (Left, Right : Ureal) return Ureal is
|
|
|
1077 begin
|
|
|
1078 if Left >= Right then
|
|
|
1079 return Left;
|
|
|
1080 else
|
|
|
1081 return Right;
|
|
|
1082 end if;
|
|
|
1083 end UR_Max;
|
|
|
1084
|
|
|
1085 ------------
|
|
|
1086 -- UR_Min --
|
|
|
1087 ------------
|
|
|
1088
|
|
|
1089 function UR_Min (Left, Right : Ureal) return Ureal is
|
|
|
1090 begin
|
|
|
1091 if Left <= Right then
|
|
|
1092 return Left;
|
|
|
1093 else
|
|
|
1094 return Right;
|
|
|
1095 end if;
|
|
|
1096 end UR_Min;
|
|
|
1097
|
|
|
1098 ------------
|
|
|
1099 -- UR_Mul --
|
|
|
1100 ------------
|
|
|
1101
|
|
|
1102 function UR_Mul (Left : Uint; Right : Ureal) return Ureal is
|
|
|
1103 begin
|
|
|
1104 return UR_From_Uint (Left) * Right;
|
|
|
1105 end UR_Mul;
|
|
|
1106
|
|
|
1107 function UR_Mul (Left : Ureal; Right : Uint) return Ureal is
|
|
|
1108 begin
|
|
|
1109 return Left * UR_From_Uint (Right);
|
|
|
1110 end UR_Mul;
|
|
|
1111
|
|
|
1112 function UR_Mul (Left, Right : Ureal) return Ureal is
|
|
|
1113 Lval : constant Ureal_Entry := Ureals.Table (Left);
|
|
|
1114 Rval : constant Ureal_Entry := Ureals.Table (Right);
|
|
|
1115 Num : Uint := Lval.Num * Rval.Num;
|
|
|
1116 Den : Uint;
|
|
|
1117 Rneg : constant Boolean := Lval.Negative xor Rval.Negative;
|
|
|
1118
|
|
|
1119 begin
|
|
|
1120 if Lval.Rbase = 0 then
|
|
|
1121 if Rval.Rbase = 0 then
|
|
|
1122 return Store_Ureal_Normalized
|
|
|
1123 ((Num => Num,
|
|
|
1124 Den => Lval.Den * Rval.Den,
|
|
|
1125 Rbase => 0,
|
|
|
1126 Negative => Rneg));
|
|
|
1127
|
|
|
1128 elsif Is_Integer (Num, Lval.Den) then
|
|
|
1129 return Store_Ureal
|
|
|
1130 ((Num => Num / Lval.Den,
|
|
|
1131 Den => Rval.Den,
|
|
|
1132 Rbase => Rval.Rbase,
|
|
|
1133 Negative => Rneg));
|
|
|
1134
|
|
|
1135 elsif Rval.Den < 0 then
|
|
|
1136 return Store_Ureal_Normalized
|
|
|
1137 ((Num => Num * (Rval.Rbase ** (-Rval.Den)),
|
|
|
1138 Den => Lval.Den,
|
|
|
1139 Rbase => 0,
|
|
|
1140 Negative => Rneg));
|
|
|
1141
|
|
|
1142 else
|
|
|
1143 return Store_Ureal_Normalized
|
|
|
1144 ((Num => Num,
|
|
|
1145 Den => Lval.Den * (Rval.Rbase ** Rval.Den),
|
|
|
1146 Rbase => 0,
|
|
|
1147 Negative => Rneg));
|
|
|
1148 end if;
|
|
|
1149
|
|
|
1150 elsif Lval.Rbase = Rval.Rbase then
|
|
|
1151 return Store_Ureal
|
|
|
1152 ((Num => Num,
|
|
|
1153 Den => Lval.Den + Rval.Den,
|
|
|
1154 Rbase => Lval.Rbase,
|
|
|
1155 Negative => Rneg));
|
|
|
1156
|
|
|
1157 elsif Rval.Rbase = 0 then
|
|
|
1158 if Is_Integer (Num, Rval.Den) then
|
|
|
1159 return Store_Ureal
|
|
|
1160 ((Num => Num / Rval.Den,
|
|
|
1161 Den => Lval.Den,
|
|
|
1162 Rbase => Lval.Rbase,
|
|
|
1163 Negative => Rneg));
|
|
|
1164
|
|
|
1165 elsif Lval.Den < 0 then
|
|
|
1166 return Store_Ureal_Normalized
|
|
|
1167 ((Num => Num * (Lval.Rbase ** (-Lval.Den)),
|
|
|
1168 Den => Rval.Den,
|
|
|
1169 Rbase => 0,
|
|
|
1170 Negative => Rneg));
|
|
|
1171
|
|
|
1172 else
|
|
|
1173 return Store_Ureal_Normalized
|
|
|
1174 ((Num => Num,
|
|
|
1175 Den => Rval.Den * (Lval.Rbase ** Lval.Den),
|
|
|
1176 Rbase => 0,
|
|
|
1177 Negative => Rneg));
|
|
|
1178 end if;
|
|
|
1179
|
|
|
1180 else
|
|
|
1181 Den := Uint_1;
|
|
|
1182
|
|
|
1183 if Lval.Den < 0 then
|
|
|
1184 Num := Num * (Lval.Rbase ** (-Lval.Den));
|
|
|
1185 else
|
|
|
1186 Den := Den * (Lval.Rbase ** Lval.Den);
|
|
|
1187 end if;
|
|
|
1188
|
|
|
1189 if Rval.Den < 0 then
|
|
|
1190 Num := Num * (Rval.Rbase ** (-Rval.Den));
|
|
|
1191 else
|
|
|
1192 Den := Den * (Rval.Rbase ** Rval.Den);
|
|
|
1193 end if;
|
|
|
1194
|
|
|
1195 return Store_Ureal_Normalized
|
|
|
1196 ((Num => Num,
|
|
|
1197 Den => Den,
|
|
|
1198 Rbase => 0,
|
|
|
1199 Negative => Rneg));
|
|
|
1200 end if;
|
|
|
1201 end UR_Mul;
|
|
|
1202
|
|
|
1203 -----------
|
|
|
1204 -- UR_Ne --
|
|
|
1205 -----------
|
|
|
1206
|
|
|
1207 function UR_Ne (Left, Right : Ureal) return Boolean is
|
|
|
1208 begin
|
|
|
1209 -- Quick processing for case of identical Ureal values (note that
|
|
|
1210 -- this also deals with comparing two No_Ureal values).
|
|
|
1211
|
|
|
1212 if Same (Left, Right) then
|
|
|
1213 return False;
|
|
|
1214
|
|
|
1215 -- Deal with case of one or other operand is No_Ureal, but not both
|
|
|
1216
|
|
|
1217 elsif Same (Left, No_Ureal) or else Same (Right, No_Ureal) then
|
|
|
1218 return True;
|
|
|
1219
|
|
|
1220 -- Do quick check based on number of decimal digits
|
|
|
1221
|
|
|
1222 elsif Decimal_Exponent_Hi (Left) < Decimal_Exponent_Lo (Right) or else
|
|
|
1223 Decimal_Exponent_Lo (Left) > Decimal_Exponent_Hi (Right)
|
|
|
1224 then
|
|
|
1225 return True;
|
|
|
1226
|
|
|
1227 -- Otherwise full comparison is required
|
|
|
1228
|
|
|
1229 else
|
|
|
1230 declare
|
|
|
1231 Imrk : constant Uintp.Save_Mark := Mark;
|
|
|
1232 Rmrk : constant Urealp.Save_Mark := Mark;
|
|
|
1233 Lval : constant Ureal_Entry := Normalize (Ureals.Table (Left));
|
|
|
1234 Rval : constant Ureal_Entry := Normalize (Ureals.Table (Right));
|
|
|
1235 Result : Boolean;
|
|
|
1236
|
|
|
1237 begin
|
|
|
1238 if UR_Is_Zero (Left) then
|
|
|
1239 return not UR_Is_Zero (Right);
|
|
|
1240
|
|
|
1241 elsif UR_Is_Zero (Right) then
|
|
|
1242 return not UR_Is_Zero (Left);
|
|
|
1243
|
|
|
1244 -- Both operands are non-zero
|
|
|
1245
|
|
|
1246 else
|
|
|
1247 Result :=
|
|
|
1248 Rval.Negative /= Lval.Negative
|
|
|
1249 or else Rval.Num /= Lval.Num
|
|
|
1250 or else Rval.Den /= Lval.Den;
|
|
|
1251 Release (Imrk);
|
|
|
1252 Release (Rmrk);
|
|
|
1253 return Result;
|
|
|
1254 end if;
|
|
|
1255 end;
|
|
|
1256 end if;
|
|
|
1257 end UR_Ne;
|
|
|
1258
|
|
|
1259 ---------------
|
|
|
1260 -- UR_Negate --
|
|
|
1261 ---------------
|
|
|
1262
|
|
|
1263 function UR_Negate (Real : Ureal) return Ureal is
|
|
|
1264 begin
|
|
|
1265 return Store_Ureal
|
|
|
1266 ((Num => Ureals.Table (Real).Num,
|
|
|
1267 Den => Ureals.Table (Real).Den,
|
|
|
1268 Rbase => Ureals.Table (Real).Rbase,
|
|
|
1269 Negative => not Ureals.Table (Real).Negative));
|
|
|
1270 end UR_Negate;
|
|
|
1271
|
|
|
1272 ------------
|
|
|
1273 -- UR_Sub --
|
|
|
1274 ------------
|
|
|
1275
|
|
|
1276 function UR_Sub (Left : Uint; Right : Ureal) return Ureal is
|
|
|
1277 begin
|
|
|
1278 return UR_From_Uint (Left) + UR_Negate (Right);
|
|
|
1279 end UR_Sub;
|
|
|
1280
|
|
|
1281 function UR_Sub (Left : Ureal; Right : Uint) return Ureal is
|
|
|
1282 begin
|
|
|
1283 return Left + UR_From_Uint (-Right);
|
|
|
1284 end UR_Sub;
|
|
|
1285
|
|
|
1286 function UR_Sub (Left, Right : Ureal) return Ureal is
|
|
|
1287 begin
|
|
|
1288 return Left + UR_Negate (Right);
|
|
|
1289 end UR_Sub;
|
|
|
1290
|
|
|
1291 ----------------
|
|
|
1292 -- UR_To_Uint --
|
|
|
1293 ----------------
|
|
|
1294
|
|
|
1295 function UR_To_Uint (Real : Ureal) return Uint is
|
|
|
1296 Val : constant Ureal_Entry := Normalize (Ureals.Table (Real));
|
|
|
1297 Res : Uint;
|
|
|
1298
|
|
|
1299 begin
|
|
|
1300 Res := (Val.Num + (Val.Den / 2)) / Val.Den;
|
|
|
1301
|
|
|
1302 if Val.Negative then
|
|
|
1303 return UI_Negate (Res);
|
|
|
1304 else
|
|
|
1305 return Res;
|
|
|
1306 end if;
|
|
|
1307 end UR_To_Uint;
|
|
|
1308
|
|
|
1309 --------------
|
|
|
1310 -- UR_Trunc --
|
|
|
1311 --------------
|
|
|
1312
|
|
|
1313 function UR_Trunc (Real : Ureal) return Uint is
|
|
|
1314 Val : constant Ureal_Entry := Normalize (Ureals.Table (Real));
|
|
|
1315 begin
|
|
|
1316 if Val.Negative then
|
|
|
1317 return -(Val.Num / Val.Den);
|
|
|
1318 else
|
|
|
1319 return Val.Num / Val.Den;
|
|
|
1320 end if;
|
|
|
1321 end UR_Trunc;
|
|
|
1322
|
|
|
1323 --------------
|
|
|
1324 -- UR_Write --
|
|
|
1325 --------------
|
|
|
1326
|
|
|
1327 procedure UR_Write (Real : Ureal; Brackets : Boolean := False) is
|
|
|
1328 Val : constant Ureal_Entry := Ureals.Table (Real);
|
|
|
1329 T : Uint;
|
|
|
1330
|
|
|
1331 begin
|
|
|
1332 -- If value is negative, we precede the constant by a minus sign
|
|
|
1333
|
|
|
1334 if Val.Negative then
|
|
|
1335 Write_Char ('-');
|
|
|
1336 end if;
|
|
|
1337
|
|
|
1338 -- Zero is zero
|
|
|
1339
|
|
|
1340 if Val.Num = 0 then
|
|
|
1341 Write_Str ("0.0");
|
|
|
1342
|
|
|
1343 -- For constants with a denominator of zero, the value is simply the
|
|
|
1344 -- numerator value, since we are dividing by base**0, which is 1.
|
|
|
1345
|
|
|
1346 elsif Val.Den = 0 then
|
|
|
1347 UI_Write (Val.Num, Decimal);
|
|
|
1348 Write_Str (".0");
|
|
|
1349
|
|
|
1350 -- Small powers of 2 get written in decimal fixed-point format
|
|
|
1351
|
|
|
1352 elsif Val.Rbase = 2
|
|
|
1353 and then Val.Den <= 3
|
|
|
1354 and then Val.Den >= -16
|
|
|
1355 then
|
|
|
1356 if Val.Den = 1 then
|
|
|
1357 T := Val.Num * (10 / 2);
|
|
|
1358 UI_Write (T / 10, Decimal);
|
|
|
1359 Write_Char ('.');
|
|
|
1360 UI_Write (T mod 10, Decimal);
|
|
|
1361
|
|
|
1362 elsif Val.Den = 2 then
|
|
|
1363 T := Val.Num * (100 / 4);
|
|
|
1364 UI_Write (T / 100, Decimal);
|
|
|
1365 Write_Char ('.');
|
|
|
1366 UI_Write (T mod 100 / 10, Decimal);
|
|
|
1367
|
|
|
1368 if T mod 10 /= 0 then
|
|
|
1369 UI_Write (T mod 10, Decimal);
|
|
|
1370 end if;
|
|
|
1371
|
|
|
1372 elsif Val.Den = 3 then
|
|
|
1373 T := Val.Num * (1000 / 8);
|
|
|
1374 UI_Write (T / 1000, Decimal);
|
|
|
1375 Write_Char ('.');
|
|
|
1376 UI_Write (T mod 1000 / 100, Decimal);
|
|
|
1377
|
|
|
1378 if T mod 100 /= 0 then
|
|
|
1379 UI_Write (T mod 100 / 10, Decimal);
|
|
|
1380
|
|
|
1381 if T mod 10 /= 0 then
|
|
|
1382 UI_Write (T mod 10, Decimal);
|
|
|
1383 end if;
|
|
|
1384 end if;
|
|
|
1385
|
|
|
1386 else
|
|
|
1387 UI_Write (Val.Num * (Uint_2 ** (-Val.Den)), Decimal);
|
|
|
1388 Write_Str (".0");
|
|
|
1389 end if;
|
|
|
1390
|
|
|
1391 -- Constants in base 10 or 16 can be written in normal Ada literal
|
|
|
1392 -- style, as long as they fit in the UI_Image_Buffer. Using hexadecimal
|
|
|
1393 -- notation, 4 bytes are required for the 16# # part, and every fifth
|
|
|
1394 -- character is an underscore. So, a buffer of size N has room for
|
|
|
1395 -- ((N - 4) - (N - 4) / 5) * 4 bits,
|
|
|
1396 -- or at least
|
|
|
1397 -- N * 16 / 5 - 12 bits.
|
|
|
1398
|
|
|
1399 elsif (Val.Rbase = 10 or else Val.Rbase = 16)
|
|
|
1400 and then Num_Bits (Val.Num) < UI_Image_Buffer'Length * 16 / 5 - 12
|
|
|
1401 then
|
|
|
1402 pragma Assert (Val.Den /= 0);
|
|
|
1403
|
|
|
1404 -- Use fixed-point format for small scaling values
|
|
|
1405
|
|
|
1406 if (Val.Rbase = 10 and then Val.Den < 0 and then Val.Den > -3)
|
|
|
1407 or else (Val.Rbase = 16 and then Val.Den = -1)
|
|
|
1408 then
|
|
|
1409 UI_Write (Val.Num * Val.Rbase**(-Val.Den), Decimal);
|
|
|
1410 Write_Str (".0");
|
|
|
1411
|
|
|
1412 -- Write hexadecimal constants in exponential notation with a zero
|
|
|
1413 -- unit digit. This matches the Ada canonical form for floating point
|
|
|
1414 -- numbers, and also ensures that the underscores end up in the
|
|
|
1415 -- correct place.
|
|
|
1416
|
|
|
1417 elsif Val.Rbase = 16 then
|
|
|
1418 UI_Image (Val.Num, Hex);
|
|
|
1419 pragma Assert (Val.Rbase = 16);
|
|
|
1420
|
|
|
1421 Write_Str ("16#0.");
|
|
|
1422 Write_Str (UI_Image_Buffer (4 .. UI_Image_Length));
|
|
|
1423
|
|
|
1424 -- For exponent, exclude 16# # and underscores from length
|
|
|
1425
|
|
|
1426 UI_Image_Length := UI_Image_Length - 4;
|
|
|
1427 UI_Image_Length := UI_Image_Length - UI_Image_Length / 5;
|
|
|
1428
|
|
|
1429 Write_Char ('E');
|
|
|
1430 UI_Write (Int (UI_Image_Length) - Val.Den, Decimal);
|
|
|
1431
|
|
|
1432 elsif Val.Den = 1 then
|
|
|
1433 UI_Write (Val.Num / 10, Decimal);
|
|
|
1434 Write_Char ('.');
|
|
|
1435 UI_Write (Val.Num mod 10, Decimal);
|
|
|
1436
|
|
|
1437 elsif Val.Den = 2 then
|
|
|
1438 UI_Write (Val.Num / 100, Decimal);
|
|
|
1439 Write_Char ('.');
|
|
|
1440 UI_Write (Val.Num / 10 mod 10, Decimal);
|
|
|
1441 UI_Write (Val.Num mod 10, Decimal);
|
|
|
1442
|
|
|
1443 -- Else use decimal exponential format
|
|
|
1444
|
|
|
1445 else
|
|
|
1446 -- Write decimal constants with a non-zero unit digit. This
|
|
|
1447 -- matches usual scientific notation.
|
|
|
1448
|
|
|
1449 UI_Image (Val.Num, Decimal);
|
|
|
1450 Write_Char (UI_Image_Buffer (1));
|
|
|
1451 Write_Char ('.');
|
|
|
1452
|
|
|
1453 if UI_Image_Length = 1 then
|
|
|
1454 Write_Char ('0');
|
|
|
1455 else
|
|
|
1456 Write_Str (UI_Image_Buffer (2 .. UI_Image_Length));
|
|
|
1457 end if;
|
|
|
1458
|
|
|
1459 Write_Char ('E');
|
|
|
1460 UI_Write (Int (UI_Image_Length - 1) - Val.Den, Decimal);
|
|
|
1461 end if;
|
|
|
1462
|
|
|
1463 -- Constants in a base other than 10 can still be easily written in
|
|
|
1464 -- normal Ada literal style if the numerator is one.
|
|
|
1465
|
|
|
1466 elsif Val.Rbase /= 0 and then Val.Num = 1 then
|
|
|
1467 Write_Int (Val.Rbase);
|
|
|
1468 Write_Str ("#1.0#E");
|
|
|
1469 UI_Write (-Val.Den);
|
|
|
1470
|
|
|
1471 -- Other constants with a base other than 10 are written using one of
|
|
|
1472 -- the following forms, depending on the sign of the number and the
|
|
|
1473 -- sign of the exponent (= minus denominator value). See that we are
|
|
|
1474 -- replacing the division by a multiplication (updating accordingly the
|
|
|
1475 -- sign of the exponent) to generate an expression whose computation
|
|
|
1476 -- does not cause a division by 0 when base**exponent is very small.
|
|
|
1477
|
|
|
1478 -- numerator.0*base**exponent
|
|
|
1479 -- numerator.0*base**-exponent
|
|
|
1480
|
|
|
1481 -- And of course an exponent of 0 can be omitted.
|
|
|
1482
|
|
|
1483 elsif Val.Rbase /= 0 then
|
|
|
1484 if Brackets then
|
|
|
1485 Write_Char ('[');
|
|
|
1486 end if;
|
|
|
1487
|
|
|
1488 UI_Write (Val.Num, Decimal);
|
|
|
1489 Write_Str (".0");
|
|
|
1490
|
|
|
1491 if Val.Den /= 0 then
|
|
|
1492 Write_Char ('*');
|
|
|
1493 Write_Int (Val.Rbase);
|
|
|
1494 Write_Str ("**");
|
|
|
1495
|
|
|
1496 if Val.Den <= 0 then
|
|
|
1497 UI_Write (-Val.Den, Decimal);
|
|
|
1498 else
|
|
|
1499 Write_Str ("(-");
|
|
|
1500 UI_Write (Val.Den, Decimal);
|
|
|
1501 Write_Char (')');
|
|
|
1502 end if;
|
|
|
1503 end if;
|
|
|
1504
|
|
|
1505 if Brackets then
|
|
|
1506 Write_Char (']');
|
|
|
1507 end if;
|
|
|
1508
|
|
|
1509 -- Rationals where numerator is divisible by denominator can be output
|
|
|
1510 -- as literals after we do the division. This includes the common case
|
|
|
1511 -- where the denominator is 1.
|
|
|
1512
|
|
|
1513 elsif Val.Num mod Val.Den = 0 then
|
|
|
1514 UI_Write (Val.Num / Val.Den, Decimal);
|
|
|
1515 Write_Str (".0");
|
|
|
1516
|
|
|
1517 -- Other non-based (rational) constants are written in num/den style
|
|
|
1518
|
|
|
1519 else
|
|
|
1520 if Brackets then
|
|
|
1521 Write_Char ('[');
|
|
|
1522 end if;
|
|
|
1523
|
|
|
1524 UI_Write (Val.Num, Decimal);
|
|
|
1525 Write_Str (".0/");
|
|
|
1526 UI_Write (Val.Den, Decimal);
|
|
|
1527 Write_Str (".0");
|
|
|
1528
|
|
|
1529 if Brackets then
|
|
|
1530 Write_Char (']');
|
|
|
1531 end if;
|
|
|
1532 end if;
|
|
|
1533 end UR_Write;
|
|
|
1534
|
|
|
1535 -------------
|
|
|
1536 -- Ureal_0 --
|
|
|
1537 -------------
|
|
|
1538
|
|
|
1539 function Ureal_0 return Ureal is
|
|
|
1540 begin
|
|
|
1541 return UR_0;
|
|
|
1542 end Ureal_0;
|
|
|
1543
|
|
|
1544 -------------
|
|
|
1545 -- Ureal_1 --
|
|
|
1546 -------------
|
|
|
1547
|
|
|
1548 function Ureal_1 return Ureal is
|
|
|
1549 begin
|
|
|
1550 return UR_1;
|
|
|
1551 end Ureal_1;
|
|
|
1552
|
|
|
1553 -------------
|
|
|
1554 -- Ureal_2 --
|
|
|
1555 -------------
|
|
|
1556
|
|
|
1557 function Ureal_2 return Ureal is
|
|
|
1558 begin
|
|
|
1559 return UR_2;
|
|
|
1560 end Ureal_2;
|
|
|
1561
|
|
|
1562 --------------
|
|
|
1563 -- Ureal_10 --
|
|
|
1564 --------------
|
|
|
1565
|
|
|
1566 function Ureal_10 return Ureal is
|
|
|
1567 begin
|
|
|
1568 return UR_10;
|
|
|
1569 end Ureal_10;
|
|
|
1570
|
|
|
1571 ---------------
|
|
|
1572 -- Ureal_100 --
|
|
|
1573 ---------------
|
|
|
1574
|
|
|
1575 function Ureal_100 return Ureal is
|
|
|
1576 begin
|
|
|
1577 return UR_100;
|
|
|
1578 end Ureal_100;
|
|
|
1579
|
|
|
1580 -----------------
|
|
|
1581 -- Ureal_10_36 --
|
|
|
1582 -----------------
|
|
|
1583
|
|
|
1584 function Ureal_10_36 return Ureal is
|
|
|
1585 begin
|
|
|
1586 return UR_10_36;
|
|
|
1587 end Ureal_10_36;
|
|
|
1588
|
|
|
1589 ----------------
|
|
|
1590 -- Ureal_2_80 --
|
|
|
1591 ----------------
|
|
|
1592
|
|
|
1593 function Ureal_2_80 return Ureal is
|
|
|
1594 begin
|
|
|
1595 return UR_2_80;
|
|
|
1596 end Ureal_2_80;
|
|
|
1597
|
|
|
1598 -----------------
|
|
|
1599 -- Ureal_2_128 --
|
|
|
1600 -----------------
|
|
|
1601
|
|
|
1602 function Ureal_2_128 return Ureal is
|
|
|
1603 begin
|
|
|
1604 return UR_2_128;
|
|
|
1605 end Ureal_2_128;
|
|
|
1606
|
|
|
1607 -------------------
|
|
|
1608 -- Ureal_2_M_80 --
|
|
|
1609 -------------------
|
|
|
1610
|
|
|
1611 function Ureal_2_M_80 return Ureal is
|
|
|
1612 begin
|
|
|
1613 return UR_2_M_80;
|
|
|
1614 end Ureal_2_M_80;
|
|
|
1615
|
|
|
1616 -------------------
|
|
|
1617 -- Ureal_2_M_128 --
|
|
|
1618 -------------------
|
|
|
1619
|
|
|
1620 function Ureal_2_M_128 return Ureal is
|
|
|
1621 begin
|
|
|
1622 return UR_2_M_128;
|
|
|
1623 end Ureal_2_M_128;
|
|
|
1624
|
|
|
1625 ----------------
|
|
|
1626 -- Ureal_Half --
|
|
|
1627 ----------------
|
|
|
1628
|
|
|
1629 function Ureal_Half return Ureal is
|
|
|
1630 begin
|
|
|
1631 return UR_Half;
|
|
|
1632 end Ureal_Half;
|
|
|
1633
|
|
|
1634 ---------------
|
|
|
1635 -- Ureal_M_0 --
|
|
|
1636 ---------------
|
|
|
1637
|
|
|
1638 function Ureal_M_0 return Ureal is
|
|
|
1639 begin
|
|
|
1640 return UR_M_0;
|
|
|
1641 end Ureal_M_0;
|
|
|
1642
|
|
|
1643 -------------------
|
|
|
1644 -- Ureal_M_10_36 --
|
|
|
1645 -------------------
|
|
|
1646
|
|
|
1647 function Ureal_M_10_36 return Ureal is
|
|
|
1648 begin
|
|
|
1649 return UR_M_10_36;
|
|
|
1650 end Ureal_M_10_36;
|
|
|
1651
|
|
|
1652 -----------------
|
|
|
1653 -- Ureal_Tenth --
|
|
|
1654 -----------------
|
|
|
1655
|
|
|
1656 function Ureal_Tenth return Ureal is
|
|
|
1657 begin
|
|
|
1658 return UR_Tenth;
|
|
|
1659 end Ureal_Tenth;
|
|
|
1660
|
|
|
1661 end Urealp;
|
