1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
9 -- Copyright (C) 1992-2003 Free Software Foundation, Inc. --
11 -- GNAT is free software; you can redistribute it and/or modify it under --
12 -- terms of the GNU General Public License as published by the Free Soft- --
13 -- ware Foundation; either version 2, or (at your option) any later ver- --
14 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
15 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
16 -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
17 -- for more details. You should have received a copy of the GNU General --
18 -- Public License distributed with GNAT; see file COPYING. If not, write --
19 -- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
20 -- MA 02111-1307, USA. --
22 -- As a special exception, if other files instantiate generics from this --
23 -- unit, or you link this unit with other files to produce an executable, --
24 -- this unit does not by itself cause the resulting executable to be --
25 -- covered by the GNU General Public License. This exception does not --
26 -- however invalidate any other reasons why the executable file might be --
27 -- covered by the GNU Public License. --
29 -- GNAT was originally developed by the GNAT team at New York University. --
30 -- Extensive contributions were provided by Ada Core Technologies Inc. --
32 ------------------------------------------------------------------------------
35 with Output
; use Output
;
37 with Tree_IO
; use Tree_IO
;
39 package body Urealp
is
41 Ureal_First_Entry
: constant Ureal
:= Ureal
'Succ (No_Ureal
);
42 -- First subscript allocated in Ureal table (note that we can't just
43 -- add 1 to No_Ureal, since "+" means something different for Ureals!
45 type Ureal_Entry
is record
47 -- Numerator (always non-negative)
50 -- Denominator (always non-zero, always positive if base is zero)
53 -- Base value. If Rbase is zero, then the value is simply Num / Den.
54 -- If Rbase is non-zero, then the value is Num / (Rbase ** Den)
57 -- Flag set if value is negative
60 package Ureals
is new Table
.Table
(
61 Table_Component_Type
=> Ureal_Entry
,
62 Table_Index_Type
=> Ureal
,
63 Table_Low_Bound
=> Ureal_First_Entry
,
64 Table_Initial
=> Alloc
.Ureals_Initial
,
65 Table_Increment
=> Alloc
.Ureals_Increment
,
66 Table_Name
=> "Ureals");
68 -- The following universal reals are the values returned by the constant
69 -- functions. They are initialized by the initialization procedure.
86 Num_Ureal_Constants
: constant := 10;
87 -- This is used for an assertion check in Tree_Read and Tree_Write to
88 -- help remember to add values to these routines when we add to the list.
90 Normalized_Real
: Ureal
:= No_Ureal
;
91 -- Used to memoize Norm_Num and Norm_Den, if either of these functions
92 -- is called, this value is set and Normalized_Entry contains the result
93 -- of the normalization. On subsequent calls, this is used to avoid the
94 -- call to Normalize if it has already been made.
96 Normalized_Entry
: Ureal_Entry
;
97 -- Entry built by most recent call to Normalize
99 -----------------------
100 -- Local Subprograms --
101 -----------------------
103 function Decimal_Exponent_Hi
(V
: Ureal
) return Int
;
104 -- Returns an estimate of the exponent of Val represented as a normalized
105 -- decimal number (non-zero digit before decimal point), The estimate is
106 -- either correct, or high, but never low. The accuracy of the estimate
107 -- affects only the efficiency of the comparison routines.
109 function Decimal_Exponent_Lo
(V
: Ureal
) return Int
;
110 -- Returns an estimate of the exponent of Val represented as a normalized
111 -- decimal number (non-zero digit before decimal point), The estimate is
112 -- either correct, or low, but never high. The accuracy of the estimate
113 -- affects only the efficiency of the comparison routines.
115 function Equivalent_Decimal_Exponent
(U
: Ureal_Entry
) return Int
;
116 -- U is a Ureal entry for which the base value is non-zero, the value
117 -- returned is the equivalent decimal exponent value, i.e. the value of
118 -- Den, adjusted as though the base were base 10. The value is rounded
119 -- to the nearest integer, and so can be one off.
121 function Is_Integer
(Num
, Den
: Uint
) return Boolean;
122 -- Return true if the real quotient of Num / Den is an integer value
124 function Normalize
(Val
: Ureal_Entry
) return Ureal_Entry
;
125 -- Normalizes the Ureal_Entry by reducing it to lowest terms (with a
128 function Same
(U1
, U2
: Ureal
) return Boolean;
129 pragma Inline
(Same
);
130 -- Determines if U1 and U2 are the same Ureal. Note that we cannot use
131 -- the equals operator for this test, since that tests for equality,
134 function Store_Ureal
(Val
: Ureal_Entry
) return Ureal
;
135 -- This store a new entry in the universal reals table and return
136 -- its index in the table.
138 -------------------------
139 -- Decimal_Exponent_Hi --
140 -------------------------
142 function Decimal_Exponent_Hi
(V
: Ureal
) return Int
is
143 Val
: constant Ureal_Entry
:= Ureals
.Table
(V
);
146 -- Zero always returns zero
148 if UR_Is_Zero
(V
) then
151 -- For numbers in rational form, get the maximum number of digits in the
152 -- numerator and the minimum number of digits in the denominator, and
153 -- subtract. For example:
155 -- 1000 / 99 = 1.010E+1
156 -- 9999 / 10 = 9.999E+2
158 -- This estimate may of course be high, but that is acceptable
160 elsif Val
.Rbase
= 0 then
161 return UI_Decimal_Digits_Hi
(Val
.Num
) -
162 UI_Decimal_Digits_Lo
(Val
.Den
);
164 -- For based numbers, just subtract the decimal exponent from the
165 -- high estimate of the number of digits in the numerator and add
166 -- one to accommodate possible round off errors for non-decimal
167 -- bases. For example:
169 -- 1_500_000 / 10**4 = 1.50E-2
171 else -- Val.Rbase /= 0
172 return UI_Decimal_Digits_Hi
(Val
.Num
) -
173 Equivalent_Decimal_Exponent
(Val
) + 1;
175 end Decimal_Exponent_Hi
;
177 -------------------------
178 -- Decimal_Exponent_Lo --
179 -------------------------
181 function Decimal_Exponent_Lo
(V
: Ureal
) return Int
is
182 Val
: constant Ureal_Entry
:= Ureals
.Table
(V
);
185 -- Zero always returns zero
187 if UR_Is_Zero
(V
) then
190 -- For numbers in rational form, get min digits in numerator, max digits
191 -- in denominator, and subtract and subtract one more for possible loss
192 -- during the division. For example:
194 -- 1000 / 99 = 1.010E+1
195 -- 9999 / 10 = 9.999E+2
197 -- This estimate may of course be low, but that is acceptable
199 elsif Val
.Rbase
= 0 then
200 return UI_Decimal_Digits_Lo
(Val
.Num
) -
201 UI_Decimal_Digits_Hi
(Val
.Den
) - 1;
203 -- For based numbers, just subtract the decimal exponent from the
204 -- low estimate of the number of digits in the numerator and subtract
205 -- one to accommodate possible round off errors for non-decimal
206 -- bases. For example:
208 -- 1_500_000 / 10**4 = 1.50E-2
210 else -- Val.Rbase /= 0
211 return UI_Decimal_Digits_Lo
(Val
.Num
) -
212 Equivalent_Decimal_Exponent
(Val
) - 1;
214 end Decimal_Exponent_Lo
;
220 function Denominator
(Real
: Ureal
) return Uint
is
222 return Ureals
.Table
(Real
).Den
;
225 ---------------------------------
226 -- Equivalent_Decimal_Exponent --
227 ---------------------------------
229 function Equivalent_Decimal_Exponent
(U
: Ureal_Entry
) return Int
is
231 -- The following table is a table of logs to the base 10
233 Logs
: constant array (Nat
range 1 .. 16) of Long_Float := (
234 1 => 0.000000000000000,
235 2 => 0.301029995663981,
236 3 => 0.477121254719662,
237 4 => 0.602059991327962,
238 5 => 0.698970004336019,
239 6 => 0.778151250383644,
240 7 => 0.845098040014257,
241 8 => 0.903089986991944,
242 9 => 0.954242509439325,
243 10 => 1.000000000000000,
244 11 => 1.041392685158230,
245 12 => 1.079181246047620,
246 13 => 1.113943352306840,
247 14 => 1.146128035678240,
248 15 => 1.176091259055680,
249 16 => 1.204119982655920);
252 pragma Assert
(U
.Rbase
/= 0);
253 return Int
(Long_Float (UI_To_Int
(U
.Den
)) * Logs
(U
.Rbase
));
254 end Equivalent_Decimal_Exponent
;
260 procedure Initialize
is
263 UR_0
:= UR_From_Components
(Uint_0
, Uint_1
, 0, False);
264 UR_M_0
:= UR_From_Components
(Uint_0
, Uint_1
, 0, True);
265 UR_Half
:= UR_From_Components
(Uint_1
, Uint_1
, 2, False);
266 UR_Tenth
:= UR_From_Components
(Uint_1
, Uint_1
, 10, False);
267 UR_1
:= UR_From_Components
(Uint_1
, Uint_1
, 0, False);
268 UR_2
:= UR_From_Components
(Uint_1
, Uint_Minus_1
, 2, False);
269 UR_10
:= UR_From_Components
(Uint_1
, Uint_Minus_1
, 10, False);
270 UR_10_36
:= UR_From_Components
(Uint_1
, Uint_Minus_36
, 10, False);
271 UR_M_10_36
:= UR_From_Components
(Uint_1
, Uint_Minus_36
, 10, True);
272 UR_100
:= UR_From_Components
(Uint_1
, Uint_Minus_2
, 10, False);
273 UR_2_128
:= UR_From_Components
(Uint_1
, Uint_Minus_128
, 2, False);
274 UR_2_M_128
:= UR_From_Components
(Uint_1
, Uint_128
, 2, False);
275 UR_2_80
:= UR_From_Components
(Uint_1
, Uint_Minus_80
, 2, False);
276 UR_2_M_80
:= UR_From_Components
(Uint_1
, Uint_80
, 2, False);
283 function Is_Integer
(Num
, Den
: Uint
) return Boolean is
285 return (Num
/ Den
) * Den
= Num
;
292 function Mark
return Save_Mark
is
294 return Save_Mark
(Ureals
.Last
);
301 function Norm_Den
(Real
: Ureal
) return Uint
is
303 if not Same
(Real
, Normalized_Real
) then
304 Normalized_Real
:= Real
;
305 Normalized_Entry
:= Normalize
(Ureals
.Table
(Real
));
308 return Normalized_Entry
.Den
;
315 function Norm_Num
(Real
: Ureal
) return Uint
is
317 if not Same
(Real
, Normalized_Real
) then
318 Normalized_Real
:= Real
;
319 Normalized_Entry
:= Normalize
(Ureals
.Table
(Real
));
322 return Normalized_Entry
.Num
;
329 function Normalize
(Val
: Ureal_Entry
) return Ureal_Entry
is
335 M
: constant Uintp
.Save_Mark
:= Uintp
.Mark
;
338 -- Start by setting J to the greatest of the absolute values of the
339 -- numerator and the denominator (taking into account the base value),
340 -- and K to the lesser of the two absolute values. The gcd of Num and
341 -- Den is the gcd of J and K.
343 if Val
.Rbase
= 0 then
347 elsif Val
.Den
< 0 then
348 J
:= Val
.Num
* Val
.Rbase
** (-Val
.Den
);
353 K
:= Val
.Rbase
** Val
.Den
;
368 Uintp
.Release_And_Save
(M
, Num
, Den
);
370 -- Divide numerator and denominator by gcd and return result
375 Negative
=> Val
.Negative
);
382 function Numerator
(Real
: Ureal
) return Uint
is
384 return Ureals
.Table
(Real
).Num
;
391 procedure pr
(Real
: Ureal
) is
401 function Rbase
(Real
: Ureal
) return Nat
is
403 return Ureals
.Table
(Real
).Rbase
;
410 procedure Release
(M
: Save_Mark
) is
412 Ureals
.Set_Last
(Ureal
(M
));
419 function Same
(U1
, U2
: Ureal
) return Boolean is
421 return Int
(U1
) = Int
(U2
);
428 function Store_Ureal
(Val
: Ureal_Entry
) return Ureal
is
430 Ureals
.Increment_Last
;
431 Ureals
.Table
(Ureals
.Last
) := Val
;
433 -- Normalize representation of signed values
436 Ureals
.Table
(Ureals
.Last
).Negative
:= True;
437 Ureals
.Table
(Ureals
.Last
).Num
:= -Val
.Num
;
447 procedure Tree_Read
is
449 pragma Assert
(Num_Ureal_Constants
= 10);
452 Tree_Read_Int
(Int
(UR_0
));
453 Tree_Read_Int
(Int
(UR_M_0
));
454 Tree_Read_Int
(Int
(UR_Tenth
));
455 Tree_Read_Int
(Int
(UR_Half
));
456 Tree_Read_Int
(Int
(UR_1
));
457 Tree_Read_Int
(Int
(UR_2
));
458 Tree_Read_Int
(Int
(UR_10
));
459 Tree_Read_Int
(Int
(UR_100
));
460 Tree_Read_Int
(Int
(UR_2_128
));
461 Tree_Read_Int
(Int
(UR_2_M_128
));
463 -- Clear the normalization cache
465 Normalized_Real
:= No_Ureal
;
472 procedure Tree_Write
is
474 pragma Assert
(Num_Ureal_Constants
= 10);
477 Tree_Write_Int
(Int
(UR_0
));
478 Tree_Write_Int
(Int
(UR_M_0
));
479 Tree_Write_Int
(Int
(UR_Tenth
));
480 Tree_Write_Int
(Int
(UR_Half
));
481 Tree_Write_Int
(Int
(UR_1
));
482 Tree_Write_Int
(Int
(UR_2
));
483 Tree_Write_Int
(Int
(UR_10
));
484 Tree_Write_Int
(Int
(UR_100
));
485 Tree_Write_Int
(Int
(UR_2_128
));
486 Tree_Write_Int
(Int
(UR_2_M_128
));
493 function UR_Abs
(Real
: Ureal
) return Ureal
is
494 Val
: constant Ureal_Entry
:= Ureals
.Table
(Real
);
508 function UR_Add
(Left
: Uint
; Right
: Ureal
) return Ureal
is
510 return UR_From_Uint
(Left
) + Right
;
513 function UR_Add
(Left
: Ureal
; Right
: Uint
) return Ureal
is
515 return Left
+ UR_From_Uint
(Right
);
518 function UR_Add
(Left
: Ureal
; Right
: Ureal
) return Ureal
is
519 Lval
: Ureal_Entry
:= Ureals
.Table
(Left
);
520 Rval
: Ureal_Entry
:= Ureals
.Table
(Right
);
525 -- Note, in the temporary Ureal_Entry values used in this procedure,
526 -- we store the sign as the sign of the numerator (i.e. xxx.Num may
527 -- be negative, even though in stored entries this can never be so)
529 if Lval
.Rbase
/= 0 and then Lval
.Rbase
= Rval
.Rbase
then
532 Opd_Min
, Opd_Max
: Ureal_Entry
;
533 Exp_Min
, Exp_Max
: Uint
;
536 if Lval
.Negative
then
537 Lval
.Num
:= (-Lval
.Num
);
540 if Rval
.Negative
then
541 Rval
.Num
:= (-Rval
.Num
);
544 if Lval
.Den
< Rval
.Den
then
557 Opd_Min
.Num
* Lval
.Rbase
** (Exp_Max
- Exp_Min
) + Opd_Max
.Num
;
564 Negative
=> Lval
.Negative
));
571 Negative
=> (Num
< 0)));
577 Ln
: Ureal_Entry
:= Normalize
(Lval
);
578 Rn
: Ureal_Entry
:= Normalize
(Rval
);
589 Num
:= (Ln
.Num
* Rn
.Den
) + (Rn
.Num
* Ln
.Den
);
596 Negative
=> Lval
.Negative
));
602 Den
=> Ln
.Den
* Rn
.Den
,
604 Negative
=> (Num
< 0))));
614 function UR_Ceiling
(Real
: Ureal
) return Uint
is
615 Val
: constant Ureal_Entry
:= Normalize
(Ureals
.Table
(Real
));
619 return UI_Negate
(Val
.Num
/ Val
.Den
);
621 return (Val
.Num
+ Val
.Den
- 1) / Val
.Den
;
629 function UR_Div
(Left
: Uint
; Right
: Ureal
) return Ureal
is
631 return UR_From_Uint
(Left
) / Right
;
634 function UR_Div
(Left
: Ureal
; Right
: Uint
) return Ureal
is
636 return Left
/ UR_From_Uint
(Right
);
639 function UR_Div
(Left
, Right
: Ureal
) return Ureal
is
640 Lval
: constant Ureal_Entry
:= Ureals
.Table
(Left
);
641 Rval
: constant Ureal_Entry
:= Ureals
.Table
(Right
);
642 Rneg
: constant Boolean := Rval
.Negative
xor Lval
.Negative
;
645 pragma Assert
(Rval
.Num
/= Uint_0
);
647 if Lval
.Rbase
= 0 then
649 if Rval
.Rbase
= 0 then
652 (Num
=> Lval
.Num
* Rval
.Den
,
653 Den
=> Lval
.Den
* Rval
.Num
,
657 elsif Is_Integer
(Lval
.Num
, Rval
.Num
* Lval
.Den
) then
659 (Num
=> Lval
.Num
/ (Rval
.Num
* Lval
.Den
),
664 elsif Rval
.Den
< 0 then
668 Den
=> Rval
.Rbase
** (-Rval
.Den
) *
677 (Num
=> Lval
.Num
* Rval
.Rbase
** Rval
.Den
,
678 Den
=> Rval
.Num
* Lval
.Den
,
683 elsif Is_Integer
(Lval
.Num
, Rval
.Num
) then
685 if Rval
.Rbase
= Lval
.Rbase
then
687 (Num
=> Lval
.Num
/ Rval
.Num
,
688 Den
=> Lval
.Den
- Rval
.Den
,
692 elsif Rval
.Rbase
= 0 then
694 (Num
=> (Lval
.Num
/ Rval
.Num
) * Rval
.Den
,
699 elsif Rval
.Den
< 0 then
705 Num
:= (Lval
.Num
/ Rval
.Num
) * (Lval
.Rbase
** (-Lval
.Den
));
706 Den
:= Rval
.Rbase
** (-Rval
.Den
);
708 Num
:= Lval
.Num
/ Rval
.Num
;
709 Den
:= (Lval
.Rbase
** Lval
.Den
) *
710 (Rval
.Rbase
** (-Rval
.Den
));
722 (Num
=> (Lval
.Num
/ Rval
.Num
) *
723 (Rval
.Rbase
** Rval
.Den
),
735 Num
:= Lval
.Num
* (Lval
.Rbase
** (-Lval
.Den
));
740 Den
:= Rval
.Num
* (Lval
.Rbase
** Lval
.Den
);
743 if Rval
.Rbase
/= 0 then
745 Den
:= Den
* (Rval
.Rbase
** (-Rval
.Den
));
747 Num
:= Num
* (Rval
.Rbase
** Rval
.Den
);
751 Num
:= Num
* Rval
.Den
;
768 function UR_Eq
(Left
, Right
: Ureal
) return Boolean is
770 return not UR_Ne
(Left
, Right
);
773 ---------------------
774 -- UR_Exponentiate --
775 ---------------------
777 function UR_Exponentiate
(Real
: Ureal
; N
: Uint
) return Ureal
is
778 X
: constant Uint
:= abs N
;
785 -- If base is negative, then the resulting sign depends on whether
786 -- the exponent is even or odd (even => positive, odd = negative)
788 if UR_Is_Negative
(Real
) then
789 Neg
:= (N
mod 2) /= 0;
790 Bas
:= UR_Negate
(Real
);
796 Val
:= Ureals
.Table
(Bas
);
798 -- If the base is a small integer, then we can return the result in
799 -- exponential form, which can save a lot of time for junk exponents.
801 IBas
:= UR_Trunc
(Bas
);
804 and then UR_From_Uint
(IBas
) = Bas
809 Rbase
=> UI_To_Int
(UR_Trunc
(Bas
)),
812 -- If the exponent is negative then we raise the numerator and the
813 -- denominator (after normalization) to the absolute value of the
814 -- exponent and we return the reciprocal. An assert error will happen
815 -- if the numerator is zero.
818 pragma Assert
(Val
.Num
/= 0);
819 Val
:= Normalize
(Val
);
822 (Num
=> Val
.Den
** X
,
827 -- If positive, we distinguish the case when the base is not zero, in
828 -- which case the new denominator is just the product of the old one
829 -- with the exponent,
832 if Val
.Rbase
/= 0 then
835 (Num
=> Val
.Num
** X
,
840 -- And when the base is zero, in which case we exponentiate
841 -- the old denominator.
845 (Num
=> Val
.Num
** X
,
857 function UR_Floor
(Real
: Ureal
) return Uint
is
858 Val
: constant Ureal_Entry
:= Normalize
(Ureals
.Table
(Real
));
862 return UI_Negate
((Val
.Num
+ Val
.Den
- 1) / Val
.Den
);
864 return Val
.Num
/ Val
.Den
;
868 ------------------------
869 -- UR_From_Components --
870 ------------------------
872 function UR_From_Components
876 Negative
: Boolean := False)
884 Negative
=> Negative
));
885 end UR_From_Components
;
891 function UR_From_Uint
(UI
: Uint
) return Ureal
is
893 return UR_From_Components
894 (abs UI
, Uint_1
, Negative
=> (UI
< 0));
901 function UR_Ge
(Left
, Right
: Ureal
) return Boolean is
903 return not (Left
< Right
);
910 function UR_Gt
(Left
, Right
: Ureal
) return Boolean is
912 return (Right
< Left
);
919 function UR_Is_Negative
(Real
: Ureal
) return Boolean is
921 return Ureals
.Table
(Real
).Negative
;
928 function UR_Is_Positive
(Real
: Ureal
) return Boolean is
930 return not Ureals
.Table
(Real
).Negative
931 and then Ureals
.Table
(Real
).Num
/= 0;
938 function UR_Is_Zero
(Real
: Ureal
) return Boolean is
940 return Ureals
.Table
(Real
).Num
= 0;
947 function UR_Le
(Left
, Right
: Ureal
) return Boolean is
949 return not (Right
< Left
);
956 function UR_Lt
(Left
, Right
: Ureal
) return Boolean is
958 -- An operand is not less than itself
960 if Same
(Left
, Right
) then
963 -- Deal with zero cases
965 elsif UR_Is_Zero
(Left
) then
966 return UR_Is_Positive
(Right
);
968 elsif UR_Is_Zero
(Right
) then
969 return Ureals
.Table
(Left
).Negative
;
971 -- Different signs are decisive (note we dealt with zero cases)
973 elsif Ureals
.Table
(Left
).Negative
974 and then not Ureals
.Table
(Right
).Negative
978 elsif not Ureals
.Table
(Left
).Negative
979 and then Ureals
.Table
(Right
).Negative
983 -- Signs are same, do rapid check based on worst case estimates of
984 -- decimal exponent, which will often be decisive. Precise test
985 -- depends on whether operands are positive or negative.
987 elsif Decimal_Exponent_Hi
(Left
) < Decimal_Exponent_Lo
(Right
) then
988 return UR_Is_Positive
(Left
);
990 elsif Decimal_Exponent_Lo
(Left
) > Decimal_Exponent_Hi
(Right
) then
991 return UR_Is_Negative
(Left
);
993 -- If we fall through, full gruesome test is required. This happens
994 -- if the numbers are close together, or in some weird (/=10) base.
998 Imrk
: constant Uintp
.Save_Mark
:= Mark
;
999 Rmrk
: constant Urealp
.Save_Mark
:= Mark
;
1005 Lval
:= Ureals
.Table
(Left
);
1006 Rval
:= Ureals
.Table
(Right
);
1008 -- An optimization. If both numbers are based, then subtract
1009 -- common value of base to avoid unnecessarily giant numbers
1011 if Lval
.Rbase
= Rval
.Rbase
and then Lval
.Rbase
/= 0 then
1012 if Lval
.Den
< Rval
.Den
then
1013 Rval
.Den
:= Rval
.Den
- Lval
.Den
;
1016 Lval
.Den
:= Lval
.Den
- Rval
.Den
;
1021 Lval
:= Normalize
(Lval
);
1022 Rval
:= Normalize
(Rval
);
1024 if Lval
.Negative
then
1025 Result
:= (Lval
.Num
* Rval
.Den
) > (Rval
.Num
* Lval
.Den
);
1027 Result
:= (Lval
.Num
* Rval
.Den
) < (Rval
.Num
* Lval
.Den
);
1041 function UR_Max
(Left
, Right
: Ureal
) return Ureal
is
1043 if Left
>= Right
then
1054 function UR_Min
(Left
, Right
: Ureal
) return Ureal
is
1056 if Left
<= Right
then
1067 function UR_Mul
(Left
: Uint
; Right
: Ureal
) return Ureal
is
1069 return UR_From_Uint
(Left
) * Right
;
1072 function UR_Mul
(Left
: Ureal
; Right
: Uint
) return Ureal
is
1074 return Left
* UR_From_Uint
(Right
);
1077 function UR_Mul
(Left
, Right
: Ureal
) return Ureal
is
1078 Lval
: constant Ureal_Entry
:= Ureals
.Table
(Left
);
1079 Rval
: constant Ureal_Entry
:= Ureals
.Table
(Right
);
1080 Num
: Uint
:= Lval
.Num
* Rval
.Num
;
1082 Rneg
: constant Boolean := Lval
.Negative
xor Rval
.Negative
;
1085 if Lval
.Rbase
= 0 then
1086 if Rval
.Rbase
= 0 then
1087 return Store_Ureal
(
1090 Den
=> Lval
.Den
* Rval
.Den
,
1092 Negative
=> Rneg
)));
1094 elsif Is_Integer
(Num
, Lval
.Den
) then
1095 return Store_Ureal
(
1096 (Num
=> Num
/ Lval
.Den
,
1098 Rbase
=> Rval
.Rbase
,
1101 elsif Rval
.Den
< 0 then
1102 return Store_Ureal
(
1104 (Num
=> Num
* (Rval
.Rbase
** (-Rval
.Den
)),
1107 Negative
=> Rneg
)));
1110 return Store_Ureal
(
1113 Den
=> Lval
.Den
* (Rval
.Rbase
** Rval
.Den
),
1115 Negative
=> Rneg
)));
1118 elsif Lval
.Rbase
= Rval
.Rbase
then
1119 return Store_Ureal
(
1121 Den
=> Lval
.Den
+ Rval
.Den
,
1122 Rbase
=> Lval
.Rbase
,
1125 elsif Rval
.Rbase
= 0 then
1126 if Is_Integer
(Num
, Rval
.Den
) then
1127 return Store_Ureal
(
1128 (Num
=> Num
/ Rval
.Den
,
1130 Rbase
=> Lval
.Rbase
,
1133 elsif Lval
.Den
< 0 then
1134 return Store_Ureal
(
1136 (Num
=> Num
* (Lval
.Rbase
** (-Lval
.Den
)),
1139 Negative
=> Rneg
)));
1142 return Store_Ureal
(
1145 Den
=> Rval
.Den
* (Lval
.Rbase
** Lval
.Den
),
1147 Negative
=> Rneg
)));
1153 if Lval
.Den
< 0 then
1154 Num
:= Num
* (Lval
.Rbase
** (-Lval
.Den
));
1156 Den
:= Den
* (Lval
.Rbase
** Lval
.Den
);
1159 if Rval
.Den
< 0 then
1160 Num
:= Num
* (Rval
.Rbase
** (-Rval
.Den
));
1162 Den
:= Den
* (Rval
.Rbase
** Rval
.Den
);
1165 return Store_Ureal
(
1170 Negative
=> Rneg
)));
1178 function UR_Ne
(Left
, Right
: Ureal
) return Boolean is
1180 -- Quick processing for case of identical Ureal values (note that
1181 -- this also deals with comparing two No_Ureal values).
1183 if Same
(Left
, Right
) then
1186 -- Deal with case of one or other operand is No_Ureal, but not both
1188 elsif Same
(Left
, No_Ureal
) or else Same
(Right
, No_Ureal
) then
1191 -- Do quick check based on number of decimal digits
1193 elsif Decimal_Exponent_Hi
(Left
) < Decimal_Exponent_Lo
(Right
) or else
1194 Decimal_Exponent_Lo
(Left
) > Decimal_Exponent_Hi
(Right
)
1198 -- Otherwise full comparison is required
1202 Imrk
: constant Uintp
.Save_Mark
:= Mark
;
1203 Rmrk
: constant Urealp
.Save_Mark
:= Mark
;
1204 Lval
: constant Ureal_Entry
:= Normalize
(Ureals
.Table
(Left
));
1205 Rval
: constant Ureal_Entry
:= Normalize
(Ureals
.Table
(Right
));
1209 if UR_Is_Zero
(Left
) then
1210 return not UR_Is_Zero
(Right
);
1212 elsif UR_Is_Zero
(Right
) then
1213 return not UR_Is_Zero
(Left
);
1215 -- Both operands are non-zero
1219 Rval
.Negative
/= Lval
.Negative
1220 or else Rval
.Num
/= Lval
.Num
1221 or else Rval
.Den
/= Lval
.Den
;
1234 function UR_Negate
(Real
: Ureal
) return Ureal
is
1236 return Store_Ureal
(
1237 (Num
=> Ureals
.Table
(Real
).Num
,
1238 Den
=> Ureals
.Table
(Real
).Den
,
1239 Rbase
=> Ureals
.Table
(Real
).Rbase
,
1240 Negative
=> not Ureals
.Table
(Real
).Negative
));
1247 function UR_Sub
(Left
: Uint
; Right
: Ureal
) return Ureal
is
1249 return UR_From_Uint
(Left
) + UR_Negate
(Right
);
1252 function UR_Sub
(Left
: Ureal
; Right
: Uint
) return Ureal
is
1254 return Left
+ UR_From_Uint
(-Right
);
1257 function UR_Sub
(Left
, Right
: Ureal
) return Ureal
is
1259 return Left
+ UR_Negate
(Right
);
1266 function UR_To_Uint
(Real
: Ureal
) return Uint
is
1267 Val
: constant Ureal_Entry
:= Normalize
(Ureals
.Table
(Real
));
1271 Res
:= (Val
.Num
+ (Val
.Den
/ 2)) / Val
.Den
;
1273 if Val
.Negative
then
1274 return UI_Negate
(Res
);
1284 function UR_Trunc
(Real
: Ureal
) return Uint
is
1285 Val
: constant Ureal_Entry
:= Normalize
(Ureals
.Table
(Real
));
1288 if Val
.Negative
then
1289 return -(Val
.Num
/ Val
.Den
);
1291 return Val
.Num
/ Val
.Den
;
1299 procedure UR_Write
(Real
: Ureal
) is
1300 Val
: constant Ureal_Entry
:= Ureals
.Table
(Real
);
1303 -- If value is negative, we precede the constant by a minus sign
1304 -- and add an extra layer of parentheses on the outside since the
1305 -- minus sign is part of the value, not a negation operator.
1307 if Val
.Negative
then
1311 -- Constants in base 10 can be written in normal Ada literal style
1313 if Val
.Rbase
= 10 then
1314 UI_Write
(Val
.Num
/ 10);
1316 UI_Write
(Val
.Num
mod 10);
1318 if Val
.Den
/= 0 then
1320 UI_Write
(1 - Val
.Den
);
1323 -- Constants in a base other than 10 can still be easily written
1324 -- in normal Ada literal style if the numerator is one.
1326 elsif Val
.Rbase
/= 0 and then Val
.Num
= 1 then
1327 Write_Int
(Val
.Rbase
);
1328 Write_Str
("#1.0#E");
1329 UI_Write
(-Val
.Den
);
1331 -- Other constants with a base other than 10 are written using one
1332 -- of the following forms, depending on the sign of the number
1333 -- and the sign of the exponent (= minus denominator value)
1335 -- (numerator.0*base**exponent)
1336 -- (numerator.0*base**(-exponent))
1338 elsif Val
.Rbase
/= 0 then
1340 UI_Write
(Val
.Num
, Decimal
);
1342 Write_Int
(Val
.Rbase
);
1345 if Val
.Den
<= 0 then
1346 UI_Write
(-Val
.Den
, Decimal
);
1350 UI_Write
(Val
.Den
, Decimal
);
1356 -- Rational constants with a denominator of 1 can be written as
1357 -- a real literal for the numerator integer.
1359 elsif Val
.Den
= 1 then
1360 UI_Write
(Val
.Num
, Decimal
);
1363 -- Non-based (rational) constants are written in (num/den) style
1367 UI_Write
(Val
.Num
, Decimal
);
1369 UI_Write
(Val
.Den
, Decimal
);
1373 -- Add trailing paren for negative values
1375 if Val
.Negative
then
1384 function Ureal_0
return Ureal
is
1393 function Ureal_1
return Ureal
is
1402 function Ureal_2
return Ureal
is
1411 function Ureal_10
return Ureal
is
1420 function Ureal_100
return Ureal
is
1429 function Ureal_10_36
return Ureal
is
1438 function Ureal_M_10_36
return Ureal
is
1447 function Ureal_2_128
return Ureal
is
1456 function Ureal_2_80
return Ureal
is
1465 function Ureal_2_M_128
return Ureal
is
1474 function Ureal_2_M_80
return Ureal
is
1483 function Ureal_Half
return Ureal
is
1492 function Ureal_M_0
return Ureal
is
1501 function Ureal_Tenth
return Ureal
is