1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
9 -- Copyright (C) 1992-2010, 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 base
140 function Same
(U1
, U2
: Ureal
) return Boolean;
141 pragma Inline
(Same
);
142 -- Determines if U1 and U2 are the same Ureal. Note that we cannot use
143 -- the equals operator for this test, since that tests for equality, not
146 function Store_Ureal
(Val
: Ureal_Entry
) return Ureal
;
147 -- This store a new entry in the universal reals table and return its index
150 function Store_Ureal_Normalized
(Val
: Ureal_Entry
) return Ureal
;
151 pragma Inline
(Store_Ureal_Normalized
);
152 -- Like Store_Ureal, but normalizes its operand first.
154 -------------------------
155 -- Decimal_Exponent_Hi --
156 -------------------------
158 function Decimal_Exponent_Hi
(V
: Ureal
) return Int
is
159 Val
: constant Ureal_Entry
:= Ureals
.Table
(V
);
162 -- Zero always returns zero
164 if UR_Is_Zero
(V
) then
167 -- For numbers in rational form, get the maximum number of digits in the
168 -- numerator and the minimum number of digits in the denominator, and
169 -- subtract. For example:
171 -- 1000 / 99 = 1.010E+1
172 -- 9999 / 10 = 9.999E+2
174 -- This estimate may of course be high, but that is acceptable
176 elsif Val
.Rbase
= 0 then
177 return UI_Decimal_Digits_Hi
(Val
.Num
) -
178 UI_Decimal_Digits_Lo
(Val
.Den
);
180 -- For based numbers, just subtract the decimal exponent from the
181 -- high estimate of the number of digits in the numerator and add
182 -- one to accommodate possible round off errors for non-decimal
183 -- bases. For example:
185 -- 1_500_000 / 10**4 = 1.50E-2
187 else -- Val.Rbase /= 0
188 return UI_Decimal_Digits_Hi
(Val
.Num
) -
189 Equivalent_Decimal_Exponent
(Val
) + 1;
191 end Decimal_Exponent_Hi
;
193 -------------------------
194 -- Decimal_Exponent_Lo --
195 -------------------------
197 function Decimal_Exponent_Lo
(V
: Ureal
) return Int
is
198 Val
: constant Ureal_Entry
:= Ureals
.Table
(V
);
201 -- Zero always returns zero
203 if UR_Is_Zero
(V
) then
206 -- For numbers in rational form, get min digits in numerator, max digits
207 -- in denominator, and subtract and subtract one more for possible loss
208 -- during the division. For example:
210 -- 1000 / 99 = 1.010E+1
211 -- 9999 / 10 = 9.999E+2
213 -- This estimate may of course be low, but that is acceptable
215 elsif Val
.Rbase
= 0 then
216 return UI_Decimal_Digits_Lo
(Val
.Num
) -
217 UI_Decimal_Digits_Hi
(Val
.Den
) - 1;
219 -- For based numbers, just subtract the decimal exponent from the
220 -- low estimate of the number of digits in the numerator and subtract
221 -- one to accommodate possible round off errors for non-decimal
222 -- bases. For example:
224 -- 1_500_000 / 10**4 = 1.50E-2
226 else -- Val.Rbase /= 0
227 return UI_Decimal_Digits_Lo
(Val
.Num
) -
228 Equivalent_Decimal_Exponent
(Val
) - 1;
230 end Decimal_Exponent_Lo
;
236 function Denominator
(Real
: Ureal
) return Uint
is
238 return Ureals
.Table
(Real
).Den
;
241 ---------------------------------
242 -- Equivalent_Decimal_Exponent --
243 ---------------------------------
245 function Equivalent_Decimal_Exponent
(U
: Ureal_Entry
) return Int
is
247 -- The following table is a table of logs to the base 10
249 Logs
: constant array (Nat
range 1 .. 16) of Long_Float := (
250 1 => 0.000000000000000,
251 2 => 0.301029995663981,
252 3 => 0.477121254719662,
253 4 => 0.602059991327962,
254 5 => 0.698970004336019,
255 6 => 0.778151250383644,
256 7 => 0.845098040014257,
257 8 => 0.903089986991944,
258 9 => 0.954242509439325,
259 10 => 1.000000000000000,
260 11 => 1.041392685158230,
261 12 => 1.079181246047620,
262 13 => 1.113943352306840,
263 14 => 1.146128035678240,
264 15 => 1.176091259055680,
265 16 => 1.204119982655920);
268 pragma Assert
(U
.Rbase
/= 0);
269 return Int
(Long_Float (UI_To_Int
(U
.Den
)) * Logs
(U
.Rbase
));
270 end Equivalent_Decimal_Exponent
;
276 procedure Initialize
is
279 UR_0
:= UR_From_Components
(Uint_0
, Uint_1
, 0, False);
280 UR_M_0
:= UR_From_Components
(Uint_0
, Uint_1
, 0, True);
281 UR_Half
:= UR_From_Components
(Uint_1
, Uint_1
, 2, False);
282 UR_Tenth
:= UR_From_Components
(Uint_1
, Uint_1
, 10, False);
283 UR_1
:= UR_From_Components
(Uint_1
, Uint_1
, 0, False);
284 UR_2
:= UR_From_Components
(Uint_1
, Uint_Minus_1
, 2, False);
285 UR_10
:= UR_From_Components
(Uint_1
, Uint_Minus_1
, 10, False);
286 UR_10_36
:= UR_From_Components
(Uint_1
, Uint_Minus_36
, 10, False);
287 UR_M_10_36
:= UR_From_Components
(Uint_1
, Uint_Minus_36
, 10, True);
288 UR_100
:= UR_From_Components
(Uint_1
, Uint_Minus_2
, 10, False);
289 UR_2_128
:= UR_From_Components
(Uint_1
, Uint_Minus_128
, 2, False);
290 UR_2_M_128
:= UR_From_Components
(Uint_1
, Uint_128
, 2, False);
291 UR_2_80
:= UR_From_Components
(Uint_1
, Uint_Minus_80
, 2, False);
292 UR_2_M_80
:= UR_From_Components
(Uint_1
, Uint_80
, 2, False);
299 function Is_Integer
(Num
, Den
: Uint
) return Boolean is
301 return (Num
/ Den
) * Den
= Num
;
308 function Mark
return Save_Mark
is
310 return Save_Mark
(Ureals
.Last
);
317 function Norm_Den
(Real
: Ureal
) return Uint
is
319 if not Same
(Real
, Normalized_Real
) then
320 Normalized_Real
:= Real
;
321 Normalized_Entry
:= Normalize
(Ureals
.Table
(Real
));
324 return Normalized_Entry
.Den
;
331 function Norm_Num
(Real
: Ureal
) return Uint
is
333 if not Same
(Real
, Normalized_Real
) then
334 Normalized_Real
:= Real
;
335 Normalized_Entry
:= Normalize
(Ureals
.Table
(Real
));
338 return Normalized_Entry
.Num
;
345 function Normalize
(Val
: Ureal_Entry
) return Ureal_Entry
is
351 M
: constant Uintp
.Save_Mark
:= Uintp
.Mark
;
354 -- Start by setting J to the greatest of the absolute values of the
355 -- numerator and the denominator (taking into account the base value),
356 -- and K to the lesser of the two absolute values. The gcd of Num and
357 -- Den is the gcd of J and K.
359 if Val
.Rbase
= 0 then
363 elsif Val
.Den
< 0 then
364 J
:= Val
.Num
* Val
.Rbase
** (-Val
.Den
);
369 K
:= Val
.Rbase
** Val
.Den
;
384 Uintp
.Release_And_Save
(M
, Num
, Den
);
386 -- Divide numerator and denominator by gcd and return result
391 Negative
=> Val
.Negative
);
398 function Numerator
(Real
: Ureal
) return Uint
is
400 return Ureals
.Table
(Real
).Num
;
407 procedure pr
(Real
: Ureal
) is
417 function Rbase
(Real
: Ureal
) return Nat
is
419 return Ureals
.Table
(Real
).Rbase
;
426 procedure Release
(M
: Save_Mark
) is
428 Ureals
.Set_Last
(Ureal
(M
));
435 function Same
(U1
, U2
: Ureal
) return Boolean is
437 return Int
(U1
) = Int
(U2
);
444 function Store_Ureal
(Val
: Ureal_Entry
) return Ureal
is
448 -- Normalize representation of signed values
451 Ureals
.Table
(Ureals
.Last
).Negative
:= True;
452 Ureals
.Table
(Ureals
.Last
).Num
:= -Val
.Num
;
458 ----------------------------
459 -- Store_Ureal_Normalized --
460 ----------------------------
462 function Store_Ureal_Normalized
(Val
: Ureal_Entry
) return Ureal
is
464 return Store_Ureal
(Normalize
(Val
));
465 end Store_Ureal_Normalized
;
471 procedure Tree_Read
is
473 pragma Assert
(Num_Ureal_Constants
= 10);
476 Tree_Read_Int
(Int
(UR_0
));
477 Tree_Read_Int
(Int
(UR_M_0
));
478 Tree_Read_Int
(Int
(UR_Tenth
));
479 Tree_Read_Int
(Int
(UR_Half
));
480 Tree_Read_Int
(Int
(UR_1
));
481 Tree_Read_Int
(Int
(UR_2
));
482 Tree_Read_Int
(Int
(UR_10
));
483 Tree_Read_Int
(Int
(UR_100
));
484 Tree_Read_Int
(Int
(UR_2_128
));
485 Tree_Read_Int
(Int
(UR_2_M_128
));
487 -- Clear the normalization cache
489 Normalized_Real
:= No_Ureal
;
496 procedure Tree_Write
is
498 pragma Assert
(Num_Ureal_Constants
= 10);
501 Tree_Write_Int
(Int
(UR_0
));
502 Tree_Write_Int
(Int
(UR_M_0
));
503 Tree_Write_Int
(Int
(UR_Tenth
));
504 Tree_Write_Int
(Int
(UR_Half
));
505 Tree_Write_Int
(Int
(UR_1
));
506 Tree_Write_Int
(Int
(UR_2
));
507 Tree_Write_Int
(Int
(UR_10
));
508 Tree_Write_Int
(Int
(UR_100
));
509 Tree_Write_Int
(Int
(UR_2_128
));
510 Tree_Write_Int
(Int
(UR_2_M_128
));
517 function UR_Abs
(Real
: Ureal
) return Ureal
is
518 Val
: constant Ureal_Entry
:= Ureals
.Table
(Real
);
532 function UR_Add
(Left
: Uint
; Right
: Ureal
) return Ureal
is
534 return UR_From_Uint
(Left
) + Right
;
537 function UR_Add
(Left
: Ureal
; Right
: Uint
) return Ureal
is
539 return Left
+ UR_From_Uint
(Right
);
542 function UR_Add
(Left
: Ureal
; Right
: Ureal
) return Ureal
is
543 Lval
: Ureal_Entry
:= Ureals
.Table
(Left
);
544 Rval
: Ureal_Entry
:= Ureals
.Table
(Right
);
548 -- Note, in the temporary Ureal_Entry values used in this procedure,
549 -- we store the sign as the sign of the numerator (i.e. xxx.Num may
550 -- be negative, even though in stored entries this can never be so)
552 if Lval
.Rbase
/= 0 and then Lval
.Rbase
= Rval
.Rbase
then
554 Opd_Min
, Opd_Max
: Ureal_Entry
;
555 Exp_Min
, Exp_Max
: Uint
;
558 if Lval
.Negative
then
559 Lval
.Num
:= (-Lval
.Num
);
562 if Rval
.Negative
then
563 Rval
.Num
:= (-Rval
.Num
);
566 if Lval
.Den
< Rval
.Den
then
579 Opd_Min
.Num
* Lval
.Rbase
** (Exp_Max
- Exp_Min
) + Opd_Max
.Num
;
586 Negative
=> Lval
.Negative
));
593 Negative
=> (Num
< 0)));
599 Ln
: Ureal_Entry
:= Normalize
(Lval
);
600 Rn
: Ureal_Entry
:= Normalize
(Rval
);
611 Num
:= (Ln
.Num
* Rn
.Den
) + (Rn
.Num
* Ln
.Den
);
618 Negative
=> Lval
.Negative
));
621 return Store_Ureal_Normalized
623 Den
=> Ln
.Den
* Rn
.Den
,
625 Negative
=> (Num
< 0)));
635 function UR_Ceiling
(Real
: Ureal
) return Uint
is
636 Val
: constant Ureal_Entry
:= Normalize
(Ureals
.Table
(Real
));
639 return UI_Negate
(Val
.Num
/ Val
.Den
);
641 return (Val
.Num
+ Val
.Den
- 1) / Val
.Den
;
649 function UR_Div
(Left
: Uint
; Right
: Ureal
) return Ureal
is
651 return UR_From_Uint
(Left
) / Right
;
654 function UR_Div
(Left
: Ureal
; Right
: Uint
) return Ureal
is
656 return Left
/ UR_From_Uint
(Right
);
659 function UR_Div
(Left
, Right
: Ureal
) return Ureal
is
660 Lval
: constant Ureal_Entry
:= Ureals
.Table
(Left
);
661 Rval
: constant Ureal_Entry
:= Ureals
.Table
(Right
);
662 Rneg
: constant Boolean := Rval
.Negative
xor Lval
.Negative
;
665 pragma Assert
(Rval
.Num
/= Uint_0
);
667 if Lval
.Rbase
= 0 then
668 if Rval
.Rbase
= 0 then
669 return Store_Ureal_Normalized
670 ((Num
=> Lval
.Num
* Rval
.Den
,
671 Den
=> Lval
.Den
* Rval
.Num
,
675 elsif Is_Integer
(Lval
.Num
, Rval
.Num
* Lval
.Den
) then
677 ((Num
=> Lval
.Num
/ (Rval
.Num
* Lval
.Den
),
682 elsif Rval
.Den
< 0 then
683 return Store_Ureal_Normalized
685 Den
=> Rval
.Rbase
** (-Rval
.Den
) *
692 return Store_Ureal_Normalized
693 ((Num
=> Lval
.Num
* Rval
.Rbase
** Rval
.Den
,
694 Den
=> Rval
.Num
* Lval
.Den
,
699 elsif Is_Integer
(Lval
.Num
, Rval
.Num
) then
700 if Rval
.Rbase
= Lval
.Rbase
then
702 ((Num
=> Lval
.Num
/ Rval
.Num
,
703 Den
=> Lval
.Den
- Rval
.Den
,
707 elsif Rval
.Rbase
= 0 then
709 ((Num
=> (Lval
.Num
/ Rval
.Num
) * Rval
.Den
,
714 elsif Rval
.Den
< 0 then
720 Num
:= (Lval
.Num
/ Rval
.Num
) * (Lval
.Rbase
** (-Lval
.Den
));
721 Den
:= Rval
.Rbase
** (-Rval
.Den
);
723 Num
:= Lval
.Num
/ Rval
.Num
;
724 Den
:= (Lval
.Rbase
** Lval
.Den
) *
725 (Rval
.Rbase
** (-Rval
.Den
));
737 ((Num
=> (Lval
.Num
/ Rval
.Num
) *
738 (Rval
.Rbase
** Rval
.Den
),
750 Num
:= Lval
.Num
* (Lval
.Rbase
** (-Lval
.Den
));
754 Den
:= Rval
.Num
* (Lval
.Rbase
** Lval
.Den
);
757 if Rval
.Rbase
/= 0 then
759 Den
:= Den
* (Rval
.Rbase
** (-Rval
.Den
));
761 Num
:= Num
* (Rval
.Rbase
** Rval
.Den
);
765 Num
:= Num
* Rval
.Den
;
768 return Store_Ureal_Normalized
781 function UR_Eq
(Left
, Right
: Ureal
) return Boolean is
783 return not UR_Ne
(Left
, Right
);
786 ---------------------
787 -- UR_Exponentiate --
788 ---------------------
790 function UR_Exponentiate
(Real
: Ureal
; N
: Uint
) return Ureal
is
791 X
: constant Uint
:= abs N
;
798 -- If base is negative, then the resulting sign depends on whether
799 -- the exponent is even or odd (even => positive, odd = negative)
801 if UR_Is_Negative
(Real
) then
802 Neg
:= (N
mod 2) /= 0;
803 Bas
:= UR_Negate
(Real
);
809 Val
:= Ureals
.Table
(Bas
);
811 -- If the base is a small integer, then we can return the result in
812 -- exponential form, which can save a lot of time for junk exponents.
814 IBas
:= UR_Trunc
(Bas
);
817 and then UR_From_Uint
(IBas
) = Bas
822 Rbase
=> UI_To_Int
(UR_Trunc
(Bas
)),
825 -- If the exponent is negative then we raise the numerator and the
826 -- denominator (after normalization) to the absolute value of the
827 -- exponent and we return the reciprocal. An assert error will happen
828 -- if the numerator is zero.
831 pragma Assert
(Val
.Num
/= 0);
832 Val
:= Normalize
(Val
);
835 ((Num
=> Val
.Den
** X
,
840 -- If positive, we distinguish the case when the base is not zero, in
841 -- which case the new denominator is just the product of the old one
842 -- with the exponent,
845 if Val
.Rbase
/= 0 then
848 ((Num
=> Val
.Num
** X
,
853 -- And when the base is zero, in which case we exponentiate
854 -- the old denominator.
858 ((Num
=> Val
.Num
** X
,
870 function UR_Floor
(Real
: Ureal
) return Uint
is
871 Val
: constant Ureal_Entry
:= Normalize
(Ureals
.Table
(Real
));
874 return UI_Negate
((Val
.Num
+ Val
.Den
- 1) / Val
.Den
);
876 return Val
.Num
/ Val
.Den
;
880 ------------------------
881 -- UR_From_Components --
882 ------------------------
884 function UR_From_Components
888 Negative
: Boolean := False)
896 Negative
=> Negative
));
897 end UR_From_Components
;
903 function UR_From_Uint
(UI
: Uint
) return Ureal
is
905 return UR_From_Components
906 (abs UI
, Uint_1
, Negative
=> (UI
< 0));
913 function UR_Ge
(Left
, Right
: Ureal
) return Boolean is
915 return not (Left
< Right
);
922 function UR_Gt
(Left
, Right
: Ureal
) return Boolean is
924 return (Right
< Left
);
931 function UR_Is_Negative
(Real
: Ureal
) return Boolean is
933 return Ureals
.Table
(Real
).Negative
;
940 function UR_Is_Positive
(Real
: Ureal
) return Boolean is
942 return not Ureals
.Table
(Real
).Negative
943 and then Ureals
.Table
(Real
).Num
/= 0;
950 function UR_Is_Zero
(Real
: Ureal
) return Boolean is
952 return Ureals
.Table
(Real
).Num
= 0;
959 function UR_Le
(Left
, Right
: Ureal
) return Boolean is
961 return not (Right
< Left
);
968 function UR_Lt
(Left
, Right
: Ureal
) return Boolean is
970 -- An operand is not less than itself
972 if Same
(Left
, Right
) then
975 -- Deal with zero cases
977 elsif UR_Is_Zero
(Left
) then
978 return UR_Is_Positive
(Right
);
980 elsif UR_Is_Zero
(Right
) then
981 return Ureals
.Table
(Left
).Negative
;
983 -- Different signs are decisive (note we dealt with zero cases)
985 elsif Ureals
.Table
(Left
).Negative
986 and then not Ureals
.Table
(Right
).Negative
990 elsif not Ureals
.Table
(Left
).Negative
991 and then Ureals
.Table
(Right
).Negative
995 -- Signs are same, do rapid check based on worst case estimates of
996 -- decimal exponent, which will often be decisive. Precise test
997 -- depends on whether operands are positive or negative.
999 elsif Decimal_Exponent_Hi
(Left
) < Decimal_Exponent_Lo
(Right
) then
1000 return UR_Is_Positive
(Left
);
1002 elsif Decimal_Exponent_Lo
(Left
) > Decimal_Exponent_Hi
(Right
) then
1003 return UR_Is_Negative
(Left
);
1005 -- If we fall through, full gruesome test is required. This happens
1006 -- if the numbers are close together, or in some weird (/=10) base.
1010 Imrk
: constant Uintp
.Save_Mark
:= Mark
;
1011 Rmrk
: constant Urealp
.Save_Mark
:= Mark
;
1017 Lval
:= Ureals
.Table
(Left
);
1018 Rval
:= Ureals
.Table
(Right
);
1020 -- An optimization. If both numbers are based, then subtract
1021 -- common value of base to avoid unnecessarily giant numbers
1023 if Lval
.Rbase
= Rval
.Rbase
and then Lval
.Rbase
/= 0 then
1024 if Lval
.Den
< Rval
.Den
then
1025 Rval
.Den
:= Rval
.Den
- Lval
.Den
;
1028 Lval
.Den
:= Lval
.Den
- Rval
.Den
;
1033 Lval
:= Normalize
(Lval
);
1034 Rval
:= Normalize
(Rval
);
1036 if Lval
.Negative
then
1037 Result
:= (Lval
.Num
* Rval
.Den
) > (Rval
.Num
* Lval
.Den
);
1039 Result
:= (Lval
.Num
* Rval
.Den
) < (Rval
.Num
* Lval
.Den
);
1053 function UR_Max
(Left
, Right
: Ureal
) return Ureal
is
1055 if Left
>= Right
then
1066 function UR_Min
(Left
, Right
: Ureal
) return Ureal
is
1068 if Left
<= Right
then
1079 function UR_Mul
(Left
: Uint
; Right
: Ureal
) return Ureal
is
1081 return UR_From_Uint
(Left
) * Right
;
1084 function UR_Mul
(Left
: Ureal
; Right
: Uint
) return Ureal
is
1086 return Left
* UR_From_Uint
(Right
);
1089 function UR_Mul
(Left
, Right
: Ureal
) return Ureal
is
1090 Lval
: constant Ureal_Entry
:= Ureals
.Table
(Left
);
1091 Rval
: constant Ureal_Entry
:= Ureals
.Table
(Right
);
1092 Num
: Uint
:= Lval
.Num
* Rval
.Num
;
1094 Rneg
: constant Boolean := Lval
.Negative
xor Rval
.Negative
;
1097 if Lval
.Rbase
= 0 then
1098 if Rval
.Rbase
= 0 then
1099 return Store_Ureal_Normalized
1101 Den
=> Lval
.Den
* Rval
.Den
,
1105 elsif Is_Integer
(Num
, Lval
.Den
) then
1107 ((Num
=> Num
/ Lval
.Den
,
1109 Rbase
=> Rval
.Rbase
,
1112 elsif Rval
.Den
< 0 then
1113 return Store_Ureal_Normalized
1114 ((Num
=> Num
* (Rval
.Rbase
** (-Rval
.Den
)),
1120 return Store_Ureal_Normalized
1122 Den
=> Lval
.Den
* (Rval
.Rbase
** Rval
.Den
),
1127 elsif Lval
.Rbase
= Rval
.Rbase
then
1130 Den
=> Lval
.Den
+ Rval
.Den
,
1131 Rbase
=> Lval
.Rbase
,
1134 elsif Rval
.Rbase
= 0 then
1135 if Is_Integer
(Num
, Rval
.Den
) then
1137 ((Num
=> Num
/ Rval
.Den
,
1139 Rbase
=> Lval
.Rbase
,
1142 elsif Lval
.Den
< 0 then
1143 return Store_Ureal_Normalized
1144 ((Num
=> Num
* (Lval
.Rbase
** (-Lval
.Den
)),
1150 return Store_Ureal_Normalized
1152 Den
=> Rval
.Den
* (Lval
.Rbase
** Lval
.Den
),
1160 if Lval
.Den
< 0 then
1161 Num
:= Num
* (Lval
.Rbase
** (-Lval
.Den
));
1163 Den
:= Den
* (Lval
.Rbase
** Lval
.Den
);
1166 if Rval
.Den
< 0 then
1167 Num
:= Num
* (Rval
.Rbase
** (-Rval
.Den
));
1169 Den
:= Den
* (Rval
.Rbase
** Rval
.Den
);
1172 return Store_Ureal_Normalized
1184 function UR_Ne
(Left
, Right
: Ureal
) return Boolean is
1186 -- Quick processing for case of identical Ureal values (note that
1187 -- this also deals with comparing two No_Ureal values).
1189 if Same
(Left
, Right
) then
1192 -- Deal with case of one or other operand is No_Ureal, but not both
1194 elsif Same
(Left
, No_Ureal
) or else Same
(Right
, No_Ureal
) then
1197 -- Do quick check based on number of decimal digits
1199 elsif Decimal_Exponent_Hi
(Left
) < Decimal_Exponent_Lo
(Right
) or else
1200 Decimal_Exponent_Lo
(Left
) > Decimal_Exponent_Hi
(Right
)
1204 -- Otherwise full comparison is required
1208 Imrk
: constant Uintp
.Save_Mark
:= Mark
;
1209 Rmrk
: constant Urealp
.Save_Mark
:= Mark
;
1210 Lval
: constant Ureal_Entry
:= Normalize
(Ureals
.Table
(Left
));
1211 Rval
: constant Ureal_Entry
:= Normalize
(Ureals
.Table
(Right
));
1215 if UR_Is_Zero
(Left
) then
1216 return not UR_Is_Zero
(Right
);
1218 elsif UR_Is_Zero
(Right
) then
1219 return not UR_Is_Zero
(Left
);
1221 -- Both operands are non-zero
1225 Rval
.Negative
/= Lval
.Negative
1226 or else Rval
.Num
/= Lval
.Num
1227 or else Rval
.Den
/= Lval
.Den
;
1240 function UR_Negate
(Real
: Ureal
) return Ureal
is
1243 ((Num
=> Ureals
.Table
(Real
).Num
,
1244 Den
=> Ureals
.Table
(Real
).Den
,
1245 Rbase
=> Ureals
.Table
(Real
).Rbase
,
1246 Negative
=> not Ureals
.Table
(Real
).Negative
));
1253 function UR_Sub
(Left
: Uint
; Right
: Ureal
) return Ureal
is
1255 return UR_From_Uint
(Left
) + UR_Negate
(Right
);
1258 function UR_Sub
(Left
: Ureal
; Right
: Uint
) return Ureal
is
1260 return Left
+ UR_From_Uint
(-Right
);
1263 function UR_Sub
(Left
, Right
: Ureal
) return Ureal
is
1265 return Left
+ UR_Negate
(Right
);
1272 function UR_To_Uint
(Real
: Ureal
) return Uint
is
1273 Val
: constant Ureal_Entry
:= Normalize
(Ureals
.Table
(Real
));
1277 Res
:= (Val
.Num
+ (Val
.Den
/ 2)) / Val
.Den
;
1279 if Val
.Negative
then
1280 return UI_Negate
(Res
);
1290 function UR_Trunc
(Real
: Ureal
) return Uint
is
1291 Val
: constant Ureal_Entry
:= Normalize
(Ureals
.Table
(Real
));
1293 if Val
.Negative
then
1294 return -(Val
.Num
/ Val
.Den
);
1296 return Val
.Num
/ Val
.Den
;
1304 procedure UR_Write
(Real
: Ureal
; Brackets
: Boolean := False) is
1305 Val
: constant Ureal_Entry
:= Ureals
.Table
(Real
);
1309 -- If value is negative, we precede the constant by a minus sign
1311 if Val
.Negative
then
1320 -- For constants with a denominator of zero, the value is simply the
1321 -- numerator value, since we are dividing by base**0, which is 1.
1323 elsif Val
.Den
= 0 then
1324 UI_Write
(Val
.Num
, Decimal
);
1327 -- Small powers of 2 get written in decimal fixed-point format
1330 and then Val
.Den
<= 3
1331 and then Val
.Den
>= -16
1334 T
:= Val
.Num
* (10/2);
1335 UI_Write
(T
/ 10, Decimal
);
1337 UI_Write
(T
mod 10, Decimal
);
1339 elsif Val
.Den
= 2 then
1340 T
:= Val
.Num
* (100/4);
1341 UI_Write
(T
/ 100, Decimal
);
1343 UI_Write
(T
mod 100 / 10, Decimal
);
1345 if T
mod 10 /= 0 then
1346 UI_Write
(T
mod 10, Decimal
);
1349 elsif Val
.Den
= 3 then
1350 T
:= Val
.Num
* (1000 / 8);
1351 UI_Write
(T
/ 1000, Decimal
);
1353 UI_Write
(T
mod 1000 / 100, Decimal
);
1355 if T
mod 100 /= 0 then
1356 UI_Write
(T
mod 100 / 10, Decimal
);
1358 if T
mod 10 /= 0 then
1359 UI_Write
(T
mod 10, Decimal
);
1364 UI_Write
(Val
.Num
* (Uint_2
** (-Val
.Den
)), Decimal
);
1368 -- Constants in base 10 or 16 can be written in normal Ada literal
1369 -- style, as long as they fit in the UI_Image_Buffer. Using hexadecimal
1370 -- notation, 4 bytes are required for the 16# # part, and every fifth
1371 -- character is an underscore. So, a buffer of size N has room for
1372 -- ((N - 4) - (N - 4) / 5) * 4 bits,
1374 -- N * 16 / 5 - 12 bits.
1376 elsif (Val
.Rbase
= 10 or else Val
.Rbase
= 16)
1377 and then Num_Bits
(Val
.Num
) < UI_Image_Buffer
'Length * 16 / 5 - 12
1379 pragma Assert
(Val
.Den
/= 0);
1381 -- Use fixed-point format for small scaling values
1383 if (Val
.Rbase
= 10 and then Val
.Den
< 0 and then Val
.Den
> -3)
1384 or else (Val
.Rbase
= 16 and then Val
.Den
= -1)
1386 UI_Write
(Val
.Num
* Val
.Rbase
**(-Val
.Den
), Decimal
);
1389 -- Write hexadecimal constants in exponential notation with a zero
1390 -- unit digit. This matches the Ada canonical form for floating point
1391 -- numbers, and also ensures that the underscores end up in the
1394 elsif Val
.Rbase
= 16 then
1395 UI_Image
(Val
.Num
, Hex
);
1396 pragma Assert
(Val
.Rbase
= 16);
1398 Write_Str
("16#0.");
1399 Write_Str
(UI_Image_Buffer
(4 .. UI_Image_Length
));
1401 -- For exponent, exclude 16# # and underscores from length
1403 UI_Image_Length
:= UI_Image_Length
- 4;
1404 UI_Image_Length
:= UI_Image_Length
- UI_Image_Length
/ 5;
1407 UI_Write
(Int
(UI_Image_Length
) - Val
.Den
, Decimal
);
1409 elsif Val
.Den
= 1 then
1410 UI_Write
(Val
.Num
/ 10, Decimal
);
1412 UI_Write
(Val
.Num
mod 10, Decimal
);
1414 elsif Val
.Den
= 2 then
1415 UI_Write
(Val
.Num
/ 100, Decimal
);
1417 UI_Write
(Val
.Num
/ 10 mod 10, Decimal
);
1418 UI_Write
(Val
.Num
mod 10, Decimal
);
1420 -- Else use decimal exponential format
1423 -- Write decimal constants with a non-zero unit digit. This
1424 -- matches usual scientific notation.
1426 UI_Image
(Val
.Num
, Decimal
);
1427 Write_Char
(UI_Image_Buffer
(1));
1430 if UI_Image_Length
= 1 then
1433 Write_Str
(UI_Image_Buffer
(2 .. UI_Image_Length
));
1437 UI_Write
(Int
(UI_Image_Length
- 1) - Val
.Den
, Decimal
);
1440 -- Constants in a base other than 10 can still be easily written in
1441 -- normal Ada literal style if the numerator is one.
1443 elsif Val
.Rbase
/= 0 and then Val
.Num
= 1 then
1444 Write_Int
(Val
.Rbase
);
1445 Write_Str
("#1.0#E");
1446 UI_Write
(-Val
.Den
);
1448 -- Other constants with a base other than 10 are written using one
1449 -- of the following forms, depending on the sign of the number
1450 -- and the sign of the exponent (= minus denominator value)
1452 -- numerator.0*base**exponent
1453 -- numerator.0*base**-exponent
1455 -- And of course an exponent of 0 can be omitted
1457 elsif Val
.Rbase
/= 0 then
1462 UI_Write
(Val
.Num
, Decimal
);
1465 if Val
.Den
/= 0 then
1467 Write_Int
(Val
.Rbase
);
1470 if Val
.Den
<= 0 then
1471 UI_Write
(-Val
.Den
, Decimal
);
1474 UI_Write
(Val
.Den
, Decimal
);
1483 -- Rationals where numerator is divisible by denominator can be output
1484 -- as literals after we do the division. This includes the common case
1485 -- where the denominator is 1.
1487 elsif Val
.Num
mod Val
.Den
= 0 then
1488 UI_Write
(Val
.Num
/ Val
.Den
, Decimal
);
1491 -- Other non-based (rational) constants are written in num/den style
1498 UI_Write
(Val
.Num
, Decimal
);
1500 UI_Write
(Val
.Den
, Decimal
);
1513 function Ureal_0
return Ureal
is
1522 function Ureal_1
return Ureal
is
1531 function Ureal_2
return Ureal
is
1540 function Ureal_10
return Ureal
is
1549 function Ureal_100
return Ureal
is
1558 function Ureal_10_36
return Ureal
is
1567 function Ureal_2_80
return Ureal
is
1576 function Ureal_2_128
return Ureal
is
1585 function Ureal_2_M_80
return Ureal
is
1594 function Ureal_2_M_128
return Ureal
is
1603 function Ureal_Half
return Ureal
is
1612 function Ureal_M_0
return Ureal
is
1621 function Ureal_M_10_36
return Ureal
is
1630 function Ureal_Tenth
return Ureal
is