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