1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
9 -- Copyright (C) 1992-2009 Free Software Foundation, Inc. --
11 -- GNAT is free software; you can redistribute it and/or modify it under --
12 -- terms of the GNU General Public License as published by the Free Soft- --
13 -- ware Foundation; either version 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. --
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. --
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/>. --
27 -- GNAT was originally developed by the GNAT team at New York University. --
28 -- Extensive contributions were provided by Ada Core Technologies Inc. --
30 ------------------------------------------------------------------------------
33 with Output
; use Output
;
35 with Tree_IO
; use Tree_IO
;
37 package body Urealp
is
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!
43 type Ureal_Entry
is record
45 -- Numerator (always non-negative)
48 -- Denominator (always non-zero, always positive if base is zero)
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)
55 -- Flag set if value is negative
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.
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;
69 for Ureal_Entry
'Size use 16 * 8;
70 -- This ensures that we did not leave out any fields
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");
80 -- The following universal reals are the values returned by the constant
81 -- functions. They are initialized by the initialization procedure.
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.
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.
108 Normalized_Entry
: Ureal_Entry
;
109 -- Entry built by most recent call to Normalize
111 -----------------------
112 -- Local Subprograms --
113 -----------------------
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.
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.
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 -- to the nearest integer, and so can be one off.
133 function Is_Integer
(Num
, Den
: Uint
) return Boolean;
134 -- Return true if the real quotient of Num / Den is an integer value
136 function Normalize
(Val
: Ureal_Entry
) return Ureal_Entry
;
137 -- Normalizes the Ureal_Entry by reducing it to lowest terms (with a
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,
146 function Store_Ureal
(Val
: Ureal_Entry
) return Ureal
;
147 -- This store a new entry in the universal reals table and return
148 -- its index in the table.
150 -------------------------
151 -- Decimal_Exponent_Hi --
152 -------------------------
154 function Decimal_Exponent_Hi
(V
: Ureal
) return Int
is
155 Val
: constant Ureal_Entry
:= Ureals
.Table
(V
);
158 -- Zero always returns zero
160 if UR_Is_Zero
(V
) then
163 -- For numbers in rational form, get the maximum number of digits in the
164 -- numerator and the minimum number of digits in the denominator, and
165 -- subtract. For example:
167 -- 1000 / 99 = 1.010E+1
168 -- 9999 / 10 = 9.999E+2
170 -- This estimate may of course be high, but that is acceptable
172 elsif Val
.Rbase
= 0 then
173 return UI_Decimal_Digits_Hi
(Val
.Num
) -
174 UI_Decimal_Digits_Lo
(Val
.Den
);
176 -- For based numbers, just subtract the decimal exponent from the
177 -- high estimate of the number of digits in the numerator and add
178 -- one to accommodate possible round off errors for non-decimal
179 -- bases. For example:
181 -- 1_500_000 / 10**4 = 1.50E-2
183 else -- Val.Rbase /= 0
184 return UI_Decimal_Digits_Hi
(Val
.Num
) -
185 Equivalent_Decimal_Exponent
(Val
) + 1;
187 end Decimal_Exponent_Hi
;
189 -------------------------
190 -- Decimal_Exponent_Lo --
191 -------------------------
193 function Decimal_Exponent_Lo
(V
: Ureal
) return Int
is
194 Val
: constant Ureal_Entry
:= Ureals
.Table
(V
);
197 -- Zero always returns zero
199 if UR_Is_Zero
(V
) then
202 -- For numbers in rational form, get min digits in numerator, max digits
203 -- in denominator, and subtract and subtract one more for possible loss
204 -- during the division. For example:
206 -- 1000 / 99 = 1.010E+1
207 -- 9999 / 10 = 9.999E+2
209 -- This estimate may of course be low, but that is acceptable
211 elsif Val
.Rbase
= 0 then
212 return UI_Decimal_Digits_Lo
(Val
.Num
) -
213 UI_Decimal_Digits_Hi
(Val
.Den
) - 1;
215 -- For based numbers, just subtract the decimal exponent from the
216 -- low estimate of the number of digits in the numerator and subtract
217 -- one to accommodate possible round off errors for non-decimal
218 -- bases. For example:
220 -- 1_500_000 / 10**4 = 1.50E-2
222 else -- Val.Rbase /= 0
223 return UI_Decimal_Digits_Lo
(Val
.Num
) -
224 Equivalent_Decimal_Exponent
(Val
) - 1;
226 end Decimal_Exponent_Lo
;
232 function Denominator
(Real
: Ureal
) return Uint
is
234 return Ureals
.Table
(Real
).Den
;
237 ---------------------------------
238 -- Equivalent_Decimal_Exponent --
239 ---------------------------------
241 function Equivalent_Decimal_Exponent
(U
: Ureal_Entry
) return Int
is
243 -- The following table is a table of logs to the base 10
245 Logs
: constant array (Nat
range 1 .. 16) of Long_Float := (
246 1 => 0.000000000000000,
247 2 => 0.301029995663981,
248 3 => 0.477121254719662,
249 4 => 0.602059991327962,
250 5 => 0.698970004336019,
251 6 => 0.778151250383644,
252 7 => 0.845098040014257,
253 8 => 0.903089986991944,
254 9 => 0.954242509439325,
255 10 => 1.000000000000000,
256 11 => 1.041392685158230,
257 12 => 1.079181246047620,
258 13 => 1.113943352306840,
259 14 => 1.146128035678240,
260 15 => 1.176091259055680,
261 16 => 1.204119982655920);
264 pragma Assert
(U
.Rbase
/= 0);
265 return Int
(Long_Float (UI_To_Int
(U
.Den
)) * Logs
(U
.Rbase
));
266 end Equivalent_Decimal_Exponent
;
272 procedure Initialize
is
275 UR_0
:= UR_From_Components
(Uint_0
, Uint_1
, 0, False);
276 UR_M_0
:= UR_From_Components
(Uint_0
, Uint_1
, 0, True);
277 UR_Half
:= UR_From_Components
(Uint_1
, Uint_1
, 2, False);
278 UR_Tenth
:= UR_From_Components
(Uint_1
, Uint_1
, 10, False);
279 UR_1
:= UR_From_Components
(Uint_1
, Uint_1
, 0, False);
280 UR_2
:= UR_From_Components
(Uint_1
, Uint_Minus_1
, 2, False);
281 UR_10
:= UR_From_Components
(Uint_1
, Uint_Minus_1
, 10, False);
282 UR_10_36
:= UR_From_Components
(Uint_1
, Uint_Minus_36
, 10, False);
283 UR_M_10_36
:= UR_From_Components
(Uint_1
, Uint_Minus_36
, 10, True);
284 UR_100
:= UR_From_Components
(Uint_1
, Uint_Minus_2
, 10, False);
285 UR_2_128
:= UR_From_Components
(Uint_1
, Uint_Minus_128
, 2, False);
286 UR_2_M_128
:= UR_From_Components
(Uint_1
, Uint_128
, 2, False);
287 UR_2_80
:= UR_From_Components
(Uint_1
, Uint_Minus_80
, 2, False);
288 UR_2_M_80
:= UR_From_Components
(Uint_1
, Uint_80
, 2, False);
295 function Is_Integer
(Num
, Den
: Uint
) return Boolean is
297 return (Num
/ Den
) * Den
= Num
;
304 function Mark
return Save_Mark
is
306 return Save_Mark
(Ureals
.Last
);
313 function Norm_Den
(Real
: Ureal
) return Uint
is
315 if not Same
(Real
, Normalized_Real
) then
316 Normalized_Real
:= Real
;
317 Normalized_Entry
:= Normalize
(Ureals
.Table
(Real
));
320 return Normalized_Entry
.Den
;
327 function Norm_Num
(Real
: Ureal
) return Uint
is
329 if not Same
(Real
, Normalized_Real
) then
330 Normalized_Real
:= Real
;
331 Normalized_Entry
:= Normalize
(Ureals
.Table
(Real
));
334 return Normalized_Entry
.Num
;
341 function Normalize
(Val
: Ureal_Entry
) return Ureal_Entry
is
347 M
: constant Uintp
.Save_Mark
:= Uintp
.Mark
;
350 -- Start by setting J to the greatest of the absolute values of the
351 -- numerator and the denominator (taking into account the base value),
352 -- and K to the lesser of the two absolute values. The gcd of Num and
353 -- Den is the gcd of J and K.
355 if Val
.Rbase
= 0 then
359 elsif Val
.Den
< 0 then
360 J
:= Val
.Num
* Val
.Rbase
** (-Val
.Den
);
365 K
:= Val
.Rbase
** Val
.Den
;
380 Uintp
.Release_And_Save
(M
, Num
, Den
);
382 -- Divide numerator and denominator by gcd and return result
387 Negative
=> Val
.Negative
);
394 function Numerator
(Real
: Ureal
) return Uint
is
396 return Ureals
.Table
(Real
).Num
;
403 procedure pr
(Real
: Ureal
) is
413 function Rbase
(Real
: Ureal
) return Nat
is
415 return Ureals
.Table
(Real
).Rbase
;
422 procedure Release
(M
: Save_Mark
) is
424 Ureals
.Set_Last
(Ureal
(M
));
431 function Same
(U1
, U2
: Ureal
) return Boolean is
433 return Int
(U1
) = Int
(U2
);
440 function Store_Ureal
(Val
: Ureal_Entry
) return Ureal
is
444 -- Normalize representation of signed values
447 Ureals
.Table
(Ureals
.Last
).Negative
:= True;
448 Ureals
.Table
(Ureals
.Last
).Num
:= -Val
.Num
;
458 procedure Tree_Read
is
460 pragma Assert
(Num_Ureal_Constants
= 10);
463 Tree_Read_Int
(Int
(UR_0
));
464 Tree_Read_Int
(Int
(UR_M_0
));
465 Tree_Read_Int
(Int
(UR_Tenth
));
466 Tree_Read_Int
(Int
(UR_Half
));
467 Tree_Read_Int
(Int
(UR_1
));
468 Tree_Read_Int
(Int
(UR_2
));
469 Tree_Read_Int
(Int
(UR_10
));
470 Tree_Read_Int
(Int
(UR_100
));
471 Tree_Read_Int
(Int
(UR_2_128
));
472 Tree_Read_Int
(Int
(UR_2_M_128
));
474 -- Clear the normalization cache
476 Normalized_Real
:= No_Ureal
;
483 procedure Tree_Write
is
485 pragma Assert
(Num_Ureal_Constants
= 10);
488 Tree_Write_Int
(Int
(UR_0
));
489 Tree_Write_Int
(Int
(UR_M_0
));
490 Tree_Write_Int
(Int
(UR_Tenth
));
491 Tree_Write_Int
(Int
(UR_Half
));
492 Tree_Write_Int
(Int
(UR_1
));
493 Tree_Write_Int
(Int
(UR_2
));
494 Tree_Write_Int
(Int
(UR_10
));
495 Tree_Write_Int
(Int
(UR_100
));
496 Tree_Write_Int
(Int
(UR_2_128
));
497 Tree_Write_Int
(Int
(UR_2_M_128
));
504 function UR_Abs
(Real
: Ureal
) return Ureal
is
505 Val
: constant Ureal_Entry
:= Ureals
.Table
(Real
);
519 function UR_Add
(Left
: Uint
; Right
: Ureal
) return Ureal
is
521 return UR_From_Uint
(Left
) + Right
;
524 function UR_Add
(Left
: Ureal
; Right
: Uint
) return Ureal
is
526 return Left
+ UR_From_Uint
(Right
);
529 function UR_Add
(Left
: Ureal
; Right
: Ureal
) return Ureal
is
530 Lval
: Ureal_Entry
:= Ureals
.Table
(Left
);
531 Rval
: Ureal_Entry
:= Ureals
.Table
(Right
);
536 -- Note, in the temporary Ureal_Entry values used in this procedure,
537 -- we store the sign as the sign of the numerator (i.e. xxx.Num may
538 -- be negative, even though in stored entries this can never be so)
540 if Lval
.Rbase
/= 0 and then Lval
.Rbase
= Rval
.Rbase
then
543 Opd_Min
, Opd_Max
: Ureal_Entry
;
544 Exp_Min
, Exp_Max
: Uint
;
547 if Lval
.Negative
then
548 Lval
.Num
:= (-Lval
.Num
);
551 if Rval
.Negative
then
552 Rval
.Num
:= (-Rval
.Num
);
555 if Lval
.Den
< Rval
.Den
then
568 Opd_Min
.Num
* Lval
.Rbase
** (Exp_Max
- Exp_Min
) + Opd_Max
.Num
;
575 Negative
=> Lval
.Negative
));
582 Negative
=> (Num
< 0)));
588 Ln
: Ureal_Entry
:= Normalize
(Lval
);
589 Rn
: Ureal_Entry
:= Normalize
(Rval
);
600 Num
:= (Ln
.Num
* Rn
.Den
) + (Rn
.Num
* Ln
.Den
);
607 Negative
=> Lval
.Negative
));
613 Den
=> Ln
.Den
* Rn
.Den
,
615 Negative
=> (Num
< 0))));
625 function UR_Ceiling
(Real
: Ureal
) return Uint
is
626 Val
: constant Ureal_Entry
:= Normalize
(Ureals
.Table
(Real
));
630 return UI_Negate
(Val
.Num
/ Val
.Den
);
632 return (Val
.Num
+ Val
.Den
- 1) / Val
.Den
;
640 function UR_Div
(Left
: Uint
; Right
: Ureal
) return Ureal
is
642 return UR_From_Uint
(Left
) / Right
;
645 function UR_Div
(Left
: Ureal
; Right
: Uint
) return Ureal
is
647 return Left
/ UR_From_Uint
(Right
);
650 function UR_Div
(Left
, Right
: Ureal
) return Ureal
is
651 Lval
: constant Ureal_Entry
:= Ureals
.Table
(Left
);
652 Rval
: constant Ureal_Entry
:= Ureals
.Table
(Right
);
653 Rneg
: constant Boolean := Rval
.Negative
xor Lval
.Negative
;
656 pragma Assert
(Rval
.Num
/= Uint_0
);
658 if Lval
.Rbase
= 0 then
660 if Rval
.Rbase
= 0 then
663 (Num
=> Lval
.Num
* Rval
.Den
,
664 Den
=> Lval
.Den
* Rval
.Num
,
668 elsif Is_Integer
(Lval
.Num
, Rval
.Num
* Lval
.Den
) then
670 (Num
=> Lval
.Num
/ (Rval
.Num
* Lval
.Den
),
675 elsif Rval
.Den
< 0 then
679 Den
=> Rval
.Rbase
** (-Rval
.Den
) *
688 (Num
=> Lval
.Num
* Rval
.Rbase
** Rval
.Den
,
689 Den
=> Rval
.Num
* Lval
.Den
,
694 elsif Is_Integer
(Lval
.Num
, Rval
.Num
) then
696 if Rval
.Rbase
= Lval
.Rbase
then
698 (Num
=> Lval
.Num
/ Rval
.Num
,
699 Den
=> Lval
.Den
- Rval
.Den
,
703 elsif Rval
.Rbase
= 0 then
705 (Num
=> (Lval
.Num
/ Rval
.Num
) * Rval
.Den
,
710 elsif Rval
.Den
< 0 then
716 Num
:= (Lval
.Num
/ Rval
.Num
) * (Lval
.Rbase
** (-Lval
.Den
));
717 Den
:= Rval
.Rbase
** (-Rval
.Den
);
719 Num
:= Lval
.Num
/ Rval
.Num
;
720 Den
:= (Lval
.Rbase
** Lval
.Den
) *
721 (Rval
.Rbase
** (-Rval
.Den
));
733 (Num
=> (Lval
.Num
/ Rval
.Num
) *
734 (Rval
.Rbase
** Rval
.Den
),
746 Num
:= Lval
.Num
* (Lval
.Rbase
** (-Lval
.Den
));
751 Den
:= Rval
.Num
* (Lval
.Rbase
** Lval
.Den
);
754 if Rval
.Rbase
/= 0 then
756 Den
:= Den
* (Rval
.Rbase
** (-Rval
.Den
));
758 Num
:= Num
* (Rval
.Rbase
** Rval
.Den
);
762 Num
:= Num
* Rval
.Den
;
779 function UR_Eq
(Left
, Right
: Ureal
) return Boolean is
781 return not UR_Ne
(Left
, Right
);
784 ---------------------
785 -- UR_Exponentiate --
786 ---------------------
788 function UR_Exponentiate
(Real
: Ureal
; N
: Uint
) return Ureal
is
789 X
: constant Uint
:= abs N
;
796 -- If base is negative, then the resulting sign depends on whether
797 -- the exponent is even or odd (even => positive, odd = negative)
799 if UR_Is_Negative
(Real
) then
800 Neg
:= (N
mod 2) /= 0;
801 Bas
:= UR_Negate
(Real
);
807 Val
:= Ureals
.Table
(Bas
);
809 -- If the base is a small integer, then we can return the result in
810 -- exponential form, which can save a lot of time for junk exponents.
812 IBas
:= UR_Trunc
(Bas
);
815 and then UR_From_Uint
(IBas
) = Bas
820 Rbase
=> UI_To_Int
(UR_Trunc
(Bas
)),
823 -- If the exponent is negative then we raise the numerator and the
824 -- denominator (after normalization) to the absolute value of the
825 -- exponent and we return the reciprocal. An assert error will happen
826 -- if the numerator is zero.
829 pragma Assert
(Val
.Num
/= 0);
830 Val
:= Normalize
(Val
);
833 (Num
=> Val
.Den
** X
,
838 -- If positive, we distinguish the case when the base is not zero, in
839 -- which case the new denominator is just the product of the old one
840 -- with the exponent,
843 if Val
.Rbase
/= 0 then
846 (Num
=> Val
.Num
** X
,
851 -- And when the base is zero, in which case we exponentiate
852 -- the old denominator.
856 (Num
=> Val
.Num
** X
,
868 function UR_Floor
(Real
: Ureal
) return Uint
is
869 Val
: constant Ureal_Entry
:= Normalize
(Ureals
.Table
(Real
));
873 return UI_Negate
((Val
.Num
+ Val
.Den
- 1) / Val
.Den
);
875 return Val
.Num
/ Val
.Den
;
879 ------------------------
880 -- UR_From_Components --
881 ------------------------
883 function UR_From_Components
887 Negative
: Boolean := False)
895 Negative
=> Negative
));
896 end UR_From_Components
;
902 function UR_From_Uint
(UI
: Uint
) return Ureal
is
904 return UR_From_Components
905 (abs UI
, Uint_1
, Negative
=> (UI
< 0));
912 function UR_Ge
(Left
, Right
: Ureal
) return Boolean is
914 return not (Left
< Right
);
921 function UR_Gt
(Left
, Right
: Ureal
) return Boolean is
923 return (Right
< Left
);
930 function UR_Is_Negative
(Real
: Ureal
) return Boolean is
932 return Ureals
.Table
(Real
).Negative
;
939 function UR_Is_Positive
(Real
: Ureal
) return Boolean is
941 return not Ureals
.Table
(Real
).Negative
942 and then Ureals
.Table
(Real
).Num
/= 0;
949 function UR_Is_Zero
(Real
: Ureal
) return Boolean is
951 return Ureals
.Table
(Real
).Num
= 0;
958 function UR_Le
(Left
, Right
: Ureal
) return Boolean is
960 return not (Right
< Left
);
967 function UR_Lt
(Left
, Right
: Ureal
) return Boolean is
969 -- An operand is not less than itself
971 if Same
(Left
, Right
) then
974 -- Deal with zero cases
976 elsif UR_Is_Zero
(Left
) then
977 return UR_Is_Positive
(Right
);
979 elsif UR_Is_Zero
(Right
) then
980 return Ureals
.Table
(Left
).Negative
;
982 -- Different signs are decisive (note we dealt with zero cases)
984 elsif Ureals
.Table
(Left
).Negative
985 and then not Ureals
.Table
(Right
).Negative
989 elsif not Ureals
.Table
(Left
).Negative
990 and then Ureals
.Table
(Right
).Negative
994 -- Signs are same, do rapid check based on worst case estimates of
995 -- decimal exponent, which will often be decisive. Precise test
996 -- depends on whether operands are positive or negative.
998 elsif Decimal_Exponent_Hi
(Left
) < Decimal_Exponent_Lo
(Right
) then
999 return UR_Is_Positive
(Left
);
1001 elsif Decimal_Exponent_Lo
(Left
) > Decimal_Exponent_Hi
(Right
) then
1002 return UR_Is_Negative
(Left
);
1004 -- If we fall through, full gruesome test is required. This happens
1005 -- if the numbers are close together, or in some weird (/=10) base.
1009 Imrk
: constant Uintp
.Save_Mark
:= Mark
;
1010 Rmrk
: constant Urealp
.Save_Mark
:= Mark
;
1016 Lval
:= Ureals
.Table
(Left
);
1017 Rval
:= Ureals
.Table
(Right
);
1019 -- An optimization. If both numbers are based, then subtract
1020 -- common value of base to avoid unnecessarily giant numbers
1022 if Lval
.Rbase
= Rval
.Rbase
and then Lval
.Rbase
/= 0 then
1023 if Lval
.Den
< Rval
.Den
then
1024 Rval
.Den
:= Rval
.Den
- Lval
.Den
;
1027 Lval
.Den
:= Lval
.Den
- Rval
.Den
;
1032 Lval
:= Normalize
(Lval
);
1033 Rval
:= Normalize
(Rval
);
1035 if Lval
.Negative
then
1036 Result
:= (Lval
.Num
* Rval
.Den
) > (Rval
.Num
* Lval
.Den
);
1038 Result
:= (Lval
.Num
* Rval
.Den
) < (Rval
.Num
* Lval
.Den
);
1052 function UR_Max
(Left
, Right
: Ureal
) return Ureal
is
1054 if Left
>= Right
then
1065 function UR_Min
(Left
, Right
: Ureal
) return Ureal
is
1067 if Left
<= Right
then
1078 function UR_Mul
(Left
: Uint
; Right
: Ureal
) return Ureal
is
1080 return UR_From_Uint
(Left
) * Right
;
1083 function UR_Mul
(Left
: Ureal
; Right
: Uint
) return Ureal
is
1085 return Left
* UR_From_Uint
(Right
);
1088 function UR_Mul
(Left
, Right
: Ureal
) return Ureal
is
1089 Lval
: constant Ureal_Entry
:= Ureals
.Table
(Left
);
1090 Rval
: constant Ureal_Entry
:= Ureals
.Table
(Right
);
1091 Num
: Uint
:= Lval
.Num
* Rval
.Num
;
1093 Rneg
: constant Boolean := Lval
.Negative
xor Rval
.Negative
;
1096 if Lval
.Rbase
= 0 then
1097 if Rval
.Rbase
= 0 then
1098 return Store_Ureal
(
1101 Den
=> Lval
.Den
* Rval
.Den
,
1103 Negative
=> Rneg
)));
1105 elsif Is_Integer
(Num
, Lval
.Den
) then
1106 return Store_Ureal
(
1107 (Num
=> Num
/ Lval
.Den
,
1109 Rbase
=> Rval
.Rbase
,
1112 elsif Rval
.Den
< 0 then
1113 return Store_Ureal
(
1115 (Num
=> Num
* (Rval
.Rbase
** (-Rval
.Den
)),
1118 Negative
=> Rneg
)));
1121 return Store_Ureal
(
1124 Den
=> Lval
.Den
* (Rval
.Rbase
** Rval
.Den
),
1126 Negative
=> Rneg
)));
1129 elsif Lval
.Rbase
= Rval
.Rbase
then
1130 return Store_Ureal
(
1132 Den
=> Lval
.Den
+ Rval
.Den
,
1133 Rbase
=> Lval
.Rbase
,
1136 elsif Rval
.Rbase
= 0 then
1137 if Is_Integer
(Num
, Rval
.Den
) then
1138 return Store_Ureal
(
1139 (Num
=> Num
/ Rval
.Den
,
1141 Rbase
=> Lval
.Rbase
,
1144 elsif Lval
.Den
< 0 then
1145 return Store_Ureal
(
1147 (Num
=> Num
* (Lval
.Rbase
** (-Lval
.Den
)),
1150 Negative
=> Rneg
)));
1153 return Store_Ureal
(
1156 Den
=> Rval
.Den
* (Lval
.Rbase
** Lval
.Den
),
1158 Negative
=> Rneg
)));
1164 if Lval
.Den
< 0 then
1165 Num
:= Num
* (Lval
.Rbase
** (-Lval
.Den
));
1167 Den
:= Den
* (Lval
.Rbase
** Lval
.Den
);
1170 if Rval
.Den
< 0 then
1171 Num
:= Num
* (Rval
.Rbase
** (-Rval
.Den
));
1173 Den
:= Den
* (Rval
.Rbase
** Rval
.Den
);
1176 return Store_Ureal
(
1181 Negative
=> Rneg
)));
1189 function UR_Ne
(Left
, Right
: Ureal
) return Boolean is
1191 -- Quick processing for case of identical Ureal values (note that
1192 -- this also deals with comparing two No_Ureal values).
1194 if Same
(Left
, Right
) then
1197 -- Deal with case of one or other operand is No_Ureal, but not both
1199 elsif Same
(Left
, No_Ureal
) or else Same
(Right
, No_Ureal
) then
1202 -- Do quick check based on number of decimal digits
1204 elsif Decimal_Exponent_Hi
(Left
) < Decimal_Exponent_Lo
(Right
) or else
1205 Decimal_Exponent_Lo
(Left
) > Decimal_Exponent_Hi
(Right
)
1209 -- Otherwise full comparison is required
1213 Imrk
: constant Uintp
.Save_Mark
:= Mark
;
1214 Rmrk
: constant Urealp
.Save_Mark
:= Mark
;
1215 Lval
: constant Ureal_Entry
:= Normalize
(Ureals
.Table
(Left
));
1216 Rval
: constant Ureal_Entry
:= Normalize
(Ureals
.Table
(Right
));
1220 if UR_Is_Zero
(Left
) then
1221 return not UR_Is_Zero
(Right
);
1223 elsif UR_Is_Zero
(Right
) then
1224 return not UR_Is_Zero
(Left
);
1226 -- Both operands are non-zero
1230 Rval
.Negative
/= Lval
.Negative
1231 or else Rval
.Num
/= Lval
.Num
1232 or else Rval
.Den
/= Lval
.Den
;
1245 function UR_Negate
(Real
: Ureal
) return Ureal
is
1247 return Store_Ureal
(
1248 (Num
=> Ureals
.Table
(Real
).Num
,
1249 Den
=> Ureals
.Table
(Real
).Den
,
1250 Rbase
=> Ureals
.Table
(Real
).Rbase
,
1251 Negative
=> not Ureals
.Table
(Real
).Negative
));
1258 function UR_Sub
(Left
: Uint
; Right
: Ureal
) return Ureal
is
1260 return UR_From_Uint
(Left
) + UR_Negate
(Right
);
1263 function UR_Sub
(Left
: Ureal
; Right
: Uint
) return Ureal
is
1265 return Left
+ UR_From_Uint
(-Right
);
1268 function UR_Sub
(Left
, Right
: Ureal
) return Ureal
is
1270 return Left
+ UR_Negate
(Right
);
1277 function UR_To_Uint
(Real
: Ureal
) return Uint
is
1278 Val
: constant Ureal_Entry
:= Normalize
(Ureals
.Table
(Real
));
1282 Res
:= (Val
.Num
+ (Val
.Den
/ 2)) / Val
.Den
;
1284 if Val
.Negative
then
1285 return UI_Negate
(Res
);
1295 function UR_Trunc
(Real
: Ureal
) return Uint
is
1296 Val
: constant Ureal_Entry
:= Normalize
(Ureals
.Table
(Real
));
1299 if Val
.Negative
then
1300 return -(Val
.Num
/ Val
.Den
);
1302 return Val
.Num
/ Val
.Den
;
1310 procedure UR_Write
(Real
: Ureal
) is
1311 Val
: constant Ureal_Entry
:= Ureals
.Table
(Real
);
1314 -- If value is negative, we precede the constant by a minus sign
1315 -- and add an extra layer of parentheses on the outside since the
1316 -- minus sign is part of the value, not a negation operator.
1318 if Val
.Negative
then
1322 -- Constants in base 10 can be written in normal Ada literal style
1324 if Val
.Rbase
= 10 then
1325 UI_Write
(Val
.Num
/ 10);
1327 UI_Write
(Val
.Num
mod 10);
1329 if Val
.Den
/= 0 then
1331 UI_Write
(1 - Val
.Den
);
1334 -- Constants in a base other than 10 can still be easily written
1335 -- in normal Ada literal style if the numerator is one.
1337 elsif Val
.Rbase
/= 0 and then Val
.Num
= 1 then
1338 Write_Int
(Val
.Rbase
);
1339 Write_Str
("#1.0#E");
1340 UI_Write
(-Val
.Den
);
1342 -- Other constants with a base other than 10 are written using one
1343 -- of the following forms, depending on the sign of the number
1344 -- and the sign of the exponent (= minus denominator value)
1346 -- (numerator.0*base**exponent)
1347 -- (numerator.0*base**(-exponent))
1349 elsif Val
.Rbase
/= 0 then
1351 UI_Write
(Val
.Num
, Decimal
);
1353 Write_Int
(Val
.Rbase
);
1356 if Val
.Den
<= 0 then
1357 UI_Write
(-Val
.Den
, Decimal
);
1361 UI_Write
(Val
.Den
, Decimal
);
1367 -- Rational constants with a denominator of 1 can be written as
1368 -- a real literal for the numerator integer.
1370 elsif Val
.Den
= 1 then
1371 UI_Write
(Val
.Num
, Decimal
);
1374 -- Non-based (rational) constants are written in (num/den) style
1378 UI_Write
(Val
.Num
, Decimal
);
1380 UI_Write
(Val
.Den
, Decimal
);
1384 -- Add trailing paren for negative values
1386 if Val
.Negative
then
1395 function Ureal_0
return Ureal
is
1404 function Ureal_1
return Ureal
is
1413 function Ureal_2
return Ureal
is
1422 function Ureal_10
return Ureal
is
1431 function Ureal_100
return Ureal
is
1440 function Ureal_10_36
return Ureal
is
1449 function Ureal_2_80
return Ureal
is
1458 function Ureal_2_128
return Ureal
is
1467 function Ureal_2_M_80
return Ureal
is
1476 function Ureal_2_M_128
return Ureal
is
1485 function Ureal_Half
return Ureal
is
1494 function Ureal_M_0
return Ureal
is
1503 function Ureal_M_10_36
return Ureal
is
1512 function Ureal_Tenth
return Ureal
is