1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
11 -- Copyright (C) 1992-2001 Free Software Foundation, Inc. --
13 -- GNAT is free software; you can redistribute it and/or modify it under --
14 -- terms of the GNU General Public License as published by the Free Soft- --
15 -- ware Foundation; either version 2, or (at your option) any later ver- --
16 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
17 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
18 -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
19 -- for more details. You should have received a copy of the GNU General --
20 -- Public License distributed with GNAT; see file COPYING. If not, write --
21 -- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
22 -- MA 02111-1307, USA. --
24 -- As a special exception, if other files instantiate generics from this --
25 -- unit, or you link this unit with other files to produce an executable, --
26 -- this unit does not by itself cause the resulting executable to be --
27 -- covered by the GNU General Public License. This exception does not --
28 -- however invalidate any other reasons why the executable file might be --
29 -- covered by the GNU Public License. --
31 -- GNAT was originally developed by the GNAT team at New York University. --
32 -- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
34 ------------------------------------------------------------------------------
37 with Output
; use Output
;
39 with Tree_IO
; use Tree_IO
;
41 package body Urealp
is
43 Ureal_First_Entry
: constant Ureal
:= Ureal
'Succ (No_Ureal
);
44 -- First subscript allocated in Ureal table (note that we can't just
45 -- add 1 to No_Ureal, since "+" means something different for Ureals!
47 type Ureal_Entry
is record
49 -- Numerator (always non-negative)
52 -- Denominator (always non-zero, always positive if base is zero)
55 -- Base value. If Rbase is zero, then the value is simply Num / Den.
56 -- If Rbase is non-zero, then the value is Num / (Rbase ** Den)
59 -- Flag set if value is negative
63 package Ureals
is new Table
.Table
(
64 Table_Component_Type
=> Ureal_Entry
,
65 Table_Index_Type
=> Ureal
,
66 Table_Low_Bound
=> Ureal_First_Entry
,
67 Table_Initial
=> Alloc
.Ureals_Initial
,
68 Table_Increment
=> Alloc
.Ureals_Increment
,
69 Table_Name
=> "Ureals");
71 -- The following universal reals are the values returned by the constant
72 -- functions. They are initialized by the initialization procedure.
85 Num_Ureal_Constants
: constant := 10;
86 -- This is used for an assertion check in Tree_Read and Tree_Write to
87 -- help remember to add values to these routines when we add to the list.
89 Normalized_Real
: Ureal
:= No_Ureal
;
90 -- Used to memoize Norm_Num and Norm_Den, if either of these functions
91 -- is called, this value is set and Normalized_Entry contains the result
92 -- of the normalization. On subsequent calls, this is used to avoid the
93 -- call to Normalize if it has already been made.
95 Normalized_Entry
: Ureal_Entry
;
96 -- Entry built by most recent call to Normalize
98 -----------------------
99 -- Local Subprograms --
100 -----------------------
102 function Decimal_Exponent_Hi
(V
: Ureal
) return Int
;
103 -- Returns an estimate of the exponent of Val represented as a normalized
104 -- decimal number (non-zero digit before decimal point), The estimate is
105 -- either correct, or high, but never low. The accuracy of the estimate
106 -- affects only the efficiency of the comparison routines.
108 function Decimal_Exponent_Lo
(V
: Ureal
) return Int
;
109 -- Returns an estimate of the exponent of Val represented as a normalized
110 -- decimal number (non-zero digit before decimal point), The estimate is
111 -- either correct, or low, but never high. The accuracy of the estimate
112 -- affects only the efficiency of the comparison routines.
114 function Equivalent_Decimal_Exponent
(U
: Ureal_Entry
) return Int
;
115 -- U is a Ureal entry for which the base value is non-zero, the value
116 -- returned is the equivalent decimal exponent value, i.e. the value of
117 -- Den, adjusted as though the base were base 10. The value is rounded
118 -- to the nearest integer, and so can be one off.
120 function Is_Integer
(Num
, Den
: Uint
) return Boolean;
121 -- Return true if the real quotient of Num / Den is an integer value
123 function Normalize
(Val
: Ureal_Entry
) return Ureal_Entry
;
124 -- Normalizes the Ureal_Entry by reducing it to lowest terms (with a
127 function Same
(U1
, U2
: Ureal
) return Boolean;
128 pragma Inline
(Same
);
129 -- Determines if U1 and U2 are the same Ureal. Note that we cannot use
130 -- the equals operator for this test, since that tests for equality,
133 function Store_Ureal
(Val
: Ureal_Entry
) return Ureal
;
134 -- This store a new entry in the universal reals table and return
135 -- its index in the table.
137 -------------------------
138 -- Decimal_Exponent_Hi --
139 -------------------------
141 function Decimal_Exponent_Hi
(V
: Ureal
) return Int
is
142 Val
: constant Ureal_Entry
:= Ureals
.Table
(V
);
145 -- Zero always returns zero
147 if UR_Is_Zero
(V
) then
150 -- For numbers in rational form, get the maximum number of digits in the
151 -- numerator and the minimum number of digits in the denominator, and
152 -- subtract. For example:
154 -- 1000 / 99 = 1.010E+1
155 -- 9999 / 10 = 9.999E+2
157 -- This estimate may of course be high, but that is acceptable
159 elsif Val
.Rbase
= 0 then
160 return UI_Decimal_Digits_Hi
(Val
.Num
) -
161 UI_Decimal_Digits_Lo
(Val
.Den
);
163 -- For based numbers, just subtract the decimal exponent from the
164 -- high estimate of the number of digits in the numerator and add
165 -- one to accommodate possible round off errors for non-decimal
166 -- bases. For example:
168 -- 1_500_000 / 10**4 = 1.50E-2
170 else -- Val.Rbase /= 0
171 return UI_Decimal_Digits_Hi
(Val
.Num
) -
172 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;
215 end Decimal_Exponent_Lo
;
221 function Denominator
(Real
: Ureal
) return Uint
is
223 return Ureals
.Table
(Real
).Den
;
226 ---------------------------------
227 -- Equivalent_Decimal_Exponent --
228 ---------------------------------
230 function Equivalent_Decimal_Exponent
(U
: Ureal_Entry
) return Int
is
232 -- The following table is a table of logs to the base 10
234 Logs
: constant array (Nat
range 1 .. 16) of Long_Float := (
235 1 => 0.000000000000000,
236 2 => 0.301029995663981,
237 3 => 0.477121254719662,
238 4 => 0.602059991327962,
239 5 => 0.698970004336019,
240 6 => 0.778151250383644,
241 7 => 0.845098040014257,
242 8 => 0.903089986991944,
243 9 => 0.954242509439325,
244 10 => 1.000000000000000,
245 11 => 1.041392685158230,
246 12 => 1.079181246047620,
247 13 => 1.113943352306840,
248 14 => 1.146128035678240,
249 15 => 1.176091259055680,
250 16 => 1.204119982655920);
253 pragma Assert
(U
.Rbase
/= 0);
254 return Int
(Long_Float (UI_To_Int
(U
.Den
)) * Logs
(U
.Rbase
));
255 end Equivalent_Decimal_Exponent
;
261 procedure Initialize
is
264 UR_0
:= UR_From_Components
(Uint_0
, Uint_1
, 0, False);
265 UR_M_0
:= UR_From_Components
(Uint_0
, Uint_1
, 0, True);
266 UR_Half
:= UR_From_Components
(Uint_1
, Uint_1
, 2, False);
267 UR_Tenth
:= UR_From_Components
(Uint_1
, Uint_1
, 10, False);
268 UR_1
:= UR_From_Components
(Uint_1
, Uint_1
, 0, False);
269 UR_2
:= UR_From_Components
(Uint_1
, Uint_Minus_1
, 2, False);
270 UR_10
:= UR_From_Components
(Uint_1
, Uint_Minus_1
, 10, False);
271 UR_100
:= UR_From_Components
(Uint_1
, Uint_Minus_2
, 10, False);
272 UR_2_128
:= UR_From_Components
(Uint_1
, Uint_Minus_128
, 2, False);
273 UR_2_M_128
:= UR_From_Components
(Uint_1
, Uint_128
, 2, False);
280 function Is_Integer
(Num
, Den
: Uint
) return Boolean is
282 return (Num
/ Den
) * Den
= Num
;
289 function Mark
return Save_Mark
is
291 return Save_Mark
(Ureals
.Last
);
298 function Norm_Den
(Real
: Ureal
) return Uint
is
300 if not Same
(Real
, Normalized_Real
) then
301 Normalized_Real
:= Real
;
302 Normalized_Entry
:= Normalize
(Ureals
.Table
(Real
));
305 return Normalized_Entry
.Den
;
312 function Norm_Num
(Real
: Ureal
) return Uint
is
314 if not Same
(Real
, Normalized_Real
) then
315 Normalized_Real
:= Real
;
316 Normalized_Entry
:= Normalize
(Ureals
.Table
(Real
));
319 return Normalized_Entry
.Num
;
326 function Normalize
(Val
: Ureal_Entry
) return Ureal_Entry
is
332 M
: constant Uintp
.Save_Mark
:= Uintp
.Mark
;
335 -- Start by setting J to the greatest of the absolute values of the
336 -- numerator and the denominator (taking into account the base value),
337 -- and K to the lesser of the two absolute values. The gcd of Num and
338 -- Den is the gcd of J and K.
340 if Val
.Rbase
= 0 then
344 elsif Val
.Den
< 0 then
345 J
:= Val
.Num
* Val
.Rbase
** (-Val
.Den
);
350 K
:= Val
.Rbase
** Val
.Den
;
365 Uintp
.Release_And_Save
(M
, Num
, Den
);
367 -- Divide numerator and denominator by gcd and return result
372 Negative
=> Val
.Negative
);
379 function Numerator
(Real
: Ureal
) return Uint
is
381 return Ureals
.Table
(Real
).Num
;
388 procedure pr
(Real
: Ureal
) is
398 function Rbase
(Real
: Ureal
) return Nat
is
400 return Ureals
.Table
(Real
).Rbase
;
407 procedure Release
(M
: Save_Mark
) is
409 Ureals
.Set_Last
(Ureal
(M
));
416 function Same
(U1
, U2
: Ureal
) return Boolean is
418 return Int
(U1
) = Int
(U2
);
425 function Store_Ureal
(Val
: Ureal_Entry
) return Ureal
is
427 Ureals
.Increment_Last
;
428 Ureals
.Table
(Ureals
.Last
) := Val
;
430 -- Normalize representation of signed values
433 Ureals
.Table
(Ureals
.Last
).Negative
:= True;
434 Ureals
.Table
(Ureals
.Last
).Num
:= -Val
.Num
;
444 procedure Tree_Read
is
446 pragma Assert
(Num_Ureal_Constants
= 10);
449 Tree_Read_Int
(Int
(UR_0
));
450 Tree_Read_Int
(Int
(UR_M_0
));
451 Tree_Read_Int
(Int
(UR_Tenth
));
452 Tree_Read_Int
(Int
(UR_Half
));
453 Tree_Read_Int
(Int
(UR_1
));
454 Tree_Read_Int
(Int
(UR_2
));
455 Tree_Read_Int
(Int
(UR_10
));
456 Tree_Read_Int
(Int
(UR_100
));
457 Tree_Read_Int
(Int
(UR_2_128
));
458 Tree_Read_Int
(Int
(UR_2_M_128
));
460 -- Clear the normalization cache
462 Normalized_Real
:= No_Ureal
;
469 procedure Tree_Write
is
471 pragma Assert
(Num_Ureal_Constants
= 10);
474 Tree_Write_Int
(Int
(UR_0
));
475 Tree_Write_Int
(Int
(UR_M_0
));
476 Tree_Write_Int
(Int
(UR_Tenth
));
477 Tree_Write_Int
(Int
(UR_Half
));
478 Tree_Write_Int
(Int
(UR_1
));
479 Tree_Write_Int
(Int
(UR_2
));
480 Tree_Write_Int
(Int
(UR_10
));
481 Tree_Write_Int
(Int
(UR_100
));
482 Tree_Write_Int
(Int
(UR_2_128
));
483 Tree_Write_Int
(Int
(UR_2_M_128
));
490 function UR_Abs
(Real
: Ureal
) return Ureal
is
491 Val
: constant Ureal_Entry
:= Ureals
.Table
(Real
);
505 function UR_Add
(Left
: Uint
; Right
: Ureal
) return Ureal
is
507 return UR_From_Uint
(Left
) + Right
;
510 function UR_Add
(Left
: Ureal
; Right
: Uint
) return Ureal
is
512 return Left
+ UR_From_Uint
(Right
);
515 function UR_Add
(Left
: Ureal
; Right
: Ureal
) return Ureal
is
516 Lval
: Ureal_Entry
:= Ureals
.Table
(Left
);
517 Rval
: Ureal_Entry
:= Ureals
.Table
(Right
);
522 -- Note, in the temporary Ureal_Entry values used in this procedure,
523 -- we store the sign as the sign of the numerator (i.e. xxx.Num may
524 -- be negative, even though in stored entries this can never be so)
526 if Lval
.Rbase
/= 0 and then Lval
.Rbase
= Rval
.Rbase
then
529 Opd_Min
, Opd_Max
: Ureal_Entry
;
530 Exp_Min
, Exp_Max
: Uint
;
533 if Lval
.Negative
then
534 Lval
.Num
:= (-Lval
.Num
);
537 if Rval
.Negative
then
538 Rval
.Num
:= (-Rval
.Num
);
541 if Lval
.Den
< Rval
.Den
then
554 Opd_Min
.Num
* Lval
.Rbase
** (Exp_Max
- Exp_Min
) + Opd_Max
.Num
;
561 Negative
=> Lval
.Negative
));
568 Negative
=> (Num
< 0)));
574 Ln
: Ureal_Entry
:= Normalize
(Lval
);
575 Rn
: Ureal_Entry
:= Normalize
(Rval
);
586 Num
:= (Ln
.Num
* Rn
.Den
) + (Rn
.Num
* Ln
.Den
);
593 Negative
=> Lval
.Negative
));
599 Den
=> Ln
.Den
* Rn
.Den
,
601 Negative
=> (Num
< 0))));
611 function UR_Ceiling
(Real
: Ureal
) return Uint
is
612 Val
: Ureal_Entry
:= Normalize
(Ureals
.Table
(Real
));
616 return UI_Negate
(Val
.Num
/ Val
.Den
);
618 return (Val
.Num
+ Val
.Den
- 1) / Val
.Den
;
626 function UR_Div
(Left
: Uint
; Right
: Ureal
) return Ureal
is
628 return UR_From_Uint
(Left
) / Right
;
631 function UR_Div
(Left
: Ureal
; Right
: Uint
) return Ureal
is
633 return Left
/ UR_From_Uint
(Right
);
636 function UR_Div
(Left
, Right
: Ureal
) return Ureal
is
637 Lval
: constant Ureal_Entry
:= Ureals
.Table
(Left
);
638 Rval
: constant Ureal_Entry
:= Ureals
.Table
(Right
);
639 Rneg
: constant Boolean := Rval
.Negative
xor Lval
.Negative
;
642 pragma Assert
(Rval
.Num
/= Uint_0
);
644 if Lval
.Rbase
= 0 then
646 if Rval
.Rbase
= 0 then
649 (Num
=> Lval
.Num
* Rval
.Den
,
650 Den
=> Lval
.Den
* Rval
.Num
,
654 elsif Is_Integer
(Lval
.Num
, Rval
.Num
* Lval
.Den
) then
656 (Num
=> Lval
.Num
/ (Rval
.Num
* Lval
.Den
),
661 elsif Rval
.Den
< 0 then
665 Den
=> Rval
.Rbase
** (-Rval
.Den
) *
674 (Num
=> Lval
.Num
* Rval
.Rbase
** Rval
.Den
,
675 Den
=> Rval
.Num
* Lval
.Den
,
680 elsif Is_Integer
(Lval
.Num
, Rval
.Num
) then
682 if Rval
.Rbase
= Lval
.Rbase
then
684 (Num
=> Lval
.Num
/ Rval
.Num
,
685 Den
=> Lval
.Den
- Rval
.Den
,
689 elsif Rval
.Rbase
= 0 then
691 (Num
=> (Lval
.Num
/ Rval
.Num
) * Rval
.Den
,
696 elsif Rval
.Den
< 0 then
702 Num
:= (Lval
.Num
/ Rval
.Num
) * (Lval
.Rbase
** (-Lval
.Den
));
703 Den
:= Rval
.Rbase
** (-Rval
.Den
);
705 Num
:= Lval
.Num
/ Rval
.Num
;
706 Den
:= (Lval
.Rbase
** Lval
.Den
) *
707 (Rval
.Rbase
** (-Rval
.Den
));
719 (Num
=> (Lval
.Num
/ Rval
.Num
) *
720 (Rval
.Rbase
** Rval
.Den
),
732 Num
:= Lval
.Num
* (Lval
.Rbase
** (-Lval
.Den
));
737 Den
:= Rval
.Num
* (Lval
.Rbase
** Lval
.Den
);
740 if Rval
.Rbase
/= 0 then
742 Den
:= Den
* (Rval
.Rbase
** (-Rval
.Den
));
744 Num
:= Num
* (Rval
.Rbase
** Rval
.Den
);
748 Num
:= Num
* Rval
.Den
;
765 function UR_Eq
(Left
, Right
: Ureal
) return Boolean is
767 return not UR_Ne
(Left
, Right
);
770 ---------------------
771 -- UR_Exponentiate --
772 ---------------------
774 function UR_Exponentiate
(Real
: Ureal
; N
: Uint
) return Ureal
is
782 -- If base is negative, then the resulting sign depends on whether
783 -- the exponent is even or odd (even => positive, odd = negative)
785 if UR_Is_Negative
(Real
) then
786 Neg
:= (N
mod 2) /= 0;
787 Bas
:= UR_Negate
(Real
);
793 Val
:= Ureals
.Table
(Bas
);
795 -- If the base is a small integer, then we can return the result in
796 -- exponential form, which can save a lot of time for junk exponents.
798 IBas
:= UR_Trunc
(Bas
);
801 and then UR_From_Uint
(IBas
) = Bas
806 Rbase
=> UI_To_Int
(UR_Trunc
(Bas
)),
809 -- If the exponent is negative then we raise the numerator and the
810 -- denominator (after normalization) to the absolute value of the
811 -- exponent and we return the reciprocal. An assert error will happen
812 -- if the numerator is zero.
815 pragma Assert
(Val
.Num
/= 0);
816 Val
:= Normalize
(Val
);
819 (Num
=> Val
.Den
** X
,
824 -- If positive, we distinguish the case when the base is not zero, in
825 -- which case the new denominator is just the product of the old one
826 -- with the exponent,
829 if Val
.Rbase
/= 0 then
832 (Num
=> Val
.Num
** X
,
837 -- And when the base is zero, in which case we exponentiate
838 -- the old denominator.
842 (Num
=> Val
.Num
** X
,
854 function UR_Floor
(Real
: Ureal
) return Uint
is
855 Val
: Ureal_Entry
:= Normalize
(Ureals
.Table
(Real
));
859 return UI_Negate
((Val
.Num
+ Val
.Den
- 1) / Val
.Den
);
861 return Val
.Num
/ Val
.Den
;
865 -------------------------
866 -- UR_From_Components --
867 -------------------------
869 function UR_From_Components
873 Negative
: Boolean := False)
881 Negative
=> Negative
));
882 end UR_From_Components
;
888 function UR_From_Uint
(UI
: Uint
) return Ureal
is
890 return UR_From_Components
891 (abs UI
, Uint_1
, Negative
=> (UI
< 0));
898 function UR_Ge
(Left
, Right
: Ureal
) return Boolean is
900 return not (Left
< Right
);
907 function UR_Gt
(Left
, Right
: Ureal
) return Boolean is
909 return (Right
< Left
);
916 function UR_Is_Negative
(Real
: Ureal
) return Boolean is
918 return Ureals
.Table
(Real
).Negative
;
925 function UR_Is_Positive
(Real
: Ureal
) return Boolean is
927 return not Ureals
.Table
(Real
).Negative
928 and then Ureals
.Table
(Real
).Num
/= 0;
935 function UR_Is_Zero
(Real
: Ureal
) return Boolean is
937 return Ureals
.Table
(Real
).Num
= 0;
944 function UR_Le
(Left
, Right
: Ureal
) return Boolean is
946 return not (Right
< Left
);
953 function UR_Lt
(Left
, Right
: Ureal
) return Boolean is
955 -- An operand is not less than itself
957 if Same
(Left
, Right
) then
960 -- Deal with zero cases
962 elsif UR_Is_Zero
(Left
) then
963 return UR_Is_Positive
(Right
);
965 elsif UR_Is_Zero
(Right
) then
966 return Ureals
.Table
(Left
).Negative
;
968 -- Different signs are decisive (note we dealt with zero cases)
970 elsif Ureals
.Table
(Left
).Negative
971 and then not Ureals
.Table
(Right
).Negative
975 elsif not Ureals
.Table
(Left
).Negative
976 and then Ureals
.Table
(Right
).Negative
980 -- Signs are same, do rapid check based on worst case estimates of
981 -- decimal exponent, which will often be decisive. Precise test
982 -- depends on whether operands are positive or negative.
984 elsif Decimal_Exponent_Hi
(Left
) < Decimal_Exponent_Lo
(Right
) then
985 return UR_Is_Positive
(Left
);
987 elsif Decimal_Exponent_Lo
(Left
) > Decimal_Exponent_Hi
(Right
) then
988 return UR_Is_Negative
(Left
);
990 -- If we fall through, full gruesome test is required. This happens
991 -- if the numbers are close together, or in some weird (/=10) base.
995 Imrk
: constant Uintp
.Save_Mark
:= Mark
;
996 Rmrk
: constant Urealp
.Save_Mark
:= Mark
;
1002 Lval
:= Ureals
.Table
(Left
);
1003 Rval
:= Ureals
.Table
(Right
);
1005 -- An optimization. If both numbers are based, then subtract
1006 -- common value of base to avoid unnecessarily giant numbers
1008 if Lval
.Rbase
= Rval
.Rbase
and then Lval
.Rbase
/= 0 then
1009 if Lval
.Den
< Rval
.Den
then
1010 Rval
.Den
:= Rval
.Den
- Lval
.Den
;
1013 Lval
.Den
:= Lval
.Den
- Rval
.Den
;
1018 Lval
:= Normalize
(Lval
);
1019 Rval
:= Normalize
(Rval
);
1021 if Lval
.Negative
then
1022 Result
:= (Lval
.Num
* Rval
.Den
) > (Rval
.Num
* Lval
.Den
);
1024 Result
:= (Lval
.Num
* Rval
.Den
) < (Rval
.Num
* Lval
.Den
);
1038 function UR_Max
(Left
, Right
: Ureal
) return Ureal
is
1040 if Left
>= Right
then
1051 function UR_Min
(Left
, Right
: Ureal
) return Ureal
is
1053 if Left
<= Right
then
1064 function UR_Mul
(Left
: Uint
; Right
: Ureal
) return Ureal
is
1066 return UR_From_Uint
(Left
) * Right
;
1069 function UR_Mul
(Left
: Ureal
; Right
: Uint
) return Ureal
is
1071 return Left
* UR_From_Uint
(Right
);
1074 function UR_Mul
(Left
, Right
: Ureal
) return Ureal
is
1075 Lval
: constant Ureal_Entry
:= Ureals
.Table
(Left
);
1076 Rval
: constant Ureal_Entry
:= Ureals
.Table
(Right
);
1077 Num
: Uint
:= Lval
.Num
* Rval
.Num
;
1079 Rneg
: constant Boolean := Lval
.Negative
xor Rval
.Negative
;
1082 if Lval
.Rbase
= 0 then
1083 if Rval
.Rbase
= 0 then
1084 return Store_Ureal
(
1087 Den
=> Lval
.Den
* Rval
.Den
,
1089 Negative
=> Rneg
)));
1091 elsif Is_Integer
(Num
, Lval
.Den
) then
1092 return Store_Ureal
(
1093 (Num
=> Num
/ Lval
.Den
,
1095 Rbase
=> Rval
.Rbase
,
1098 elsif Rval
.Den
< 0 then
1099 return Store_Ureal
(
1101 (Num
=> Num
* (Rval
.Rbase
** (-Rval
.Den
)),
1104 Negative
=> Rneg
)));
1107 return Store_Ureal
(
1110 Den
=> Lval
.Den
* (Rval
.Rbase
** Rval
.Den
),
1112 Negative
=> Rneg
)));
1115 elsif Lval
.Rbase
= Rval
.Rbase
then
1116 return Store_Ureal
(
1118 Den
=> Lval
.Den
+ Rval
.Den
,
1119 Rbase
=> Lval
.Rbase
,
1122 elsif Rval
.Rbase
= 0 then
1123 if Is_Integer
(Num
, Rval
.Den
) then
1124 return Store_Ureal
(
1125 (Num
=> Num
/ Rval
.Den
,
1127 Rbase
=> Lval
.Rbase
,
1130 elsif Lval
.Den
< 0 then
1131 return Store_Ureal
(
1133 (Num
=> Num
* (Lval
.Rbase
** (-Lval
.Den
)),
1136 Negative
=> Rneg
)));
1139 return Store_Ureal
(
1142 Den
=> Rval
.Den
* (Lval
.Rbase
** Lval
.Den
),
1144 Negative
=> Rneg
)));
1150 if Lval
.Den
< 0 then
1151 Num
:= Num
* (Lval
.Rbase
** (-Lval
.Den
));
1153 Den
:= Den
* (Lval
.Rbase
** Lval
.Den
);
1156 if Rval
.Den
< 0 then
1157 Num
:= Num
* (Rval
.Rbase
** (-Rval
.Den
));
1159 Den
:= Den
* (Rval
.Rbase
** Rval
.Den
);
1162 return Store_Ureal
(
1167 Negative
=> Rneg
)));
1176 function UR_Ne
(Left
, Right
: Ureal
) return Boolean is
1178 -- Quick processing for case of identical Ureal values (note that
1179 -- this also deals with comparing two No_Ureal values).
1181 if Same
(Left
, Right
) then
1184 -- Deal with case of one or other operand is No_Ureal, but not both
1186 elsif Same
(Left
, No_Ureal
) or else Same
(Right
, No_Ureal
) then
1189 -- Do quick check based on number of decimal digits
1191 elsif Decimal_Exponent_Hi
(Left
) < Decimal_Exponent_Lo
(Right
) or else
1192 Decimal_Exponent_Lo
(Left
) > Decimal_Exponent_Hi
(Right
)
1196 -- Otherwise full comparison is required
1200 Imrk
: constant Uintp
.Save_Mark
:= Mark
;
1201 Rmrk
: constant Urealp
.Save_Mark
:= Mark
;
1202 Lval
: constant Ureal_Entry
:= Normalize
(Ureals
.Table
(Left
));
1203 Rval
: constant Ureal_Entry
:= Normalize
(Ureals
.Table
(Right
));
1207 if UR_Is_Zero
(Left
) then
1208 return not UR_Is_Zero
(Right
);
1210 elsif UR_Is_Zero
(Right
) then
1211 return not UR_Is_Zero
(Left
);
1213 -- Both operands are non-zero
1217 Rval
.Negative
/= Lval
.Negative
1218 or else Rval
.Num
/= Lval
.Num
1219 or else Rval
.Den
/= Lval
.Den
;
1232 function UR_Negate
(Real
: Ureal
) return Ureal
is
1234 return Store_Ureal
(
1235 (Num
=> Ureals
.Table
(Real
).Num
,
1236 Den
=> Ureals
.Table
(Real
).Den
,
1237 Rbase
=> Ureals
.Table
(Real
).Rbase
,
1238 Negative
=> not Ureals
.Table
(Real
).Negative
));
1245 function UR_Sub
(Left
: Uint
; Right
: Ureal
) return Ureal
is
1247 return UR_From_Uint
(Left
) + UR_Negate
(Right
);
1250 function UR_Sub
(Left
: Ureal
; Right
: Uint
) return Ureal
is
1252 return Left
+ UR_From_Uint
(-Right
);
1255 function UR_Sub
(Left
, Right
: Ureal
) return Ureal
is
1257 return Left
+ UR_Negate
(Right
);
1264 function UR_To_Uint
(Real
: Ureal
) return Uint
is
1265 Val
: Ureal_Entry
:= Normalize
(Ureals
.Table
(Real
));
1269 Res
:= (Val
.Num
+ (Val
.Den
/ 2)) / Val
.Den
;
1271 if Val
.Negative
then
1272 return UI_Negate
(Res
);
1282 function UR_Trunc
(Real
: Ureal
) return Uint
is
1283 Val
: constant Ureal_Entry
:= Normalize
(Ureals
.Table
(Real
));
1286 if Val
.Negative
then
1287 return -(Val
.Num
/ Val
.Den
);
1289 return Val
.Num
/ Val
.Den
;
1297 procedure UR_Write
(Real
: Ureal
) is
1298 Val
: constant Ureal_Entry
:= Ureals
.Table
(Real
);
1301 -- If value is negative, we precede the constant by a minus sign
1302 -- and add an extra layer of parentheses on the outside since the
1303 -- minus sign is part of the value, not a negation operator.
1305 if Val
.Negative
then
1309 -- Constants in base 10 can be written in normal Ada literal style
1310 -- If the literal is negative enclose in parens to emphasize that
1311 -- it is part of the constant, and not a separate negation operator
1313 if Val
.Rbase
= 10 then
1315 UI_Write
(Val
.Num
/ 10);
1317 UI_Write
(Val
.Num
mod 10);
1319 if Val
.Den
/= 0 then
1321 UI_Write
(1 - Val
.Den
);
1324 -- Constants in a base other than 10 can still be easily written
1325 -- in normal Ada literal style if the numerator is one.
1327 elsif Val
.Rbase
/= 0 and then Val
.Num
= 1 then
1328 Write_Int
(Val
.Rbase
);
1329 Write_Str
("#1.0#E");
1330 UI_Write
(-Val
.Den
);
1332 -- Other constants with a base other than 10 are written using one
1333 -- of the following forms, depending on the sign of the number
1334 -- and the sign of the exponent (= minus denominator value)
1336 -- (numerator.0*base**exponent)
1337 -- (numerator.0*base**(-exponent))
1339 elsif Val
.Rbase
/= 0 then
1341 UI_Write
(Val
.Num
, Decimal
);
1343 Write_Int
(Val
.Rbase
);
1346 if Val
.Den
<= 0 then
1347 UI_Write
(-Val
.Den
, Decimal
);
1351 UI_Write
(Val
.Den
, Decimal
);
1357 -- Rational constants with a denominator of 1 can be written as
1358 -- a real literal for the numerator integer.
1360 elsif Val
.Den
= 1 then
1361 UI_Write
(Val
.Num
, Decimal
);
1364 -- Non-based (rational) constants are written in (num/den) style
1368 UI_Write
(Val
.Num
, Decimal
);
1370 UI_Write
(Val
.Den
, Decimal
);
1374 -- Add trailing paren for negative values
1376 if Val
.Negative
then
1386 function Ureal_0
return Ureal
is
1395 function Ureal_1
return Ureal
is
1404 function Ureal_2
return Ureal
is
1413 function Ureal_10
return Ureal
is
1422 function Ureal_100
return Ureal
is
1431 function Ureal_2_128
return Ureal
is
1440 function Ureal_2_M_128
return Ureal
is
1449 function Ureal_Half
return Ureal
is
1458 function Ureal_M_0
return Ureal
is
1467 function Ureal_Tenth
return Ureal
is